优化:将数据帧拆分为数据帧列表,每行转换数据

Question

预备:这个问题大多具有教育价值,即使方法不完全是最优的,手头的实际任务也已完成.我的问题是下面的代码是否可以针对速度进行优化和/或更优雅地实现.也许使用其他包,例如plyr或reshape.运行实际数据需要大约140秒,远远高于模拟数据,因为一些原始行只包含NA,并且必须进行额外的检查.为了比较,模拟数据在大约30秒内处理.

条件:数据集包含360个变量,是12个集合的30倍.我们将它们命名为V1_1,V1_2 ......(第一组),V2_1,V2_2 ......(第二组)等等.每组12个变量包含二分(是/否)响应,实际上对应于职业状态.例如:工作(是/否),学习(是/否)等等,总共12种状态,重复30次.

任务:手头的任务是将每组12个二分变量重新编码为具有12个响应类别的单个变量(例如,工作,研究......).最终我们应该得到30个变量,每个变量有12个响应类别.

数据:我无法发布实际数据集,但这是一个很好的模拟近似值:

randomRow <- function() {
  # make a row with a single 1 and some NA's
  sample(x=c(rep(0,9),1,NA,NA),size=12,replace=F) 
}

# create a data frame with 12 variables and 1500 cases
makeDf <- function() {
  data <- matrix(NA,ncol=12,nrow=1500)
  for (i in 1:1500) {
    data[i,] <- randomRow()
  }
  return(data)
}

mydata <- NULL

# combine 30 of these dataframes horizontally
for (i in 1:30) {
  mydata <- cbind(mydata,makeDf())
}
mydata <- as.data.frame(mydata) # example data ready

我的解决方案:

# Divide the dataset into a list with 30 dataframes, each with 12 variables
S1 <- lapply(1:30,function(i) {
  Z <- rep(1:30,each=12) # define selection vector
  mydata[Z==i]           # use selection vector to get groups of variables (x12)
})

recodeDf <- function(df) {
  result <- as.numeric(apply(df,1,function(x) {
    if (any(!is.na(df))) which(x == 1) else NA # return the position of "1" per row
  }))                                          # the if/else check is for the real data
  return(result)
}
# Combine individual position vectors into a dataframe
final.df <- as.data.frame(do.call(cbind,lapply(S1,recodeDf)))

总而言之,有一个double*apply函数,一个在列表中,另一个在数据帧行中.这使它有点慢.有什么建议？提前致谢.

Answer 1

这是一种基本上即时的方法.(system.time = 0.1秒)

se set.columnMatch组件将取决于您的数据,但如果它是每12列,则以下内容将起作用.

MYD <- data.table(mydata)
# a new data.table (changed to numeric : Arun)
newDT <- as.data.table(replicate(30, numeric(nrow(MYD)),simplify = FALSE))
# for each column, which values equal 1
whiches <- lapply(MYD, function(x) which(x == 1))
# create a list of column matches (those you wish to aggregate)
columnMatch <- split(names(mydata), rep(1:30,each = 12))
setattr(columnMatch, 'names', names(newDT))

# cycle through all new columns
# and assign the the rows in the new data.table
## Arun: had to generate numeric indices for 
## cycling through 1:12, 13:24 in whiches[[.]]. That was the problem.
for(jj in seq_along(columnMatch)) {
 for(ii in seq_along(columnMatch[[jj]])) {
  set(newDT, j = jj, i = whiches[[ii + 12 * (jj-1)]], value = ii)
 }
}

这也可以通过引用原始添加列来实现.

注意也set适用data.frames....

Answer 2

我真的很喜欢@Arun 的矩阵乘法想法。有趣的是，如果您针对某些 OpenBLAS 库编译 R，您可以使其并行运行。

但是，我想为您提供另一个可能比矩阵乘法慢的解决方案，该解决方案使用您的原始模式，但比您的实现快得多：

# Match is usually faster than which, because it only returns the first match 
# (and therefore won't fail on multiple matches)
# It also neatly handles your *all NA* case
recodeDf2 <- function(df) apply(df,1,match,x=1) 
# You can split your data.frame by column with split.default
# (Using split on data.frame will split-by-row)
S2<-split.default(mydata,rep(1:30,each=12))
final.df2<-lapply(S2,recodeDf2)

如果您有一个非常大的数据帧和许多处理器，您可以考虑将此操作并行化：

library(parallel)
final.df2<-mclapply(S2,recodeDf2,mc.cores=numcores) 
# Where numcores is your number of processors.

阅读了 @Arun 和 @mnel 后，我学到了很多关于如何改进这个函数的知识，通过避免对数组的强制，通过按data.frame列而不是按行处理。我并不是想在这里“窃取”答案；OP 应考虑将复选框切换到 @mnel 的答案。

然而，我想分享一个不使用data.table并避免 的解决方案for。然而，它仍然比 @mnel 的解决方案慢，尽管慢了一点。

nograpes2<-function(mydata) {
  test<-function(df) {
    l<-lapply(df,function(x) which(x==1))
    lens<-lapply(l,length)
    rep.int(seq.int(l),times=lens)[order(unlist(l))]
  }
  S2<-split.default(mydata,rep(1:30,each=12))
  data.frame(lapply(S2,test))
}

我还想补充一点，@Aaron 的方法，如果开始时是，而不是 ，那么使用whichwitharr.ind=TRUE也会非常快速和优雅。对 a 的强制转换比函数的其余部分慢。如果速度是一个问题，那么首先值得考虑将数据作为矩阵读取。mydatamatrixdata.framematrix