Styjun

I am trying to identify groups in a dataset where values of a specific variable differ.

For example, in the data below, I had four patients and made three appointments to see each.

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

Sometimes they were well, sometimes sick and sometimes they didn't attend (DNA).

I can easily see that the status of at least some of them differed between appointments:

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

I am trying to work out how to identify which patients have differing statuses.

The best I have so far is:

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

This works, but I have a big dataset with many groups (i.e. patients). I seem to come across this specific problem quite often. I feel there must be an elegant and vectorized way to do this. I know I can improve the speed of my approach using dplyr/data.table but I can only think of approaches that split the data and then loop a function over the groups. What is the best way to do this?

Here is a non tidy way:

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

gives

Jack Jean Jess John 
 1 2 2 1 

And a slightly different tidy approach where you keep information about the status:

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

^{Created on 2019-03-28 by the reprex package (v0.2.1)}

And here's a data.table approach

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

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

Here's one idea...

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

EDIT - Here's my first ever effort at benchmarking

The results suggest that split/apply and 'table' approaches in base are actually faster than either dplyr or data.table for this purpose, while the 'ch' function is much faster. The 'ch' function does rely on the patients being on consecutive rows in the table, which the other approaches don't.

# 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