這裏是一個快速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