How to use purrr::pmap to invoke a user-defined function in R

Viewed 244

I want to invoke the function wrap_vr using map or pmap of the purrr library.

First, I don't understand why I have to use df$v1 and df$v2 to pass the variables to the function. Why not v1 and v2 only?

Second, what is my error when I tried to use pmap?

library(tidyverse)

df <- tibble(cy = c('a', 'a', 'b', 'b'),
             date = c(1,2,1,2),
             v1 = c(1,2,3,1),
             v2 = c(5,3,2,1))

wrap_vr <- function(df, vr, tit, ylab){
  ggplot(data = df, aes(date, all_of(vr))) +
    geom_line(color = "steelblue", size = 1) +
    labs(title =  tit,
         y = ylab, x = "") +
    facet_wrap(~ cy)
}

wrap_vr(df, df$v1, "title_1", "ylabel_1")


wrap_vr(df, df$v2, "title_2", "ylabel_2")


list_1 <- list(df, list(df$v1, df$v2), list("title_1", "title_2"), list("ylabel_1", "ylabel_2"))

# This gives an error
pmap(list_1, ~wrap_vr(.x))
#> Error: Element 2 of `.l` must have length 1 or 4, not 2
Created on 2021-07-06 by the reprex package (v2.0.0)
3 Answers

Changing a couple of things in your code fixes this problem. First, your dataset shouldn't be read as a list, so you can take that out of list_1.

list_1 <- list(list(df$v1, df$v2), list("title_1", "title_2"), list("ylabel_1", "ylabel_2"))

From there, you can phrase your pmap call like this to get the results you're after:

pmap(list_1, ~wrap_vr(df, ..1, ..2, ..3))

Apart from the two problems listed there is one more problem, you are passing date and cy columns as constant assuming that it will always be there.
Nevertheless, my suggestion is to use these columns as default names.

so

  • your first problem can be tackled using .data[[vars]]
  • your second problem can be tackled by removing df from the list
  • additionally, your custom_function is suggested to be modified further by using two more argument albeit with default values.
  • Also suggested to use df argument in last with a default value
  • Thus, in your function you'll have to pass it three arguments, others will use default values.

Demo

library(tidyverse)

df <- tibble(cy = c('a', 'a', 'b', 'b'),
             date = c(1,2,1,2),
             v1 = c(1,2,3,1),
             v2 = c(5,3,2,1))

wrap_vr <- function( vr, tit, ylab, c1 = 'date', c2 = 'cy', df = df){
  df %>% ggplot(aes(.data[[c1]], .data[[vr]])) +
    geom_line(color = "steelblue", size = 1) +
    labs(title =  tit,
         y = ylab, x = "") +
    facet_wrap(~ .data[[c2]])
}

wrap_vr( 'v1', "title_1", "ylabel_1")

wrap_vr( 'v2', "title_2", "ylabel_2")

list_1 <- list(list('v1', 'v2'), list("title_1", "title_2"), list("ylabel_1", "ylabel_2"))

pmap(list_1, ~wrap_vr(..1, ..2, ..3))
#> [[1]]

#> 
#> [[2]]

Created on 2021-07-06 by the reprex package (v2.0.0)

The use of pmap in this case will result in empty lists printing in the console (or inside a markdown). Because wrap_vr() is called by it's side effects (show a graphic) and doesn't return anything, it's better to use pwalk() function like this:

Regarding to writing v1 instead of df$v1 we'll need to modify a wrap_vr() to contemplate the fact that v1 need to be stored inside a list as an expression (to avoid 'object v1 not found` error).

library(tidyverse)
library(rlang)

df <- tibble(cy = c('a', 'a', 'b', 'b'),
             date = c(1,2,1,2),
             v1 = c(1,2,3,1),
             v2 = c(5,3,2,1))

wrap_vr <- function(df, vr, tit, ylab){
  print(
  ggplot(data = df, aes(date, all_of(vr))) +
    geom_line(color = "steelblue", size = 1) +
    labs(title =  tit,
         y = ylab, x = "") +
    facet_wrap(~ cy))
}

list_1 <- list(list(df, df), list(df$v1, df$v2), list("title_1", "title_2"), list("ylabel_1", "ylabel_2"))

pwalk(list_1, wrap_vr)

Option 2

#to avoid calling df twice inside the list
list_2 <- list(list(df$v1, df$v2), list("title_1", "title_2"), list("ylabel_1", "ylabel_2"))

pwalk(list_2, wrap_vr, df = df)

option 3

#or quoting the column names

#because column names will go inside a list, we'll need a mechanism to avoid evaluation.

wrap_vr_expr <- function(df, vr, tit, ylab){
  print(
    ggplot(data = df, aes(date, eval_tidy(vr))) +
      geom_line(color = "steelblue", size = 1) +
      labs(title =  tit,
           y = ylab, x = "") +
      facet_wrap(~ cy))
}

list_3 <- list(list(df, df), list(expr(v1), expr(v2)), list("title_1", "title_2"), list("ylabel_1", "ylabel_2"))

pwalk(list_3, wrap_vr_expr)
Related