Определите группы с различными наблюдениями - PullRequest
Новая
       18

Определите группы с различными наблюдениями

1 голос
/ 29 марта 2019

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

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

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, но я могу думать только о подходах, которые разделяют данные, а затем зацикливают функцию на группы.Каков наилучший способ сделать это?

Ответы [ 4 ]

3 голосов
/ 29 марта 2019

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

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

дает 

Jack Jean Jess John 
  1    2    2    1
1 голос
/ 29 марта 2019

А вот подход 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
1 голос
/ 29 марта 2019

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

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 пакетом представ. (v0.2.1)

0 голосов
/ 29 марта 2019

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

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) & !d(dat$patient) # status changes but patient doesn't
unique(dat$patient[dat$nc])

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

Результаты показывают, что подходы разделения / применения и «таблицы» в базена самом деле быстрее, чем 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]) & !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 & 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
...