识别具有不同观察结果的组

Question

我正在尝试识别数据集中特定变量值不同的组。

例如，在下面的数据中，我有四个病人，每个人预约了三个时间。

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

有时他们很好，有时生病，有时他们没有参加（DNA）。

我可以很容易地看到，至少其中一些的状态在约会之间有所不同：

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 提高我的方法的速度，但我只能想到拆分数据然后在组上循环一个函数的方法。最好的方法是什么？

Answer 1

这是一个不整洁的方式：

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

给予

Jack Jean Jess John 
  1    2    2    1 

Answer 2

还有一种稍微不同的整理方法，您可以在其中保存有关状态的信息：

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

^{由reprex package (v0.2.1) 于 2019 年 3 月 28 日创建}

Answer 3

这是一种 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

Answer 4

这里有一个想法...

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

---

编辑 - 这是我第一次进行基准测试

结果表明，为此目的，base 中的 split/apply 和 'table' 方法实际上比 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