2016-10-01 174 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 
相关问题