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

IIUC，每12列只有一个1。剩下的是0或NA。如果是这样，通过这个想法可以更快地执行操作。

想法：您可以使用尺寸为1的矩阵，而不是遍历每一行并询问1500 * 12的位置，而每行只是{{} 1}}。那就是：

1:12

现在，您可以将此矩阵与您的每个子集mul.mat <- matrix(rep(1:12, nrow(DT)), ncol = 12, byrow=TRUE)（相同维度，此处为1500 * 12）相乘，然后使用data.frame将其“rowSums”（已向量化）。这只是直接给出你有1的行（因为1将乘以1到12之间的相应值）。

data.table实现：在这里，我将使用na.rm = TRUE来说明这个想法。由于它通过引用创建列，我希望data.table上使用的相同想法会慢一点，尽管它应该会大大加快您当前的代码。

data.frame

现在，你将留下30个与1的位置相对应的列。在我的系统上，这需要大约0.4秒。

require(data.table)
DT <- data.table(mydata)
ids <- seq(1, ncol(DT), by=12)

# for multiplying with each subset and taking rowSums to get position of 1
mul.mat <- matrix(rep(1:12, nrow(DT)), ncol = 12, byrow=TRUE)

for (i in ids) {
    sdcols <- i:(i+12-1)
    # keep appending the new columns by reference to the original data
    DT[, paste0("R", i %/% 12 + 1) := rowSums(.SD * mul.mat, 
                     na.rm = TRUE), .SDcols = sdcols]
}
# delete all original 360 columns by reference from the original data
DT[, grep("V", names(DT), value=TRUE) := NULL]

Answer 3

我非常喜欢@ 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而不是按行来处理data.table，从而避免了对数组的强制，从而学到了很多关于如何改进这个功能的知识。我不是故意在这里“偷”答案; OP应考虑将复选框切换为@ mnel的答案。

但是，我想分享一个不使用for的解决方案，并避免使用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)) }。然而，它仍然比@ mnel的解决方案慢，尽管稍微有点。

which

我还想补充一点，如果arr.ind=TRUE以mydata开头，那么matrix和data.frame使用matrix的@ Aaron方法也会非常快速和优雅，而不是{{1}}。强制到{{1}}比函数的其余部分慢。如果速度是一个问题，那么首先考虑将数据作为矩阵读取是值得的。

Answer 4

使用基础R可以完成的另一种方法是简单地获取要放入新矩阵的值并直接用矩阵索引填充它们。

idx <- which(mydata==1, arr.ind=TRUE)   # get indices of 1's
i <- idx[,2] %% 12                      # get column that was 1
idx[,2] <- ((idx[,2] - 1) %/% 12) + 1   # get "group" and put in "col" of idx
out <- array(NA, dim=c(1500,30))        # make empty matrix
out[idx] <- i                           # and fill it in!

优化：将数据帧拆分为数据帧列表，每行转换数据

4 个答案: