Apply computations basing on column name pattern

Viewed 23

How do I apply computations on data frame columns basing on name patterns. I'm looking for a more R-like solution / more readable code:

df <- data.frame(xA1 = sample(x = 1:4, size = 10, replace = TRUE),
                 yA1 = sample(x = 1:4, size = 10, replace = TRUE),
                 xA2 = sample(x = 1:4, size = 10, replace = TRUE),
                 yA2 = sample(x = 1:4, size = 10, replace = TRUE),
                 xB1 = sample(x = 1:4, size = 10, replace = TRUE),
                 yB1 = sample(x = 1:4, size = 10, replace = TRUE),
                 xB2 = sample(x = 1:4, size = 10, replace = TRUE),
                 yB2 = sample(x = 1:4, size = 10, replace = TRUE))

# df$A1 <- weighted.mean(x = c(df$xA1, df$yA1),
#                        w = c(0.25, 0.75))
# repeat for A2, B1, B2

for (middle in c('A', 'B')) {
 for (right in 1:2) {
  df[paste0(middle, right)] <- apply(X = subset(df, select = c(paste0('x', middle, right), paste0('y', middle, right))),
                                     MARGIN = 1,
                                     FUN = weighted.mean,
                                     w = c(0.25, 0.75))
 }
}
1 Answers

This is substantially longer, but arguably more readable if you don't mind a tidyverse approach:

bind_cols(df,

  # reshape long into multiple columns for xy, grp, and num
  df %>% mutate(row = row_number()) %>%
    pivot_longer(-row, names_to = c("xy","grp", "num"), names_pattern = "(.)(.)(.)") %>%

    # calculate weighted sum for each row/grp/num combination
    group_by(row, grp, num) %>%
    summarize(wtd_sum = sum(value * if_else(xy == "x", 0.25, 0.75))) %>%
    ungroup() %>% 

    # reshape wide
    select(-row) %>%
    pivot_wider(names_from = c(grp, num), values_from = wtd_sum)
)
Related