2016-10-01 212 views
2

我有兩個具有相同維度的數據幀。一個數據幀(df1)由「1」和「0」組成,而另一個數據幀(df2)具有不同的值。我想通過基於條件減去df2值來創建新的數據框(df3)。條件是每當df1中有「1」時,該位置應該在df2中標識(例如,它的第1行,第4列)。現在前一列(第1行,第3列)中的df2值應被視爲基準{0.98},並且後兩列(第1行,第4列{0.6}和第5列第{0.75}列)中的值應爲從這個基值中逐一減去。 它下面的樣本中解釋說:根據另一個數據幀的條件減去數據幀的值

df3: 
ID 2005 2006 2007 2008 2009 
1  NA  NA  0  -0.38 -0.23 
2  NA  NA  0  -0.13  0.07 
3  NA  NA  NA  NA  NA 
4  0  -0.15  0  0  0.11 

這裏ROW3都是NA因爲沒有「1」 DF1,所以沒有:

df1: 
ID 2005 2006 2007 2008 2009 
1  NA  NA  0  1  0 
2  NA  NA  0  1  1 
3  0  0  0  NA  0 
4  0  1  0  0  1 

df2: 
ID 2005 2006 2007 2008 2009 
1  NA  0.7  0.98  0.6  0.75 
2  NA  0.2  0.43  0.3  0.5 
3  0.1 -0.98 0.01  0.09 0.1 
4  0.05 -0.1 0.05  0.12 0.23 

我想DF3是減法後如下減法。

我想使用「哪個」函數來確定位置,但前一列的減法使我對它有點複雜。您的幫助將受到高度讚賞。

謝謝。薩巴

+1

恕我直言:這可能有助於說明如何準確一些'計算df3'的價值觀。 – lukeA

+0

你可以說'dput(df1)'和'dput(df2)'? – loki

+0

OP提供了關於df1,df2或df3計算方式的足夠信息(df3中的NA除外)。然而,這不是一個簡單的任務,因爲對於最後的列基值有訂閱超出範圍的情況。我試圖通過矩陣索引獲得解決方案,結果非常麻煩。如果你的數據量不是很大,那麼for循環可能更容易實現。 – dracodoc

回答

-1

我得到的結果是從OP的例子不同,因爲這種情況沒有明確的定義:

df [2,5]和df [2,6]都是1,但OP的df3似乎只以df [2,5]爲基礎,忽略df [2, 6]。我的代碼將使用每個有1個值作爲基礎的地方並減少它。如果OP期望不同的行爲,OP是否可以更清楚地定義此案例的規則?

設置數據

每個步驟
s1 <- "ID 2005 2006 2007 2008 2009 
1  NA  NA  0  1  0 
2  NA  NA  0  1  1 
3  0  0  0  NA  0 
4  0  1  0  0  1" 

s2 <- "ID 2005 2006 2007 2008 2009 
1  NA  0.7  0.98  0.6  0.75 
2  NA  0.2  0.43  0.3  0.5 
3  0.1 -0.98 0.01  0.09 0.1 
4  0.05 -0.1 0.05  0.12 0.23" 
# data.table is only used for reading data, df1 and df2 are regular data.frame 
library(data.table) 
df1 <- fread(s1, header = TRUE, data.table = FALSE) 
df2 <- fread(s2, header = TRUE, data.table = FALSE) 

計算指數,結合所有改變成一個變化矩陣,設定其他位置,以NA。注意我在左側和右側添加了列以避免訂閱出站問題。

# remove the ID column since it also have value of 1 
df1_values <- df1[, 2:ncol(df1)] 
df2_values <- df2[, 2:ncol(df2)] 
# add extra columns to avoid subscription out of bounds 
df1_values <- cbind(0, df1_values, 0, 0) 
df2_values <- cbind(0, df2_values, 0, 0) 
ones_index <- which(df1_values == 1, arr.ind = TRUE) 
one_column_shift <- matrix(c(0, 1), nrow = nrow(ones_index), ncol = 2, byrow = TRUE) 
base_index <- ones_index - one_column_shift 
zero_matrix <- matrix(0, nrow = nrow(df1_values), ncol = ncol(df1_values)) 
base_matrix <- zero_matrix 
base_matrix[base_index] <- df2_values[base_index] 
col2_matrix <- zero_matrix 
col2_matrix[base_index + one_column_shift] <- df2_values[base_index] 
col3_matrix <- zero_matrix 
col3_matrix[base_index + one_column_shift + one_column_shift] <- df2_values[base_index] 
changes_matrix <- base_matrix + col2_matrix + col3_matrix 
changes_matrix[which(changes_matrix == 0, arr.ind = TRUE)] <- NA 
result <- df2_values - changes_matrix 
result <- cbind(ID = df1[, 1], result[, 2:(ncol(result) - 2)]) 

> result 
    ID 2005 2006 2007 2008 2009 
1 1 NA NA 0 -0.38 -0.23 
2 2 NA NA 0 -0.43 -0.23 
3 3 NA NA NA NA NA 
4 4 0 -0.15 0 0.00 0.11 

基準

set.seed(101) 
df1 <- data.frame(1:10000, matrix(sample(c(NA,0,1), 10000*7, replace = TRUE), ncol = 7)) 
df2 <- data.frame(1:10000, matrix(rnorm(10000*7), ncol = 7)) 

Unit: milliseconds 
      expr  min  lq  mean median  uq  max neval 
selected_code 30.28814 37.44009 81.45066 38.27878 41.1185 264.1638 10 
+0

非常感謝代碼..雖然它沒有給出確切的輸出,但我設法通過使用這段代碼的一部分來獲得所需的結果。這真的很有用。謝謝 – Saba

+0

事實上,@dracodoc我真的很感激,如果你有興趣看看下面的鏈接:http://stackoverflow.com/questions/39864565/conditional-subtraction-of-a-cells-value-from-preceding -12細胞觀測。你的詳細的一步一步的編碼確實對我有幫助,因此我正在尋找與鏈接中提到的問題相同的編碼。非常感謝 – Saba

0

這裏是一個快速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 
相關問題