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

Question

预备：这个问题主要是教育价值，即使这种方法并不是完全最优的，它仍然完成了实际的任务。我的问题是下面的代码是否可以针对速度进行优化和/或实现更优雅。也许使用额外的软件包，如plyr或重塑。运行实际数据大约需要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))) 

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

Answer 1

我真的很喜欢@ 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，我学到了很多关于如何提高THI通过按列处理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)) 
} 

我还想补充一点，@阿龙的方法，使用which与arr.ind=TRUE也将是非常快速和优雅，如果mydata开始作为一个matrix，而不是data.frame。强制转换为matrix比其他功能慢。如果速度是一个问题，那么首先将数据读取为矩阵是值得考虑的。

Answer 2

IIUC，您每12列只有一个1。你有其余的0或NA。如果是这样，这个想法可以更快地执行操作。

的想法：而是通过每个行会，并要求为1的位置，你可以每行仅仅是1:12使用与维1500 * 12的矩阵。那就是：

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

现在，你可以乘这个矩阵，每个subset'd data.frame的（中相同的尺寸，1500 * 12在这里），并带他们去他们的“rowSums”（这是矢量化）与na.rm = TRUE。这将直接给出你有1的行（因为1将乘以1和12之间的对应值）。

---

data.table实现：在这里，我将使用data.table来说明这个想法。由于它通过引用创建列，所以我期望在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 

Answer 3

这是一个基本上瞬时的方法。 （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 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!