case_when условно используя purrr, который читает последовательность столбцов - PullRequest
Новая
       26

case_when условно используя purrr, который читает последовательность столбцов

1 голос
/ 17 июня 2019

Я пытаюсь классифицировать текущий статус участников курса. Это расширение этого поста: purrr pmap для чтения максимального имени столбца по номеру имени столбца . Мой набор данных выглядит так: 

library(dplyr)
problem <- tibble(name = c("Angela", "Claire", "Justin", "Bob", "Joseph", "Gil"),
                   status_1 = c("Registered", "Withdrawn", "Completed", "Registered", "Registered", "Registered"),
                   status_2 = c("Withdrawn", "Withdrawn", "Registered", "NA", "Withdrawn", "Cancelled"),
                   status_3 = c("NA", "Registered", "Withdrawn", "NA", "Registered", "NA"),
                   status_4 = c("Withdrawn", "Registered", "Withdrawn", "NA", "Registered", "NA"))

Я хочу классифицировать текущий статус людей. Если кто-то прошел курс в каком-либо статусе, его статус «Завершено». Однако, что сложно, это их зарегистрированный статус. Кто-то «Зарегистрирован», ЕСЛИ его окончательный статус зарегистрирован ИЛИ, если последующий статус - «NA». Они НЕ зарегистрированы, если статус после их регистрации отозван или отменен. Итак, окончательный набор данных должен выглядеть так: 

library(dplyr)
solution <- tibble(name = c("Angela", "Claire", "Justin", "Bob", "Joseph", "Gil"),
                   status_1 = c("Registered", "Withdrawn", "Completed", "Registered", "Registered", "Registered"),
                   status_2 = c("Withdrawn", "Withdrawn", "Registered", "NA", "Withdrawn", "Cancelled"),
                   status_3 = c("NA", "Registered", "Withdrawn", "NA", "Registered", "NA"),
                   status_4 = c("Withdrawn", "Registered", "Withdrawn", "NA", "Registered", "NA"),
                   current = c("Not Taken", "Registered", "Completed", "Registered", "Registered", "Not Taken"))

Анжела не взята, потому что она вышла после своей регистрации. Клэр зарегистрирована, потому что, несмотря на ее прошлые изъятия, она недавно зарегистрировалась. Джастин закончил, потому что он прошел курс при любом статусе. Боб зарегистрирован, потому что он не отозвал или отменил курс. Подобно Клэр, Джозеф зарегистрировался совсем недавно, чем его снятие, поэтому он зарегистрирован. Наконец, Гил "Не взят", потому что его курс был отменен, и у него нет более поздней регистрации.

Вот мой код: 

library(tidyverse)
solution %>% 
  mutate(
    test =
      pmap_chr(select(., contains("status")), ~
        case_when(
          any(str_detect(c(...), "(?i)Completed")) ~ "Completed",
          any(str_detect(c(...), "(?i)Exempt")) | any(str_detect(c(...), "(?i)Incomplete")) ~ "Exclude",
          length(c(...) == "Registered") > length(c(...) == "Withdrawn") | length(c(...) == "Registered") > length(c(...) == "Cancelled")  ~ "Registered",
          any(str_detect(c(...), "(?i)No Show")) | any(str_detect(c(...), "(?i)Denied")) | any(str_detect(c(...), "(?i)Cancelled")) | any(str_detect(c(...), "(?i)Waitlist Expired")) || any(str_detect(c(...), "(?i)Withdrawn")) ~ "Not Taken",
          TRUE ~ "NA"
        )
      )
  )

Я не могу понять, как взломать код с регистрационной частью. В идеале я хотел бы сохранить как можно больше этого кода, потому что мой истинный набор данных имеет много столбцов статуса.

Спасибо!

1 Ответ

1 голос
/ 18 июня 2019

Я думаю, что эту проблему легче решить, если сначала немного переставить данные в соответствии с принципами «аккуратных данных» , где каждый раз, когда изменяется статус студента, записывается в отдельном ряду.Переставленные данные находятся в problem_wrangled.

. Тогда текущий статус обычно можно определить, просматривая только самый последний статус, за исключением статуса «Завершено», для которого мы проверяем все прошлые статусы.. 

library(tidyverse)

