rtidyverse

Is there an R function to calculate row sums using a range/window of column indices?

Is there a way to calculate the sum (or mean, etc.) for a range of values that are defined for that row in another column?

Here's some sample data:

structure(list(start = c("cmi_apr", "cmi_may", "cmi_may"), end = c("cmi_oct", 
"cmi_oct", "cmi_dec"), cmi_jan = c(2.35, 2.24, 37.66), cmi_feb = c(1.33, 
5.65, 43.23), cmi_mar = c(0.08, 4.43, 22.2), cmi_apr = c(0.17, 
6.48, 18.56), cmi_may = c(-5.61, 0.54, 21.52), cmi_jun = c(-6.37, 
-0.92, 13.86), cmi_jul = c(-6.53, 5.18, 2.81), cmi_aug = c(-2.37, 
4.4, 21.32), cmi_sep = c(1.28, 0.92, 19.48), cmi_oct = c(0.33, 
11.21, 26.43), cmi_nov = c(1.41, 9.18, 43.87), cmi_dec = c(2.21, 
10.96, 30.54)), row.names = c(NA, -3L), class = c("tbl_df", "tbl", 
"data.frame"))

I want to generate range sums based on the start and end variable like this:

enter image description here

I have a solution, however my real dataset has over 60,000 rows and it takes way too long to complete the calculation. I figure this should be a lot faster since addition is vectorized. Here's my current solution:

compute_growing_season <- function(df, start_colname, end_colname, FUN) {
  # Generate column index vectors
  start_idx = sapply(start_colname, function(x) { which(x == names(df))} )
  end_idx = sapply(end_colname, function(x) { which(x == names(df))} )
  
  # Generate computed vector
  results <- numeric(nrow(df))
  for (i in 1:nrow(df)) {
    results[i] <- FUN(df[i, start_idx[i]:end_idx[i]], na.rm = F)
  }
  
  return(results)
}

output <- sample %>%
  mutate(
    cmi_growingseason_sum = compute_growing_season(., start, end, sum)
  )
Solution

  • There might be better names than sample for a tibble. In dplyr syntax (data and code suggest you are already using those packages), you might want to start developing something from here. Staying in long format may bring advantages.

    library(tidyr)
library(dplyr)

sample |>
  rename_with(~sub('^cmi_', '', .), starts_with('cmi')) |>
  mutate(row = row_number(), start = sub('^cmi_', '', start), 
         end = sub('^cmi_', '', end), .before = start) |>
  pivot_longer(cols = -c(row, start, end), names_to = 'month', values_to = 'value') |>
  mutate(across(c(start, end, month), ~match(., tolower(month.abb)), .names = '{.col}_i')) |>
  mutate(gs_sum = sum(value[between(month_i, start_i, end_i)]), .by = row) |>
  pivot_wider(id_cols = -ends_with('_i'), names_from = 'month', values_from = 'value')

    # A tibble: 3 × 15
  start end   gs_sum   jan   feb   mar   apr   may   jun   jul   aug   sep   oct   nov   dec
  <chr> <chr>  <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 apr   oct    -19.1  2.35  1.33  0.08  0.17 -5.61 -6.37 -6.53 -2.37  1.28  0.33  1.41  2.21
2 may   oct     21.3  2.24  5.65  4.43  6.48  0.54 -0.92  5.18  4.4   0.92 11.2   9.18 11.0 
3 may   dec    180.  37.7  43.2  22.2  18.6  21.5  13.9   2.81 21.3  19.5  26.4  43.9  30.5

    If you like the idea of going from wide to long back to wide. Surely, there is room for optimisation, but not needed at 60k rows. Included some re-arrangements: removing cmi-prefix; if you need it, keep it instead.

    Base R. (1) Reshaping (might be useful later), (2) Months to integer representation and aggregation.

    names(sample) = sub('^cmi_', '', names(sample))
sample[c('start', 'end')] = lapply(sample[c('start', 'end')], 
  \(i) match(sub('^cmi_', '', i), tolower(month.abb)))

reshape(as.data.frame(sample), varying=tolower(month.abb),  
        v.names='value', timevar='month', direction='l') |>
  subset(month >= start & month <= end) |>
  aggregate(value~id, data=_, sum) # id = row
## or aggregate(cbind(gs_sum=value)~cbind(row=id), data=_, sum) to re-name

      id  value
1  1 -19.10
2  2  21.33
3  3 179.83