применить функцию к динамически измененному количеству столбцов для каждой строки

Question

У меня есть список:

pr <- list(x = c("a", "b", "c"),
           y = c("a", "b"),
           z = c("a"))

и фрейм данных df:

> dput(df)
structure(list(m = c("x", "y", "x", "y", "x", "x", "z", "y", 
"z"), order = c(2, 3, 0, 0, 0, 0, 2, 0, 0), a = c(0, 0, -1, -1, 
0, 0, 0, -1, -1), b = c(0, 0, 0, 0, -1, 0, 0, 0, 0), c = c(0, 
0, 0, 0, 0, -1, 0, 0, 0)), .Names = c("m", "order", "a", "b", 
"c"), row.names = c(NA, -9L), class = c("tbl_df", "tbl", "data.frame"
))

, который выглядит следующим образом

> dff
# A tibble: 9 x 5
  m     order     a     b     c
  <chr> <dbl> <dbl> <dbl> <dbl>
1 x      2.00  0     0     0   
2 y      3.00  0     0     0   
3 x      0    -1.00  0     0   
4 y      0    -1.00  0     0   
5 x      0     0    -1.00  0   
6 x      0     0     0    -1.00
7 z      2.00  0     0     0   
8 y      0    -1.00  0     0   
9 z      0    -1.00  0     0

Теперь, еслизначение в order равно больше , чем ноль, проверьте соответствующее значение в m и добавьте order -значение только к тем столбцам , названия которых соответствуют до значения m в списке pr.

Итак, желаемый вывод должен выглядеть так:

  m     order     a     b     c
  <chr> <dbl> <dbl> <dbl> <dbl>
1 x      2.00  2.00  2.00  2.00   (since x = c("a", "b", "c")
2 y      3.00  3.00  3.00  0      (since y = c("a", "b")
3 x      0    -1.00  0     0   
4 y      0    -1.00  0     0   
5 x      0     0    -1.00  0   
6 x      0     0     0    -1.00
7 z      2.00  2.00  0     0      (since z = c("a")
8 y      0    -1.00  0     0   
9 z      0    -1.00  0     0

Я пытался атаковать это с помощью mutate_at, quosures, !! но теперь я застрял.

Любая помощь будет очень цениться.Заранее спасибо!

Answer 1

Проблема не кажется простой, поэтому мое решение не очень изящно:

df %>% mutate(row = row_number()) %>% 
  gather(key, value, -m, -order, -row) %>%
  mutate(value = value + order * (order > 0 & mapply(`%in%`, key, pr[m]))) %>% 
  spread(key, value) %>% select(-row)

Сначала я определяю row как вспомогательную переменную для использования spread позже.Теперь, когда все значения a, b, c находятся в одном столбце, можно использовать просто mutate.Затем мы вернемся.

Простое использование цикла, я думаю, является более кратким, чем большинство, если не все решения в этом случае:

for(r in which(df$order > 0))
  df[r, pr[[df$m[r]]]] <- df[r, pr[[df$m[r]]]] + df$order[r]

Обратите внимание, что ни одно из решений не упоминает a,b, c, поэтому большое количество столбцов не является проблемой.

Answer 2

Как насчет:

library(tidyverse)

dynamic_function <- function(df, list_var, m_var, order_var, ...) {

group_var <- quos(...)
order_var <- enquo(order_var)

byvar1 <- enquo(m_var)
byvar2 <- "key"
by <- setNames(quo_name(byvar2), quo_name(byvar1))

list_var <- data.frame(sapply(list_var, '[', seq(max(lengths(list_var))))) %>%
  gather() %>% na.omit()

df_gathered <- df %>%
  mutate(rown = row_number()) %>%
  gather(key, value, !!! group_var) %>%
  left_join(list_var, by = by) %>%
  filter(key == value.y) %>%
  group_by(!! byvar1, !! order_var) %>%
  mutate(
    value = case_when(
      !! order_var > 0  ~ !! order_var,
      TRUE ~ value.x
    )
  ) %>% ungroup() %>% distinct(!! byvar1, !! order_var, key, value, rown) %>%
  spread(key, value) %>% 
  group_by(!! byvar1, !! order_var, rown) %>%
  replace(., is.na(.), 0) %>%
  summarise_at(vars(!!! group_var), funs(sum)) %>%
  arrange(rown) %>% select(-rown) %>% ungroup()

return(df_gathered)

}

Вы можете вызвать эту функцию следующим образом:

dfs <- dynamic_function(df, list_var = pr, m_var = m, order_var = order, a, b, c)

Где df - это имя вашего информационного кадра, list_var - это ваше имя списка, m_var - это имя столбца m, order_var - это имя столбца заказа, а a, b, c - это нужные вам динамические столбцы (вы можете добавить d, e, f ...).

Вывод:

# A tibble: 9 x 5
  m     order     a     b     c
  <chr> <dbl> <dbl> <dbl> <dbl>
1 x         2     2     2     2
2 y         3     3     3     0
3 x         0    -1     0     0
4 y         0    -1     0     0
5 x         0     0    -1     0
6 x         0     0     0    -1
7 z         2     2     0     0
8 y         0    -1     0     0
9 z         0    -1     0     0

Вы получите предупреждение об атрибутах, которые вы можете игнорировать.