problem <- tibble(name = c("Angela", "Claire", "Justin", "Bob", "Joseph", "Gil"),
                  status_1 = c("Registered", "Withdrawn", "Completed", "Registered", "Registered", "Registered"),
                  status_2 = c("Withdrawn", "Withdrawn", "Registered", "NA", "Withdrawn", "Cancelled"),
                  status_3 = c("NA", "Registered", "Withdrawn", "NA", "Registered", "NA"),
                  status_4 = c("Withdrawn", "Registered", "Withdrawn", "NA", "Registered", "NA"))

status_wrangled <- problem %>%
  gather(key = "time", value = "status", starts_with("status")) %>%
  mutate(time = as.integer(str_split_fixed(time, "_", 2)[, 2])) %>%
  arrange(name, time) %>%
  filter(status != "NA")

head(status_wrangled)
#> # A tibble: 6 x 3
#>   name   time  status    
#>   <chr>  <chr> <chr>     
#> 1 Angela 1     Registered
#> 2 Angela 2     Withdrawn 
#> 3 Angela 4     Withdrawn 
#> 4 Bob    1     Registered
#> 5 Claire 1     Withdrawn 
#> 6 Claire 2     Withdrawn

status_current <- status_wrangled %>%
  group_by(name) %>%
  summarize(
    current = case_when(
      # Has student completed at any time?
      "Completed" %in% status ~ "Completed",
      # Examine last recorded status
      tail(status, 1) %in% c("Exempt", "Incomplete") ~ "Exclude",
      tail(status, 1) %in% c("Withdrawn", "Cancelled", "No Show", "Denied", "Waitlist Expired") ~ "Not Taken",
      tail(status, 1) == "Registered" ~ "Registered",
      TRUE ~ "Unknown"
    )
  )

print(status_current, n = Inf)
#> # A tibble: 6 x 2
#>   name   current   
#>   <chr>  <chr>     
#> 1 Angela Not Taken 
#> 2 Bob    Registered
#> 3 Claire Registered
#> 4 Gil    Not Taken 
#> 5 Joseph Registered
#> 6 Justin Completed

Создано в 2019-06-17 пакетом представ (v0.3.0)

РЕДАКТИРОВАТЬ: Относительно вашего комментария оВыполнение приблизительных совпадений: я изменил пример, чтобы разрешить приблизительные совпадения до определенного расстояния редактирования.Вы, вероятно, хотите настроить это, но допустимо до трех или около того правок.Но будьте осторожны, разница между «Incomplete» и «Completed» составляет всего четыре правки. 

library(tidyverse)

problem <- tibble(name = c("Angela", "Claire", "Justin", "Bob", "Joseph", "Gil"),
                  status_1 = c("Registered", "Withdrawn", "Completed", "Registered", "Registered", "Registered"),
                  status_2 = c("Withdrawn", "Withdrawn", "Registered", "NA", "Withdrawn", "Cancelled"),
                  status_3 = c("NA", "Registered", "Withdrawn", "NA", "Registered", "NA"),
                  status_4 = c("Withdrawnn", "Registered", "Withdrawn", "NA", "Registered", "NA"))

status_wrangled <- problem %>%
  gather(key = "time", value = "status", starts_with("status")) %>%
  mutate(time = as.integer(str_split_fixed(time, "_", 2)[, 2])) %>%
  arrange(name, time) %>%
  filter(status != "NA")

# Find if input vector matches to *any* given pattern below the specified edit distance
any_fuzzy_match <- function(x, patterns, max.distance = 3) {
  matches <- map(paste0("^", patterns, "$"), agrepl, x = x, max.distance = max.distance, fixed = FALSE)
  reduce(matches, `|`)
}

status_current <- status_wrangled %>%
  group_by(name) %>%
  summarize(
    current = case_when(
      # Has student completed at any time?
      any(any_fuzzy_match(status, "Completed")) ~ "Completed",
      # Examine last recorded status
      any_fuzzy_match(tail(status, 1), c("Exempt", "Incomplete")) ~ "Exclude",
      any_fuzzy_match(tail(status, 1), c("Withdrawn", "Cancelled", "No Show", "Denied", "Waitlist Expired")) ~ "Not Taken",
      any_fuzzy_match(tail(status, 1), "Registered") ~ "Registered",
      TRUE ~ "Unknown"
    )
  )

print(status_current, n = Inf)
#> # A tibble: 6 x 2
#>   name   current   
#>   <chr>  <chr>     
#> 1 Angela Not Taken 
#> 2 Bob    Registered
#> 3 Claire Registered
#> 4 Gil    Not Taken 
#> 5 Joseph Registered
#> 6 Justin Completed

Создан в 2019-06-18 пакетом Представить (v0.3.0)

...