Можно ли написать эту итерацию аккуратно и функционально - PullRequest
Новая
       97

Можно ли написать эту итерацию аккуратно и функционально

1 голос
/ 05 октября 2019

data имеет столбец с именем description типа character() и столбец id типа integer(), который установлен как row_number().

data_map имеет имя столбцаdesc_map типа character() и столбец id типа integer(), установленный в row_number().

data и data_map, имеют другие столбцы, используемые в дальнейшей обработке после объединения.

Идея кода ниже заключается в использовании data_map$desc_map в качестве шаблона в str_detect для соответствия data$description. На совпадении это добавило бы строку к другому tibble, используя data$id и data_map$id. Получившийся matches позволяет объединять data и 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

Мой вопрос: может ли этот код быть написан более функционально tidy и как это будет выглядеть? Если это не может быть сделано таким образом, какой будет причина?

1 Ответ

2 голосов
/ 06 октября 2019

Обновление

На основе вашего обновленного вопроса приведена обновленная версия моего ответа.

На этот раз я просто использовал ваши входные данные как есть и не создалименованная функция. Вместо этого я положил все в одну трубу. Столбец found должен указывать, сколько раз был найден шаблон, поэтому вам не нужны разные объекты, так как not_unique, matched_not_found, matches_found.

Я взял идею из GenesRus (вкомментарии вашего вопроса), чтобы создать список-столбец и удалить его, но я не стал использовать этот подход, используя расширение / сводную ширину, а вместо этого выбрал map2 для циклического перебора столбцов description и desc_map. 

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)

Старый ответ

Ниже приведен более основанный на тидивсе подход, который должен дать тот же результат. «Должен», потому что я могу только догадываться, как выглядят ваши входные данные и ожидаемый результат. Несколько замечаний: (1) Я выбираю нормальные символьные векторы в качестве входных данных. Идентификаторы строк генерируются на лету. (2) Я поместил ваш подход в функцию под названием match_tbl. (3) Я использовал функции Tidyverse в сочетании с оператором pipe. Это делает весь подход легко читаемым, а внешний вид выглядит как 'tidyverse-ish'. Однако, когда вы посмотрите на реальные функции пакетов tidyverse, вы увидите, что авторы обычно воздерживаются от использования оператора pipe внутри функций, поскольку он может легко выдавать ошибки. Используйте отладчик RStudio в конвейерной операции и попытайтесь углубиться в происходящее, и вы увидите, что это довольно грязно. Поэтому, если вы хотите сделать из него действительно стабильную функцию, отбросьте каналы и используйте вместо этого промежуточные переменные.

Данные и пакеты 

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")

Функция, генерирующая желаемый выход: таблица соответствий 

# 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"))

}

Вызов функции и выход 

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
...