Блог

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

Например, в приведенных ниже данных у меня было четыре пациента, и я записался на прием к каждому по три раза.

 dat <- structure(list(patient = c('John', 'John', 'John', 'Jean', 'Jean', 'Jean', 'Jack', 'Jack', 'Jack', 'Jess', 'Jess', 'Jess'), 
                      status = c('Well', 'Well', 'Well', 'Well', 'Sick', 'Well', 'DNA', 'DNA', 'DNA', 'DNA', 'Well', 'Well')), class = "data.frame", row.names = c(NA, -12L))
  

Иногда они были здоровы, иногда болели, а иногда не посещали (ДНК).

Я легко вижу, что статус по крайней мере некоторых из них отличался между назначениями:

 nrow(unique(dat)) == length(unique(dat$patient))
# gives FALSE
  

Я пытаюсь выяснить, как определить, какие пациенты имеют разные статусы.

Лучшее, что у меня есть на данный момент, это:

 # function to find if all elements of a vector are the same
all_same <- function(x) all(x == x[1])

# split table and apply function
sapply(split(dat$status, dat$patient), all_same)
  

Это работает, но у меня большой набор данных со многими группами (то есть пациентами). Кажется, я довольно часто сталкиваюсь с этой конкретной проблемой. Я чувствую, что должен быть элегантный и векторизованный способ сделать это. Я знаю, что могу повысить скорость моего подхода, используя dplyr / data.table, но я могу думать только о подходах, которые разделяют данные, а затем выполняют циклическую функцию над группами. Каков наилучший способ сделать это?

Вот не аккуратный способ:

 table(unique(dat)[,'patient'])
  

дает

 Jack Jean Jess John 
  1    2    2    1 
  

И немного другой аккуратный подход, при котором вы сохраняете информацию о состоянии:

 library("tidyverse")

dat <- structure(list(patient = c('John', 'John', 'John', 'Jean', 'Jean', 'Jean', 'Jack', 'Jack', 'Jack', 'Jess', 'Jess', 'Jess'),
                      status = c('Well', 'Well', 'Well', 'Well', 'Sick', 'Well', 'DNA', 'DNA', 'DNA', 'DNA', 'Well', 'Well')), class = "data.frame", row.names = c(NA, -12L))

dat %>% 
  # Keep unique combinations of patient and status
  distinct(patient, status) %>%
  # Are they are any patients with more than one status?
  group_by(patient) %>%
  filter(n() > 1) %>%
  summarise(status=paste(status, collapse = ","))
#> # A tibble: 2 x 2
#>   patient status   
#>   <chr>   <chr>    
#> 1 Jean    Well,Sick
#> 2 Jess    DNA,Well
  

^{Создано 2019-03-28 пакетом reprex (версия 0.2.1)}

И вот подход data.table

  library(data.table)
 setDT(dat); 
 dat[,.(unique=uniqueN(status)),patient]

   patient unique
1:    John      1
2:    Jean      2
3:    Jack      1
4:    Jess      2
  

Вот одна идея…

 d <- function (x) { # test whether each element of a vector is different to the element before
  y <- x != c(x[-1], NA)
  y <- c(F, y)
  y[-length(y)]
}

dat$nc <- d(dat$status) amp; !d(dat$patient) # status changes but patient doesn't
unique(dat$patient[dat$nc])
  

РЕДАКТИРОВАТЬ — Вот моя первая попытка сравнительного анализа

Результаты показывают, что методы разделения / применения и ‘table’ в base на самом деле быстрее, чем dplyr или data.table для этой цели, в то время как функция ‘ch’ намного быстрее. Функция ‘ch’ действительно зависит от того, что пациенты находятся в последовательных строках таблицы, чего нет в других подходах.

 # function for my approach above

ch <- function(dat, group, status) {
  d <- function (x) {
    y <- x != c(x[-1], NA)
    y <- c(F, y)
    y[-length(y)]
  }
  unique(dat[,group][d(dat[,status]) amp; !d(dat[,group])])
}

# you can also use factor and diff - see 'ch2' below
# generate data with 20000 groups

library(stringi)
dat <- data.frame(patient = rep(stri_rand_strings(20000, 7), each = 4),
                  status = sample(c('A', 'B', 'C'), 80000, replace = T, prob = c(0.8, 0.1, 0.1)),
                  stringsAsFactors = F)

microbenchmark(
  dplyr = dat %>% as_tibble() %>% group_by(patient) %>% summarise(result = n_distinct(status)),
  split_apply =  sapply(split(dat$status, dat$patient), function(x) all(x == x[1])),
  table = table(unique(dat)[,'patient']),
  ch = ch(dat, 'patient', 'status'),
  ch2 = unique(dat$patient[c(F, diff(as.numeric(factor(dat$patient))) != 0 amp; diff(as.numeric(factor(dat$status))) == 0)]),
  datatable = {setDT(dat); dat[,.(unique=uniqueN(status)),patient]},
  times = 1
)

Unit: milliseconds
        expr       min        lq      mean    median        uq       max neval
       dplyr 5523.6048 5523.6048 5523.6048 5523.6048 5523.6048 5523.6048     1
 split_apply  165.8760  165.8760  165.8760  165.8760  165.8760  165.8760     1
       table  224.9030  224.9030  224.9030  224.9030  224.9030  224.9030     1
          ch   10.8821   10.8821   10.8821   10.8821   10.8821   10.8821     1
         ch2  146.2358  146.2358  146.2358  146.2358  146.2358  146.2358     1
   datatable  851.1028  851.1028  851.1028  851.1028  851.1028  851.1028     1