如何在 R 中更快地将循环重写为运行？

Question

给定 > 900,000 行的数据集，其中 length(duplicates) = >300,000，以下循环在 R 中需要大约 4 小时到运行，这是不可接受的。

for(i in duplicates) {
  couple_table <- filter(data, pnr == i) # filter patients
  min_date <- min(couple_table$date)     # determine date of first operation
  max_date <- max(couple_table$date)     # determine date of second operation
  
  data$first[data$pnr == i & data$date == min_date] <- 1  # assign 1 to column first
  data$second[data$pnr == i & data$date == max_date] <- 1 # assign 1 to column second
}

如何在 R 中将此代码调整为运行更快？我看过 *apply 但我一点都不熟悉，有什么想法吗？

虚拟数据：

data <- data.frame(pnr = c('a43','a4945', 'a43', 'a231', 'a231', 'a6901'),
                date = c(as.Date('2011-12-19'), as.Date('2012-09-11'),  as.Date('2013-10-01'),
                as.Date('2012-05-09'), as.Date('2009-09-10'), as.Date('2015-06-12')))
duplicates <- as.character(data$pnr[duplicated(data$pnr)])

Answer 1

按操作分组会更快

library(dplyr)
data %>% 
   group_by(pnr) %>% 
   mutate(Min = if(n() > 1)  NA^(date != min(date)) else NA, 
          Max = if(n() > 1) NA^(date != max(date)) else NA) %>%
   ungroup

-输出

# A tibble: 6 x 4
#  pnr   date         Min   Max
#  <chr> <date>     <dbl> <dbl>
#1 a43   2011-12-19     1    NA
#2 a4945 2012-09-11    NA    NA
#3 a43   2013-10-01    NA     1
#4 a231  2012-05-09    NA     1
#5 a231  2009-09-10     1    NA
#6 a6901 2015-06-12    NA    NA

data.table 中的类似逻辑是

library(data.table)
setDT(data)[, c('Min', 'Max') := .(if(.N > 1) 
    NA^(date != min(date)) else NA, if(.N> 1) 
        NA^(date != max(date)) else NA), .(pnr)]

或者可以使用 collapse 来加快执行速度

library(collapse)
data %>%
    ftransform(n = fNobs(date, pnr, TRA = 'replace_fill')) %>% 
    ftransform(Min = NA^(fmin(date, pnr, TRA = "replace_fill") != date | n == 1), 
    Max = NA^(fmax(date, pnr, TRA = "replace_fill") != date | n == 1), n = NULL )
#    pnr       date Min Max
#1   a43 2011-12-19   1  NA
#2 a4945 2012-09-11  NA  NA
#3   a43 2013-10-01  NA   1
#4  a231 2012-05-09  NA   1
#5  a231 2009-09-10   1  NA
#6 a6901 2015-06-12  NA  NA

或使用 base R 和 duplicated

i1 <- with(data, duplicated(pnr)|duplicated(pnr, fromLast = TRUE))     
data$Min <- with(data, i1 & date == ave(date, pnr, FUN = min))
data$Max <- with(data, i1 & date == ave(date, pnr, FUN = max))

Answer 2

和data.table

library(data.table)

setDT(data)
data[pnr %in% duplicates, ":="(
    Min = (date == min(date)) * 1L,
    Max = (date == max(date)) * 1L
  ), by = pnr
]
data[, c("Min", "Max") := lapply(.SD, function(x) ifelse(x == 0, NA, x)), .SDcols = c("Min", "Max")]

Answer 3

这是 ave 的基础 R 解决方案。它使用中的技巧，即

NA^0 == 1

（更准确地说，NA^FALSE == NA^0 == 1）

data$first <- with(data, ave(as.integer(date), pnr, FUN = function(d) NA^(d == max(d))))
data$second <- with(data, ave(as.integer(date), pnr, FUN = function(d) NA^(d == min(d))))

data
#    pnr       date first second
#1   a43 2011-12-19     1     NA
#2 a4945 2012-09-11    NA     NA
#3   a43 2013-10-01    NA      1
#4  a231 2012-05-09    NA      1
#5  a231 2009-09-10     1     NA
#6 a6901 2015-06-12    NA     NA

Answer 4

一个data.table选项

setDT(data)[
  ,
  `:=`(
    first = ifelse(min(date) == date & .N > 1, 1, NA_integer_),
    second = ifelse(max(date) == date & .N > 1, 1, NA_integer_)
  ),
  pnr
]

给予

     pnr       date first second
1:   a43 2011-12-19     1     NA
2: a4945 2012-09-11    NA     NA
3:   a43 2013-10-01    NA      1
4:  a231 2012-05-09    NA      1
5:  a231 2009-09-10     1     NA
6: a6901 2015-06-12    NA     NA

如何在 R 中更快地将循环重写为 运行？

How to rewrite loop to run faster in R?

r

lapply

如何在 R 中更快地将循环重写为运行？