logo标签列表

查找满足条件的最接近当前行的值，并对每个组应用函数

rdata.tabletidyverse
4

我希望能够按组为每一行进行简单的计算，但是我需要参考符合特定条件的以前的行。我想创建一个新变量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和/或fill，但不确定如何在这里使用。如果我对前一行进行计算，则可以使用lag，但不确定如何搜索多个上面的值。我可以使用base R、data.table、tidyverse或其他解决方案。

4个回答
5
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
2

使用 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
谢谢。当我运行它时，出现以下错误：Error in fifelse(x.id < id, i.value * value, NA) : 'yes' is of type double but 'no' is of type logical. Please make sure that both arguments have the same type. - AndrewGB
1
在我的环境中使用示例数据集可以正常工作，但请注意我的编辑：强制使用 NA_REAL_。 - Waldi
搞定了！但是如果我在数据表的不同迭代上运行它（即 df$code[3] <- 1），那么我就得不到正确的输出。例如，第3行应该是44，但是却出现了一个NA。 - AndrewGB
1
使用data.table的类似解决方案，根据微基准测试可能会快10倍。 - Waldi
1
我正在添加第二个示例数据集，以展示更改标记的影响（使第三行有效以进行乘法）：
df2 <- df
df2$code[3] <- 1

目的是过滤数据框中有效的行以用于计算结果，重新加入原始数据框，使用fill来传播最后一个有效值。在连接的数据框中将id加1，因为这将是第一个可以使用该值的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

额外脆/第三行已更改

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
0

我猜纯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
谢谢，这个例子可以运行。但是，如果我在数据框的不同迭代上运行它（即df1$code[3] <- 1），那么我就得不到正确的输出了。对于那个，第三行没有返回值。 - AndrewGB
你在修改 df1$code[3]<- 1 后更新了 logi 对象吗？这样应该也可以。 - BrunoPLC
是的，我做了。我认为问题在第二个if语句中，即logi[i] == FALSE。基本上，如果有两个相邻的Y标签也具有有效代码（即不是NA），则它不会计算带有Y的行，因为该行的logi将为TRUE。 - AndrewGB
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接