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，等价物!!来对此进行攻击，但现在我陷入了困境。

任何帮助将不胜感激。预先谢谢你！

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是订单列的名称，{ {1}}是您想要的动态列（您可以添加a, b, c ...）。

输出：

d, e, f

您将收到有关可以忽略的属性的警告。

将功能应用于动态更改的每一行的列数

2 个答案: