Как я могу передать несколько функций в purr :: map (exec или invoke_map), когда функция использует столбцы enquo? - PullRequest
1 голос
/ 28 октября 2019

Я получаю следующую ошибку, когда пытаюсь передать аргументы в функцию, которая использует enquo ().

"Ошибка: кавычки можно заключать в кавычки только в контексте квазиквотации."

В приведенном ниже примере функция

Wrap1 использует map для запуска нескольких наборов аргументов для одной функции,Передача переменных с помощью !! enquo () работает.

Wrap 2 пытается передать несколько функций и аргументов, но я не могу получить правильный синтаксис.

  1. Есть ли проблема с тем, как я передаю (порядок в функциях exec или invoke_map, или как столбцы передаются с помощью !! enquo (cols)?

  2. Есть ли способ передать дополнительные переменные в invoke_map или они являются общими для всех, кроме списка параметров (аналогично использованию частичного в приведенном ниже коде wrap1)?

library(dplyr)  
library(lubridate)  
library(purrr)   
library(rlang)   
library(rkt)

dataset <- tibble(Date= lubridate::decimal_date(seq(as.Date("2000/1/1"), by = "month", length.out = 120)),
                  Value = rnorm(120), 
                  season = lubridate::month(seq(as.Date("2000/1/1"), by = "month", length.out = 120)))

#inner function
run1_fun <- function(df, yCOL, datesCOL, seasCOL=NULL,  ind.obs=TRUE){

   y <- df %>% pull(!!enquo(yCOL))
   dates <- df %>% pull(!!enquo(datesCOL))

  mk <- rlang::quo_is_null(enquo(seasCOL))

  if(mk){

    seas <- rep(1, length(y))  #just so can get nseas=1 later

    smk <- rkt::rkt(date=dates, y=y)

  }else{

    seas <- df %>% pull(!!enquo(seasCOL))

    smk <- rkt::rkt(date=dates, y=y, block=seas, correct = !ind.obs)

  }
out <- tibble(tau = smk$tau, 
              slope = smk$B, 
              type = ifelse(mk, "MK", "SK"))

out
}

#inner function with by option
run1_fun_by <- function(df, by=NULL, yCOL, datesCOL, seasCOL=NULL,  ind.obs=TRUE){

    if(is.null(by)) {
      df <- run1_fun(df, !!enquo(yCOL), !!enquo(datesCOL), !!enquo(seasCOL),ind.obs)
  } else {
    df <- plyr::ddply(df, .variables = by, 
                     .fun = run1_fun, !!enquo(yCOL), !!enquo(datesCOL), !!enquo(seasCOL),ind.obs)
  }
  df
}

#to run:
run1_fun_by(dataset, by="season", Value, Date, ind.obs=TRUE)

#WRAP 1: WORKS
# example of wrap function that passing multiple arguments sets to the above inner function that uses enquo variables. 
wrap1 <- function(df, yCOL, datesCOL, seasCOL=NULL,  ind.obs=TRUE, 
                  ttype=c("MK", "SK")){

  fun_args <- partial(run1_fun, df=df, yCOL = !!enquo(yCOL), datesCOL =  !!enquo(datesCOL), ind.obs=ind.obs)

  #fun_args - order in "SK", "MK"  
  keep <- which(c("SK", "MK") %in% ttype)
  args <- list(seasCOL = dplyr::vars(!!enquo(seasCOL), NULL)[keep])   # didnt work with alist..
  #args <-tibble(seasCOL = dplyr::vars(!!enquo(seasCOL), NULL)[keep])  #works too
  res <- purrr::pmap_dfr(args, fun_args)

  res
}
#to run: 
wrap1(dataset, Value, Date, season, ind.obs=TRUE, ttype=c("MK", "SK"))

#WRAP 2: DOESN'T WORK
#attempt to iterate through multiple functions and argument sets (where functions requires enquo arguments)
using either invoke_map or exec?

wrap2 <- function(df, yCOL, datesCOL, seasCOL=NULL,  ind.obs=TRUE, 
                  ttype=c("MK", "SK", "MKSeas")){

  t <- c("SK", "MK", "MKSeas")

   #HOW CAN I PASS (which are enq in next function)
    sim <- tribble(
   ~f,               ~params,
  "run1_fun",        list(seasCOL = dplyr::vars(!!enquo(seasCOL)), ind.obs=ind.obs),   #SK
  "run1_fun",        list(seasCOL = dplyr::vars(NULL)),                                      #MK
  "run1_fun_by",     list(by="season"))                                                #MKSeas

  #with invoke_map - but looks like this is retired 
  res  <- invoke_map_dfc(sim$f, sim$params, df=df, yCOL=!!enquo(yCOL), datesCOL=!!enquo(datesCOL)) 

  #with exec - new
  #res <-  map2_dfc(sim$f, sim$params, function(fn, args) exec(fn, !!!args))

  res  
}

#to run
wrap2(dataset, Value, Date, season, ind.obs=TRUE, ttype=c("MK", "SK", "MKSeas"))

Ошибка: кавычки можно не заключать в кавычки только в контексте квази-цитаты.

# Bad: list (!! myquosure)

# Good: dplyr :: mutate (data, !! myquosure) Вызовите rlang::last_error(), чтобы увидеть обратную трассировку. Вызывается из: abort (paste_line («Кавычки можно заключать в кавычки только в контексте квазиквотации.», «», «# Bad:», «list (!! myquosure)«, »», "# Good:", "dplyr :: mutate (data, !! myquosure)")

1 Ответ

1 голос
/ 29 октября 2019

Используйте rlang::call2, чтобы составить нужные вызовы функций, а затем оценить их.

Кроме того, поскольку вы работаете с именами столбцов, правильный глагол NSE равен ensym(), а не enquo(). Первый захватывает символические имена и работает со строками. Последний захватывает выражение и его контекст. В этом случае контекст - это фрейм данных, который уже передается непосредственно в функцию, тогда как enquo() захватывает глобальную среду (что неверно).

wrap2 <- function(df, yCOL, datesCOL, seasCOL=NULL,  ind.obs=TRUE,
                  ttype=c("MK", "SK", "MKSeas")){

  sim <- tribble(
          ~f,             ~params,
          "run1_fun",     list(seasCOL = ensym(seasCOL), ind.obs=ind.obs),  #SK
          "run1_fun",     list(seasCOL = NULL),                             #MK
          "run1_fun_by",  list(by="season"))                                #MKSeas

  # Concatenate common arguments to each list of parameters
  myArgs <- map( sim$params, c, yCOL=ensym(yCOL), datesCOL=ensym(datesCOL) )

  # Compose the function calls
  calls <- map2( sim$f, myArgs, ~rlang::call2(.x, !!!.y, df=df) )

  # Evaluate the function calls and aggregate the results
  map_dfr( calls, eval )
}

wrap2(dataset, Value, Date, season, ind.obs=TRUE, ttype=c("MK", "SK", "MKSeas"))
# # A tibble: 14 x 4
#        tau   slope type  season
#      <dbl>   <dbl> <chr>  <dbl>
#  1 -0.0259 -0.0180 SK        NA
#  2 -0.0255 -0.0151 MK        NA
#  3  0.2     0.0743 MK         1
#  4 -0.378  -0.162  MK         2
#  5 -0.0222 -0.0505 MK         3
# ...
...