R:使用条件和行、列索引对列求和

R: sum columns using conditionals and row, column indexes

我有一个数据框,其中有很多很多 NA 值散布在感兴趣的列中。这是一个示例:

dput(try[, 30:34])
structure(list(adj_avg_2016 = c(25641966.4, 28919805, 44152549.8, 
4341304.9, 10588244.8, 4928398.6, 8985362.4, 832000, 2674875.2, 
20416846.8), adj_avg_2017 = c(27693728, 29815155, 46187854.8, 
4594589.9, 11021124.8, 5075010, 9436240.8, 848640, 2782821.6, 
21439365.4), adj_avg_2018 = c(31554678.4, 30710505, 45952664, 
NA, NA, NA, NA, 865920, 2894427.2, 21556703.6), adj_avg_2019 = c(33454832, 
31605855, 45590832, NA, 12319764.8, NA, NA, 900480, NA, 
21556703.6), adj_avg_2020 = c(35122520, 32501205, 46495412, NA, 
NA, NA, NA, NA, 3130445.6, 22520553.1)), class = "data.frame", row.names = c(NA, 
10L))

我想做的是根据使用列索引的条件对数据框中的每一列求和try

更具体地说,我想查看上一年的列并仅使用当前和上一年列中非 NA 的元素求和。例如

我想要的结果是每年的列,agg_pass1_2016...agg_pass1_2020 包含指定的计算。

由于数据框每年都会继续增长,而我将在这方面做相当多的工作,因此似乎是可行的方法。这是我到目前为止的想法:

str <- function(df, overwrite = TRUE){
    nms <- grep("adj_avg_[0-9]+$", names(df), value = TRUE) # get the columns
    nms_col_idx <- grep("adj_avg_[0-9]+$", names(df), value = FALSE) # get the column indexes
    revnms <- gsub("adj_avg", "agg_pass1", nms) # names of new columns I want to add
    if(!overwrite) revnms <- setdiff(revnms, names(df))
    df[, revnms] <- lapply(df[, nms], sum, ....) # This is where I get confused.
}

我的problems/questions:

  1. 在上述函数中将行和列索引合并到df[, revnms]以实现所需计算的最佳方法是什么?我知道一种方法会涉及 which(!is.na(.)) 的某种组合,但我不确定如何将其放入最后一行的函数中。

  2. 是否有其他函数可以像函数一样快速简单地实现我的结果?

欢迎所有comments/suggestions。非常感谢。

根据逻辑,我们可能需要将没有第一列和最后一列的数据子集创建的逻辑矩阵相乘,得到colSums

colSums(cbind(try[1], try[-1] * (!is.na(try[-1]) & 
         !is.na(try[-ncol(try)]))), na.rm = TRUE)

-输出

adj_avg_2016 adj_avg_2017 adj_avg_2018 adj_avg_2019 adj_avg_2020 
   151481354    158894530    133534898    133108703    136639690 

或使用tidyverse

library(dplyr)
library(stringr)
try %>%
    summarise(across(everything(),
     ~ if(cur_column() == 'adj_avg_2016') sum(., na.rm = TRUE) 
     else sum(.x[!is.na(.x) &  
      !is.na(get(str_replace(cur_column(), "(\d+)$",
       function(x) as.numeric(x) - 1)))])))
  adj_avg_2016 adj_avg_2017 adj_avg_2018 adj_avg_2019 adj_avg_2020
1    151481354    158894530    133534898    133108703    136639690

如果我们要创建新列,请使用 mutate 而不是 summarise 并使用 .names

try %>%
    mutate(across(everything(),
     ~ if(cur_column() == 'adj_avg_2016') sum(., na.rm = TRUE) 
     else sum(.x[!is.na(.x) &  
      !is.na(get(str_replace(cur_column(), "(\d+)$",
       function(x) as.numeric(x) - 1)))]), 
      .names = "{str_replace(.col, 'avg', 'pass')}"))

-输出

   adj_avg_2016 adj_avg_2017 adj_avg_2018 adj_avg_2019 adj_avg_2020 adj_pass_2016 adj_pass_2017 adj_pass_2018 adj_pass_2019 adj_pass_2020
1      25641966     27693728     31554678     33454832     35122520     151481354     158894530     133534898     133108703     136639690
2      28919805     29815155     30710505     31605855     32501205     151481354     158894530     133534898     133108703     136639690
3      44152550     46187855     45952664     45590832     46495412     151481354     158894530     133534898     133108703     136639690
4       4341305      4594590           NA           NA           NA     151481354     158894530     133534898     133108703     136639690
5      10588245     11021125           NA     12319765           NA     151481354     158894530     133534898     133108703     136639690
6       4928399      5075010           NA           NA           NA     151481354     158894530     133534898     133108703     136639690
7       8985362      9436241           NA           NA           NA     151481354     158894530     133534898     133108703     136639690
8        832000       848640       865920       900480           NA     151481354     158894530     133534898     133108703     136639690
9       2674875      2782822      2894427           NA      3130446     151481354     158894530     133534898     133108703     136639690
10     20416847     21439365     21556704     21556704     22520553     151481354     158894530     133534898     133108703     136639690