这里是一个快速base R
溶液:
MakeDF3 <- function(dfB, dfN) { ## dfB --> Binary, dfN --> Numeric
di <- dim(dfB); n <- di[1]; m <- di[2]
dfOut <- data.frame(matrix(rep(NA, m*n), nrow = n))
mBool <- matrix(rep(TRUE, m*n), nrow = n)
myNames <- names(dfB)
names(dfOut) <- myNames
## Here is the speed increase... i.e. looping over columns as opposed to rows
for (j in 3:(m-1L)) {
myOne <- which(dfB[,j]==1)
myRow <- intersect(myOne, which(mBool[,j-1L]))
dfOut[myRow,j-1L] <- 0
mBool[myRow,j-1L] <- FALSE
for (i in j:(j+1L)) {
myRow <- intersect(myOne, which(mBool[,i]))
dfOut[myRow,i] <- dfN[myRow,i]-dfN[myRow,j-1L]
mBool[myRow,i] <- FALSE
}
}
myOne <- which(dfB[,m]==1)
myRow <- intersect(myOne,which(mBool[,m-1L]))
dfOut[myRow,m-1L] <- 0
myRow <- intersect(myOne,which(mBool[,m]))
dfOut[myRow,m] <- dfN[myRow,m]-dfN[myRow,m-1L]
dfOut[,1L] <- dfB[,1L]
dfOut
}
下面是示例输出:
df1 <- data.frame(1:4,c(NA, NA, 0, 0),c(NA, NA, 0, 1),c(0, 0, 0, 0), c(1, 1, NA, 0), c(0, 1, 0, 1))
df2 <- data.frame(1:4,c(NA, NA, 0.1, 0.05),c(0.7,0.2,-0.98,-0.1),c(0.98,0.43,0.01,0.05), c(0.6,0.3,0.09,0.12), c(0.75,0.5,0.1,0.23))
names(df2) <- c("ID", as.character(2005:2009))
names(df1) <- c("ID", as.character(2005:2009))
MakeDF3(df1, df2)
ID 2005 2006 2007 2008 2009
1 1 NA NA 0 -0.38 -0.23
2 2 NA NA 0 -0.13 0.07
3 3 NA NA NA NA NA
4 4 0 -0.15 0 0.00 0.11
这里是一个更大的示例:
set.seed(101)
df3 <- data.frame(1:10000, matrix(sample(c(NA,0,1), 10000*7, replace = TRUE), ncol = 7))
df4 <- data.frame(1:10000, matrix(rnorm(10000*7), ncol = 7))
names(df3) <- c("ID", as.character(2005:2011))
names(df4) <- c("ID", as.character(2005:2011))
df5 <- MakeDF3(df3, df4)
下面是一个简要说明算法如何工作。从OP的例子中,我们可以推断出当确定输出时,来自较小列号的“基”优先。我们知道这一点,因为df1[2,c("2008","2009")] = 1 1
以及生成的行/列的结果数据帧为:df3[2,c("2007","2008","2009")] = 0 -0.13 0.07
。如果情况并非如此,则df3[2,"2008"]
将为0,因为df1[2,"2009"] = 1
。这是我的算法的工作原理。基本上,我遍历列,我只更新以前没有计算过的行(这是由mBool
矩阵确定的)。
head(df3)
ID 2005 2006 2007 2008 2009 2010 2011
1 1 0 1 NA 0 1 0 1
2 2 NA 0 1 0 1 1 0
3 3 1 0 NA 1 NA 0 0
4 4 0 0 NA 1 NA NA NA
5 5 NA 0 1 NA 0 1 1
6 6 NA 1 0 NA 0 0 0
head(round(df4, 2))
ID 2005 2006 2007 2008 2009 2010 2011
1 1 -0.61 1.56 -0.60 0.58 -1.70 -0.86 0.25
2 2 0.37 -1.59 1.25 -1.46 0.38 1.40 2.16
3 3 -0.11 -0.39 -0.04 -1.04 1.09 -2.25 0.50
4 4 0.15 -0.34 0.97 1.19 -0.90 0.62 0.32
5 5 0.61 -0.10 0.17 -0.10 0.33 -0.20 1.87
6 6 1.87 -0.72 -1.52 -1.06 1.13 -0.23 -1.13
head(round(df5,2))
ID 2005 2006 2007 2008 2009 2010 2011
1 1 0 2.16 0.01 0.00 -2.28 -1.44 1.11
2 2 NA 0.00 2.84 0.13 1.84 2.86 1.78 ### Note that 2.16 - 0.38 = 1.78 (see df3[2,"2010"] above)
3 3 NA NA 0.00 -1.00 1.14 NA NA
4 4 NA NA 0.00 0.22 -1.87 NA NA
5 5 NA 0.00 0.27 0.01 0.00 -0.53 1.54
6 6 0 -2.58 -3.38 NA NA NA NA
下面是一些基准与保留(虽然它们不产生相同的目的,输出足够相似,以保证效率比较):
microbenchmark(MakeDF3(df3,df4),Dracodoc(df3,df4))
Unit: milliseconds
expr min lq mean median uq max neval cld
MakeDF3(df3, df4) 16.54374 19.01940 26.06108 20.23607 21.38977 168.8745 100 a
Dracodoc(df3, df4) 26.64295 30.79689 59.82243 33.50883 38.02572 191.6978 100 b
恕我直言:这可能有助于说明如何准确一些'计算df3'的价值观。 – lukeA
你可以说'dput(df1)'和'dput(df2)'? – loki
OP提供了关于df1,df2或df3计算方式的足够信息(df3中的NA除外)。然而,这不是一个简单的任务,因为对于最后的列基值有订阅超出范围的情况。我试图通过矩阵索引获得解决方案,结果非常麻烦。如果你的数据量不是很大,那么for循环可能更容易实现。 – dracodoc