data tiene una columna llamada description de tipo character() y una columna id de tipo integer() establecida por row_number().

data_map tiene un nombre de columna desc_map de tipo character() y una columna id de tipo integer() establecida por row_number().

data y data_map sí tienen otras columnas utilizadas en el procesamiento posterior después de unirse.

La idea del código siguiente es usar data_map$desc_map como patrón en str_detect para hacer coincidir data$description. En un partido, agregaría una fila a otra tibble, usando data$id y data_map$id. El matches resultante permite la unión de data y data_map.

library(tidyverse)

data = tribble(
  ~description,
  "19ABB123456",
  "19BCC123456",
  "19CDD123456",
  "19DEE123456",
  "19EFF456789",
  "19FF0056789",
  "19A0A123456",
) %>% mutate(id = row_number())

data_map = tribble(
  ~desc_map,
  "AA",
  "BB",
  "CC",
  "DD",
  "EE",
  "FF",
  "00",
) %>% mutate(id = row_number())

seq_along_rows <- function(.data) {
  seq_len(nrow(.data))
}

matches <- data %>% (function (tbl) {
  m <- tibble(
    row_id = integer(),
    map_id = integer()
  )

  for (i in seq_along_rows(tbl)) {
    row <- tbl[i, ]
    key <- row[["description"]]
    found <- FALSE

    for (j in seq_along_rows(data_map)) {
      map_row <- data_map[j, ]
      pattern <- map_row[["desc_map"]]

      if (str_detect(key, pattern)) {
        m <- add_row(m, row_id = row[["id"]], map_id = map_row[["id"]])
        found <- TRUE
        # allow for finding more than one match
      }
    }

    if (!found) {
      m <- add_row(m, row_id = row[["id"]], map_id = NA)
    }
  }

  return(m)
})

not_unique <- matches %>% 
  group_by(row_id) %>%
  filter(n() > 1) %>%
  ungroup() %>%
  inner_join(data, by = c("row_id" = "id")) %>%
  inner_join(data_map, by = c("map_id" = "id"))

head(not_unique)
#> # A tibble: 2 x 4
#>   row_id map_id description desc_map
#>    <int>  <int> <chr>       <chr>   
#> 1      6      6 19FF0056789 FF      
#> 2      6      7 19FF0056789 00

matches_not_found <- matches %>%
  filter(is.na(map_id)) %>%
  select(-map_id) %>%
  inner_join(data, by = c("row_id" = "id"))

head(matches_not_found)
#> # A tibble: 1 x 2
#>   row_id description
#>    <int> <chr>      
#> 1      7 19A0A123456

matches_found <- matches %>%
  filter(!is.na(map_id)) %>%
  inner_join(data, by = c("row_id" = "id")) %>%
  inner_join(data_map, by = c("map_id" = "id"))

head(matches_found)
#> # A tibble: 6 x 4
#>   row_id map_id description desc_map
#>    <int>  <int> <chr>       <chr>   
#> 1      1      2 19ABB123456 BB      
#> 2      2      3 19BCC123456 CC      
#> 3      3      4 19CDD123456 DD      
#> 4      4      5 19DEE123456 EE      
#> 5      5      6 19EFF456789 FF      
#> 6      6      6 19FF0056789 FF

Mi pregunta es, ¿se puede escribir este código de una manera más tidy funcional y cómo se vería? Si no se puede hacer de esa manera, ¿cuál sería la razón?

1
NebulaFox 5 oct. 2019 a las 15:22

1 respuesta

La mejor respuesta

Actualizar

Según su pregunta actualizada, aquí hay una versión actualizada de mi respuesta.

Esta vez solo usé sus entradas tal como están y no creé una función con nombre. En cambio, puse todo en una tubería. La columna found debería indicar cuántas veces se encontró un patrón, por lo que no debería necesitar objetos diferentes como not_unique, matched_not_found, matches_found.

Tomé la idea de GenesRus (en los comentarios de su pregunta) para crear una columna de lista y anidarla, pero no llevé el enfoque más allá usando spread / pivot-wide y en su lugar elegí map2 para recorrer el {{X0 }} y desc_map columnas.

library(tidyverse)

data %>% 
  mutate(pattern = list(data_map)) %>% 
  unnest %>% 
  rename(row_id = "id", map_id = "id1") %>% 
  mutate(v = map2_lgl(description, desc_map,
                  ~ str_detect(.x, .y))) %>% 
  group_by(row_id) %>% 
  mutate(found = sum(v),
         desc_map = ifelse(found == F, NA, desc_map),
         map_id = ifelse(found == F, NA, map_id)) %>% 
  filter(v == T | (v == F & found == 0)) %>%
  distinct %>%
  select(-v) 

Antigua respuesta

A continuación se muestra un enfoque más basado en tidyverse que debería producir el mismo resultado. 'Debería' porque solo puedo adivinar cómo se ven sus datos de entrada y el resultado esperado. Algunas notas: (1) Elijo vectores de caracteres normales como entradas. Los identificadores de fila se generan sobre la marcha. (2) Puse su enfoque en una función llamada match_tbl. (3) Usé funciones tidyverse en combinación con el operador de tubería. Esto hace que todo el enfoque sea fácil de leer y la apariencia parece ser 'tidyverse-ish'. Sin embargo, cuando observe las funciones reales de los paquetes tidyverse, verá que los autores generalmente se abstienen de usar el operador de tubería dentro de las funciones, ya que puede arrojar errores fácilmente. Use el depurador de RStudio en una operación de tubería e intente profundizar en lo que está sucediendo y verá que es bastante complicado. Por lo tanto, si desea hacer una función realmente estable, elimine las tuberías y use variables intermedias en su lugar.

Datos y paquetes

library(tidyverse)

# some description data (not a dataframe but a normal char vector)
description <- c("This is a text description",
                "Some words that won't match",
                "Some random text goes here",
                "and some more explanation here")

# patterns that we want to find (not a dataframe but a normal char vector)
pattern <- c("explanation","description", "text")

Una función que genera el resultado deseado: una tabla de coincidencias

# a function which replaces your nested for loop
match_tbl <- function(.string, .pattern) {

  res <- imap(.pattern,
               ~ stringr::str_detect(.string, .x) %>% 
                     tibble::enframe(name = "row_id") %>%
                     dplyr::mutate(map_id = .y) %>% 
                     dplyr::filter(value == T) %>% 
                     dplyr::select(-"value"))

  string_tbl <- .string %>% 
             tibble::enframe(name = "id") %>% 
             dplyr::select("id")

  dplyr::bind_rows(res) %>%
    dplyr::right_join(string_tbl, by = c("row_id" = "id"))

}

Llamada y salida de función

match_tbl(description, pattern)
>   row_id map_id
>    <int>  <int>
> 1      1      2
> 2      1      3
> 3      2     NA
> 4      3      3
> 5      4      1
3
TimTeaFan 7 oct. 2019 a las 12:32