2013-04-10 96 views
8

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

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

+0

(+1)非常好框的问题。 – Arun 2013-04-10 19:36:31

回答

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,我学到了很多关于如何提高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)) 
} 

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

+1

nograpes,(+1)谢谢。根据我对平行工作的经验,除非你平行的任务是“沉重的”,否则在完成后创造工作和合并结果的开销*要高得多,结果变慢。在1处理器和一组处理器上进行基准测试会很有趣。我不认为这里的实际操作“很重”。如果我设法榨取一些时间,我会尽力去做。 – Arun 2013-04-10 21:43:47

+0

谢谢。我也喜欢@ Arun关于矩阵乘法的建议。尽管如此,我发现你的代码对于真正的数据应用来说更加强大乘法方法取决于数据的清晰度,否则行总和将不正确。我尽我所能消除了违规行为,但人们永远无法知晓。代码在速度方面表现非常好,0.25秒。伟大的建议。 – 2013-04-10 21:44:31

+2

在data.frame上使用apply将强制为一个矩阵,这不是有效的。 – mnel 2013-04-11 00:26:45

4

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 
+0

谢谢,阿伦。矩阵乘法是一个绝妙的想法,我甚至没有朝这个方向思考。直觉上我期望plyr或者重塑一些简洁的技巧,但是你使用data.table的建议也是一个非常值得欢迎的发现。 – 2013-04-10 21:30:47

5

这是一个基本上瞬时的方法。 (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以及....

+0

我不知道什么是错的,但是这段代码并没有给我结果。相反,我得到一个data.table(newDT),其中包含变量名称而不是值。我设想这些对应于我寻求的值,例如V1_8指的是8.对于“set”仍然是一个有价值的建议,谢谢。 – 2013-04-11 08:03:10

+2

@ mnel,辉煌的答案。我做了一些更正。对'whiches [[。]]'的访问是不正确的。对于每一个'jj',当对于ex:对于'jj = 2','ii'必须是'13:24'时,它都经历了相同的1:12。希望你不介意编辑。如果你不服气,随意编辑/回滚。马克西姆,你现在应该得到想要的结果。是的,它*是*快! – Arun 2013-04-11 08:46:08

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! 
+0

一个非常有趣的方法,谢谢。不幸的是,它不适用于原始数据,很可能是由于某些行仅包含NA。它确实对模拟数据确实有效,当然实际数据也可以进行调整。 – 2013-04-11 09:12:58

+0

附录:它实际上可以处理原始数据,不确定第一次出错的地方。再次感谢。 – 2013-04-11 09:28:26

相关问题