在满足条件的当前行上方找到最接近的值并为每个组应用函数

Find closest value above current row that meets condition and apply function for each group

我想对每一行按组做一个简单的计算,但我需要引用满足某些条件的前一行。我想创建一个新变量 results。对于每组中的每一行,我想在 tag == "Y"code 不是 NA 的上方找到最近的行。然后,我想使用该行中的 value,并乘以当前行中的值。

最小示例

df <- structure(list(name = c("apples", "apples", "apples", "apples", 
                              "oranges", "oranges", "oranges", "oranges"), 
               id = 1:8, 
               tag = c("X", "Y", "Y", "X", "X", "Y", "X", "X"), 
               code = c(1, 1, NA, 1, NA, 1, NA, NA),
               value = c(1, 11, 4, 3, 9, 5, 7, 8)), 
          class = "data.frame", row.names = c(NA, -8L))

     name id tag code value
1  apples  1   X    1     1
2  apples  2   Y    1    11
3  apples  3   Y   NA     4
4  apples  4   X    1     3
5 oranges  5   X   NA     9
6 oranges  6   Y    1     5
7 oranges  7   X   NA     7
8 oranges  8   X   NA     8

预期输出

例如,对于第 3 行,第 2 行将是最接近满足条件的行,因此将 4 乘以 11(得到 44)。对于第 4 行,第 3 行不满足条件,所以我们转到第 2 行,并将 3 乘以 11(得到 33)。等等。

     name id tag code value results
1  apples  1   X    1     1      NA
2  apples  2   Y    1    11      NA
3  apples  3   Y   NA     4      44
4  apples  4   X    1     3      33
5 oranges  5   X   NA     9      NA
6 oranges  6   Y    1     5      NA
7 oranges  7   X   NA     7      35
8 oranges  8   X   NA     8      40

我猜我需要使用 cumsum and/or fill,但不确定如何在这里使用它。我知道如果我对前一行进行计算,那么我可以使用 lag,但不确定如何搜索上面的多个值。我对基础 R、data.tabletidyverse 或其他解决方案持开放态度。

我正在添加第二个示例数据集以显示更改标签的影响(使第 3 行对乘法有效):

df2 <- df
df2$code[3] <- 1

目的是将data.frame过滤为计算结果中使用的有效行,加入原始data.frame,并使用fill传播最后一个有效值.您将一个添加到加入的 data.frame 中的 id,因为这将是该值可有效使用的第一个 ID。如果 id 在实际数据中不是连续的,则需要添加一个带有行号的虚拟列。

为了显示更改数据的影响,定义函数:

computeResults <- function(data) {
  left_join(
      data,
      data %>% 
        filter(tag == "Y" & !is.na(code)) %>% 
        mutate(id = id + 1) %>% 
        select(name, id, prevVal = value),
      by = c("name", "id"),
      copy = TRUE
    ) %>% 
    group_by(name) %>% 
    tidyr::fill(prevVal) %>% 
    mutate(results = value * prevVal) %>% 
    select(name, id, tag, code, value, results)
}

原配方

computeResults(df)
#> # A tibble: 8 x 6
#> # Groups:   name [2]
#>   name       id tag    code value results
#>   <chr>   <dbl> <chr> <dbl> <dbl>   <dbl>
#> 1 apples      1 X         1     1      NA
#> 2 apples      2 Y         1    11      NA
#> 3 apples      3 Y        NA     4      44
#> 4 apples      4 X         1     3      33
#> 5 oranges     5 X        NA     9      NA
#> 6 oranges     6 Y         1     5      NA
#> 7 oranges     7 X        NA     7      35
#> 8 oranges     8 X        NA     8      40

额外 crispy/row 3 已更改

computeResults(df2)
#> # A tibble: 8 x 6
#> # Groups:   name [2]
#>   name       id tag    code value results
#>   <chr>   <dbl> <chr> <dbl> <dbl>   <dbl>
#> 1 apples      1 X         1     1      NA
#> 2 apples      2 Y         1    11      NA
#> 3 apples      3 Y         1     4      44
#> 4 apples      4 X         1     3      12
#> 5 oranges     5 X        NA     9      NA
#> 6 oranges     6 Y         1     5      NA
#> 7 oranges     7 X        NA     7      35
#> 8 oranges     8 X        NA     8      40

我想基本的 R 方法可能是:

df1<-df
df1$results<-NA

logi<-df1$tag=="Y" & is.na(df1$code)==FALSE

for (i in 1:length(logi)){
  
  if(i == 1 & logi[i] == FALSE){
    }else{
      
      if(logi[i] == FALSE & logi[i-1]==TRUE & logi[i+1]==FALSE){
        
        df1$results[i]<-df1$value[i]*df1$value[i-1]
        
        df1$results[i+1]<-df1$value[i+1]*df1$value[i-1]
      }
    }
  }


> df1
     name id tag code value results
1  apples  1   X    1     1      NA
2  apples  2   Y    1    11      NA
3  apples  3   Y   NA     4      44
4  apples  4   X    1     3      33
5 oranges  5   X   NA     9      NA
6 oranges  6   Y    1     5      NA
7 oranges  7   X   NA     7      35
8 oranges  8   X   NA     8      40
df %>% 
  group_by(name) %>%
  mutate(t = na_if(lag(value * (tag == 'Y' & !is.na(code))), 0)) %>%
  fill(t) %>%
  mutate(results = t * value)

# A tibble: 8 x 7
# Groups:   name [2]
  name       id tag    code value     t results
  <chr>   <int> <chr> <dbl> <dbl> <dbl>   <dbl>
1 apples      1 X         1     1    NA      NA
2 apples      2 Y         1    11    NA      NA
3 apples      3 Y        NA     4    11      44
4 apples      4 X         1     3    11      33
5 oranges     5 X        NA     9    NA      NA
6 oranges     6 Y         1     5    NA      NA
7 oranges     7 X        NA     7     5      35
8 oranges     8 X        NA     8     5      40

data.table:

library(data.table)
setDT(df)

df[,result:=value*shift(nafill(fifelse(tag=='Y'&!is.na(code),value,NA),type = 'locf')), 
   by=name][]

      name    id    tag  code value result
    <char> <int> <char> <num> <num>  <num>
1:  apples     1      X     1     1     NA
2:  apples     2      Y     1    11     NA
3:  apples     3      Y    NA     4     44
4:  apples     4      X     1     3     33
5: oranges     5      X    NA     9     NA
6: oranges     6      Y     1     5     NA
7: oranges     7      X    NA     7     35
8: oranges     8      X    NA     8     40