Испытание Замена мягко-устаревшего funs_ () в mutate_at - PullRequest
2 голосов
/ 25 апреля 2020

Я написал функцию, которая создает преобразование запаздывания для переменных во фрейме данных. Теперь, когда dplyr имеет мягкий устаревший аргумент funs_, он дает мне предупреждение использовать список вместо 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_ списком, но с ошибкой

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"): object 'dplyr :: lag (., 1) 'режима' функция 'не найдена

см. Вопрос ниже, но не может исправить ошибку

Создать новые переменные с помощью mutate_at, сохранив при этом исходные

какая модификация мне нужна?

1 Ответ

1 голос
/ 25 апреля 2020

Использование 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

Создано в 2020-04-25 с помощью пакета contex (v0.3.0)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...