挑战在 mutate_at 中替换软已弃用的 funs_()答案

【问题标题】：Challenge Replacing Soft-deprecated funs_() within mutate_at挑战在 mutate_at 中替换软已弃用的 funs_()
【发布时间】：2020-08-09 00:56:05
【问题描述】：

我编写了一个函数，可以为数据框中的变量创建滞后转换。现在由于 dplyr 有软贬值 funs_ 参数，它警告我使用 list 代替 funs_。下面给出的是我的滞后转换函数，它工作正常，但我想使用更新的参数列表对其进行修改。

lagTransformation<- function(ds,n)
{
  # this function creats lag transformation of dataframe
  # args:
  # ds : Dataset
  # n : number of lags

  require(dplyr)
  lags <- seq(n)
  lag_names <- paste("lag", formatC(lags, width = nchar(max(lags)), flag = "0"), sep = "")
  lag_functions <- setNames(paste("dplyr::lag(., ", lags, ")"), lag_names)
  ds <-ds %>% mutate_at(vars(names(ds)), funs_(lag_functions)) %>% select(contains("_lag"))
  return(ds)
}

尝试将 funs_ 替换为 list 但出现错误

lagTransformation<- function(ds,n)
{
  # this function creats lag transformation of dataframe
  # args:
  # ds : Dataset
  # n : number of lags

  require(dplyr)
  lags <- seq(n)
  lag_names <- paste("lag", formatC(lags, width = nchar(max(lags)), flag = "0"), sep = "")
  lag_functions <- setNames(paste("dplyr::lag(., ", lags, ")"), lag_names)
  ds <-ds %>% mutate_at(vars(names(ds)), list(~.lag_functions)) %>% select(contains("_lag"))
  return(ds)
}

get(.x, .env, mode = "function") 中的错误：找不到模式'function'的对象'dplyr::lag(., 1)'

提到了下面的问题，但无法纠正错误

Create new variables with mutate_at while keeping the original ones

我需要什么修改？

【问题讨论】：

paste("dplyr::lag(., ", lags, ")") 除非你 eval parse 否则这是行不通的（eval(parse) 有它自己的缺点）。
也试过eval和parse，结果是一样的。

标签： r dplyr

【解决方案1】：

使用purrr::map设置lag_functions的列表可以这样实现

library(dplyr)
library(purrr)

lagTransformation<- function(ds,n)
{
  # this function creats lag transformation of dataframe
  # args:
  # ds : Dataset
  # n : number of lags

  require(dplyr)
  lags <- seq(n)
  lag_names <- paste("lag", formatC(lags, width = nchar(max(lags)), flag = "0"), sep = "")
  lag_functions <- purrr::map(lags, ~ function(x) dplyr::lag(x, .x)) %>% 
    setNames(lag_names)
  ds <- ds %>% mutate_at(vars(names(ds)), lag_functions) %>% select(contains("_lag"))
  return(ds)
}

lagTransformation(mtcars[1:4], 2) %>% head()
#>   mpg_lag1 cyl_lag1 disp_lag1 hp_lag1 mpg_lag2 cyl_lag2 disp_lag2 hp_lag2
#> 1       NA       NA        NA      NA       NA       NA        NA      NA
#> 2     21.0        6       160     110       NA       NA        NA      NA
#> 3     21.0        6       160     110     21.0        6       160     110
#> 4     22.8        4       108      93     21.0        6       160     110
#> 5     21.4        6       258     110     22.8        4       108      93
#> 6     18.7        8       360     175     21.4        6       258     110

^{由reprex package (v0.3.0) 于 2020 年 4 月 25 日创建}

【讨论】：