purrr::reduce/reduce2 或映射的 mutate_at()？ - 应用于各个列的功能答案

【问题标题】：purrr::reduce/reduce2 or mapped mutate_at()? - functions applied to respective columnpurrr::reduce/reduce2 或映射的 mutate_at()？ - 应用于各个列的功能
【发布时间】：2018-12-24 11:44:17
【问题描述】：

我有一张要应用到各自列的函数图。
有没有类似映射的mutate_at 的东西？

my_map <- 
  data_frame(col = names(iris)[-5],
             calc = rep(c("floor", "ceiling"), 2))
my_map 
# A tibble: 4 x 2
col          calc   
<chr>        <chr>  
Sepal.Length floor  
Sepal.Width  ceiling
Petal.Length floor  
Petal.Width  ceiling

尝试失败：

tbl_df(iris) %>% mutate_at(vars(col_calcs$col), funs_(col_calcs$calc))

Sepal.Length Sepal.Width Petal.Length Petal.Width Species Sepal.Length_floor Sepal.Width_floor Petal.Length_floor Petal.Width_floor Sepal.Length_ceiling
      <dbl>       <dbl>        <dbl>       <dbl> <fct>                <dbl>             <dbl>              <dbl>             <dbl>                <dbl>
       5.1         3.5          1.4         0.2 setosa                   5                 3                  1                 0                    6
       4.9         3            1.4         0.2 setosa                   4                 3                  1                 0                    5

期望的输出：

Sepal.Length Sepal.Width Petal.Length Petal.Width Species
        <dbl>       <dbl>        <dbl>       <dbl> <fct>  
         5.0         4.0          1.0         1.0 setosa 
         4.0         3.0          1.0         1.0 setosa

最后，my_map$calc 可能有未知的功能可以应用。
例如）有人可以将最后一个“楼层”更改为“圆形”。

【问题讨论】：

您似乎根据您认为的最佳答案更改了您的问题，但这有点误导。如果这是原始标题，其他人可能不会首先提交他们的答案。
好点。我在标题问题中添加了 mutate_at() 。谢谢

标签： r reduce purrr dplyr

【解决方案1】：

我认为dplyr::mutate_* 函数没有直接的方法；一种解决方法是使用reduce（或reduce2）函数并用相应的变换函数一一改变列：

library(tidyverse)

reduce2(.x = my_map$col, 
        .y = my_map$calc, 
        .f = function(df, col, f) mutate_at(df, vars(col), f), 
        .init = iris) %>% head(2)

#   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
# 1            5           4            1           1  setosa
# 2            4           3            1           1  setosa

【讨论】：

【解决方案2】：

这是一种使用map2 替换每一列的方法。

library(tidyverse)

iris2 <- iris

iris2[, -5] <- map2(my_map$calc, my_map$col, function(x, y){
  x2 <- eval(parse(text = x))
  y2 <- iris2[[y]]
  result <- x2(y2)
  return(result)
})

head(iris2)
#   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
# 1            5           4            1           1  setosa
# 2            4           3            1           1  setosa
# 3            4           4            1           1  setosa
# 4            4           4            1           1  setosa
# 5            5           4            1           1  setosa
# 6            5           4            1           1  setosa

【讨论】：

我们可以稍微简化一下，首先你可以使用get(x)而不是eval(parse(text=x))，然后我们可以注意到我们可以使用mget，这是get的矢量化版本不同的默认值，我们可以直接在map2调用中使用，最后我们可以使用更简洁的公式表示法，得到：iris2[-5] <- map2(mget(my_map$calc,inherits =TRUE), my_map$col, ~ .x(iris[[.y]]))。这可以很容易地转化为一个简洁的基础解决方案：iris2[-5] <- Map(function(x, y) x(iris[[y]]), mget(my_map$calc,inherits =TRUE), my_map$col)
@Moody_Mudskipper 感谢您分享您的好解决方案。

【解决方案3】：

如果我们假设你想取floor函数的所有变量都包含相同的字符，即Length，并且你想取ceiling函数的所有变量都包含相同的字符，即Width，那么我们可以应用如下代码：

library(tidyverse)
iris %>% 
  mutate_at(vars(ends_with("Length")), funs(floor)) %>% 
  mutate_at(vars(ends_with("Width")), funs(ceiling))

#   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
# 1            5           4            1           1  setosa
# 2            4           3            1           1  setosa

【讨论】：

【解决方案4】：

虽然冗长，但我发现以下非常可读且简单的地图实现：

iris2 <- iris %>% 
    mutate(id = 1:n()) %>%
    gather(key = col, value, my_map$col ) %>%
    full_join(my_map, by = "col") %>%
    mutate(value = invoke_map(.f = calc, .x = value)) %>%
    unnest() %>%
    select(-calc) %>
    spread(col, value) %>%
    select(-id)

head(iris2)
#    Species Petal.Length Petal.Width Sepal.Length Sepal.Width
# 1  setosa            1           1            5           4
# 2  setosa            1           1            4           3
# 3  setosa            1           1            4           4
# 4  setosa            1           1            4           4
# 5  setosa            1           1            5           4

【讨论】：

【解决方案5】：

我们可以从my_map 开始：

library(tidyverse)
map2(my_map$col,my_map$calc,~transmute_at(iris,.x,.y)) %>%
  bind_cols(iris[!names(iris) %in% my_map$col]) %>% # or less general: iris[-5]  
  head

#   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
# 1            5           4            1           1  setosa
# 2            4           3            1           1  setosa
# 3            4           4            1           1  setosa
# 4            4           4            1           1  setosa
# 5            5           4            1           1  setosa
# 6            5           4            1           1  setosa

【讨论】：