如何使用 apply() 或等效函数对当前和相邻数据框行执行数学运算?

How to use an apply() or equivalent function to perform math operations on current and adjacent data frame rows?

我正在对数据框行执行简单的按列数学运算,这些操作还涉及访问相邻的、先前的数据框行。虽然下面的代码有效,但它很麻烦(至少就我对 cbind()subset() 函数的自由使用而言)我想知道是否有一种干净的方法可以使用 [=14= 获得相同的结果] 或其他超级 duper R 函数。如果可能,在 base R 中。

我在每个数据框行中添加和减去列值(参考下面的列,“plus1”+“plus 2”-“minus”=“total”),如果 id 号是与从一行向下移动到下一行相同,添加前一行的 plus1。见下图:

  id   plus1 plus2 minus total [total explained]
1  1     3     5    10    -2
2  2     4     5     9     0
3  3     8     5     8     5   [8 + 5 - 8 = 5, ignoring "plus1" in row 2 since "id" changed between rows 2 and 3]
4  3     1     4     7     6   [1 + 4 - 7, + 8 from "plus1" col in row 3 since "id" is same in rows 3 and 4, = 6]
5  3     2     5     6     2   [2 + 5 - 6, + 1 from "plus1" col in row 4 since "id" is same in rows 4 and 5, = 2]
6  5     3     6     5     4   [3 + 6 - 5 = 4, ignoring "plus1" in row 5 since "id" changed between rows 5 and 6]

这是我用来生成上面的代码:

data <- data.frame(id=c(1,2,3,3,3,5), 
                   plus1=c(3,4,8,1,2,3), 
                   plus2=c(5,5,5,4,5,6),
                   minus = c(10,9,8,7,6,5))

data <- cbind(data,
              tmp1=(data[ ,"plus1"] +
                    data[ ,"plus2"] -
                    data[ ,"minus"]
                   )
              )

grp <- with(rle(data$id), rep(seq_along(values), lengths))
data$tmp2 <- with(data,ave(plus1, grp, FUN = function(x) c(0, x[-length(x)])))

data <- cbind(data, total = round((data[ ,"tmp1"] + data[ ,"tmp2"]),2))
data <- subset(data, select = -c(tmp1,tmp2) )
data

我在 apply() 的世界里追求简单,因为我将在我当前的项目中使用很多此类东西的派生。看起来我在 R 中模仿 Excel,我就是。

我认为一个简单的方法是使用 lag function from dplyr 包。我使用 case_when 检查 id 是否更改。如果没有变化,则添加额外的项,否则添加 0。

library(dplyr)

data2<-data %>%
  mutate(extra=case_when(
    id==lag(id) ~ lag(plus1), 
    TRUE ~ 0
  )) %>%
  mutate(computed_total=plus1+plus2-minus+extra)

这是一个基本的 R 解决方案,但没有 apply,因此可能不可接受,尽管它看起来没有 OP 的代码复杂。

不确定应用系列(请原谅双关语)是否适用于这种情况,因为我的理解是通常函数应用于所有列、行或列表元素,而在这种情况下,一个新变量被创建。但是,我不太熟悉apply和friends的使用,所以这可能不正确。

通过比较添加了一个 dplyr 解决方案,尽管我知道 OP 专门要求基本 R。


data$lag_id <- c(0, data$id[-nrow(data)])
data$lag_plus1 <- c(NA, data$plus1[-nrow(data)])

data$total <- with(data, ifelse(id == lag_id, plus1 + plus2 - minus + lag_plus1, plus1 + plus2 - minus))

data[ , -c(5:6)]
#>   id plus1 plus2 minus total
#> 1  1     3     5    10    -2
#> 2  2     4     5     9     0
#> 3  3     8     5     8     5
#> 4  3     1     4     7     6
#> 5  3     2     5     6     2
#> 6  5     3     6     5     4



library(dplyr)

data %>% 
  mutate(total = case_when(id == lag(id) ~ plus1 + plus2 - minus + lag(plus1),
                          TRUE ~ plus1 + plus2 - minus))
#>   id plus1 plus2 minus total
#> 1  1     3     5    10    -2
#> 2  2     4     5     9     0
#> 3  3     8     5     8     5
#> 4  3     1     4     7     6
#> 5  3     2     5     6     2
#> 6  5     3     6     5     4

reprex package (v2.0.1)

于 2021-12-11 创建