column search by id

library(data.table)
library(tidyr)
library(dplyr)
library(magrittr)
N = 1e5
dat = data.table(ID = paste0("P", 1:N))
for (i in 1:50)
  eval(parse(text = paste0("dat %<>% mutate(D", i,
    "=paste0(sample(LETTERS, N, TRUE),",
    "sample(as.character(1:100), N, TRUE)))")))

# single search
code1 = "D5"
st = proc.time()
a = dat %>% gather(D, code, -ID) %>% group_by(ID) %>%
  summarise(stroke = any(code == code1)) %>% distinct()
proc.time() - st
#   user  system elapsed
#   0.42    0.05    0.47

# multiple search
codes_search = c("D5", "E55", "Z2", "A96")
st = proc.time()
a = dat %>% gather(D, code, -ID) %>% group_by(ID)
for (i in 1:length(codes_search))
  eval(parse(text = paste0("a %<>% mutate(codes_search_", i,
    "=codes_search[", i, "])")))
b = a %>% group_by(ID) %>% summarise_(.dots = paste0(
    "any(code == codes_search_", 1:length(codes_search),")")) %>%
  setnames(c("ID", paste0("stroke", 1:length(codes_search))))
proc.time() - st
#   user  system elapsed
#   2.74    0.26    3.01

## list search
diseases = vector('list', 15)
for (i in 1:length(diseases))
  diseases[[i]] = paste0(sample(LETTERS, i, TRUE),
    sample(1:100, i, TRUE))

st = proc.time()
a = dat %>% gather(D, code, -ID) %>% group_by(ID)
out_list = llply(1:length(diseases), function(i){
  a %>% setkey(ID) %>% group_by(ID) %>%
  summarise(stroke = any(code %in% diseases[[i]])) %>%
  setnames("stroke", paste0("stroke_", i))
})
out = Reduce(function(x, y) merge(x, y), out_list)
proc.time() - st
#   user  system elapsed
#   8.88    0.36    9.23

## faster way
st = proc.time()
a = dat %>% gather(D, code, -ID) %>% group_by(ID)
eval(parse(text = paste("a %<>% summarise(", paste0("stroke_",
  1:length(diseases) ,"=any(diseases[[", 1:length(diseases),
  "]] %in% code)", collapse = ","), ")")))
proc.time() - st
#   user  system elapsed
#   5.79    0.05    5.85

## the fastest way
st = proc.time()
out2 = vector('list', length(diseases))
for (i in 1:length(diseases))
  out2[[i]] = rowMeans(sweep(as.matrix(dat[,2:51, with = FALSE]), 2, 1:(ncol(dat)-1), function(x, y){matrix(x %in% diseases[[i]], nrow(dat))})) > 0
out2 = do.call(cbind, out2) %>% data.table %>% cbind(dat$ID, .) %>%
  setnames(c("ID", paste0("stroke_", 1:length(diseases)))) %>% tbl_dt(FALSE)
proc.time() - st
#   user  system elapsed
#   3.20    0.52    3.71

all.equal(out2, a) # TRUE