8

预备：这个问题主要是教育价值，手头的实际任务已经完成，即使方法不是完全最优的。我的问题是下面的代码是否可以针对速度进行优化和/或更优雅地实现。也许使用其他软件包，例如 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)))

总而言之，有一个双 *apply 函数，一个跨列表，另一个跨数据框行。这使它有点慢。有什么建议么？提前致谢。

4

4 回答 4

5

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

瑟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....

于 2013-04-11T00:15:14.243 回答
4

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

这个想法：而不是遍历每一行并询问 的位置1，您可以使用具有1500 * 12每行的维度的矩阵只是1:12。那是：

mul.mat <- matrix(rep(1:12, nrow(DT)), ncol = 12, byrow=TRUE)

现在，您可以将此矩阵与您的每个子集data.frame（相同维度，此处为 1500*12）相乘，然后将它们的“rowSums”（矢量化）与na.rm = TRUE. 这将直接给出您拥有 1 的行（因为 1 将乘以 1 到 12 之间的相应值）。

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

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]

现在，您将剩下 30 列对应于 1 的位置。在我的系统上，这大约需要 0.4 秒。

all(unlist(final.df) == unlist(DT)) # not a fan of `identical`
# [1] TRUE
于 2013-04-10T19:34:23.680 回答
4

我真的很喜欢@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 的方法，如果从 a 开始，而不是 a ，使用whichwitharr.ind=TRUE也会非常快速和优雅。对 a 的强制比函数的其余部分慢。如果速度是一个问题，那么首先考虑将数据作为矩阵读取是值得的。mydatamatrixdata.framematrix

于 2013-04-10T20:11:59.393 回答
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!
于 2013-04-11T01:54:47.193 回答