加快将函数应用于 R 中的唯一值

Question

我希望有人可以提供帮助，我正在尝试加快应用功能，我尝试了一些技巧，但仍然很慢，我想知道是否有人有更多建议。

我的数据如下：

myData= data.frame(ident=c(3,3,4,4,4,4,4,4,4,4,4,7,7,7,7,7,7,7),
group=c(7,7,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8),
significant=c(1,1,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,0),
year=c(2003,2002,2001,2008,2010,2007,2007,2008,2006,2012,2008,
2012,2006,2001,2014,2012,2004,2007),
month=c(1,1,9,12,3,2,4,3,9,5,12,8,11,3,1,6,3,1),
subReport=c(0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0),
prevReport=c(1,1,0,1,1,1,0,1,1,1,0,1,1,1,1,1,1,1))

我想最终得到这样的数据框：

results=data.frame(ident=c(3,4,7),
significant=c(1,0,1),
prevReports=c(2,6,7),
subReport=c(0,1,0),
group=c(7,7,8))

为此，我编写了下面的代码并快速完成，我尝试转换为数据表并使用 rbindlist 而不是 rbind，我发现在几个线程中建议使用它。我也尝试过 parLapply，但我仍然发现这个过程很慢，（我试图在大约 250,000 个数据点上执行此操作）。

dt<-data.table(myData)

results<-NULL

ApplyModel <- function (id,data) {

dtTemp<-dt[dt$ident== id,] 

if(nrow(dtTemp)>=1){

prevReport = if(sum(dtTemp$prevReport)>=1) sum(dtTemp$prevReport) else 0 

subsequentReport =  if(sum(dtTemp$subReport)>=1) 1 else 0 

significant = as.numeric(head(dtTemp$sig,1))

group = head(dtTemp$group,1)

id= as.numeric(head(dtTemp$id,1))

output<-cbind(id, significant ,prevReport,subsequentReport ,group)

output<-output[!duplicated(output[,1]),]
print(output)
results <- rbindlist(list(as.list(output)))

 }
}


results<-lapply(unique(dt$ident), ApplyModel)
results<-as.data.frame(do.call(rbind, results))

任何关于如何加快速度的建议都将受到欢迎！我认为这可能与子集有关，我想将函数应用于基于唯一值的子集，但我认为 lapply 实际上更多的是用于将函数应用于每个值，因此子集在某种程度上击败了对象......

Answer 1

在这里，您的代码会产生错误：

结果

在我看来，您正在寻找的是 tapply 而不是 lapply。使用 tapply 你可以用更简洁的方式大致表达上述内容：

results2 <- data.frame(significant = tapply(myData$significant, myData$ident, function(x) return(x[1])),
                       prevreports = tapply(myData$prevReport, myData$ident, sum),
                       subReports = tapply(myData$subReport, myData$ident, function(x) as.numeric(any(x==1))),
                       group = tapply(myData$group, myData$ident, function(x) return(x[1])))

应该做同样的工作，但更具可读性。现在这应该很快，除了巨大的数据集。在大多数情况下，等待 R 完成工作应该比花更多时间编程要快。使这更快的一种方法是使用 data.table 包的强大功能，但仅调用它并不能解决问题。你需要学习它非常特殊的语法。请先检查一下，以这种方式给出的代码确实太慢了。 如果真的太慢，请检查：

library(data.table)

first <- function(x) x[1]
myAny <- function(x) as.numeric(any(x==1))
myData <- data.table(myData)

myData[, .(significant=first(significant),
           prevReports=sum(prevReport),
           subReports=myAny(subReport), 
           group=first(group)), ident]

Answer 2

你可以使用dplyr:

require(dplyr)

new <- myData %>% group_by(ident) %>% 
summarise(first(significant),sum(prevReport),(n_distinct(subReport)-1), first(group)) %>%
data.frame()