Use purrr::map to apply multiple arguments to a function

Kay picture Kay · Feb 28, 2017 · Viewed 9k times · Source

I have a data frame like this

   df <- data.frame(tiny = rep(letters[1:3], 20), 
                  block = rnorm(60), tray = runif(60, min=0.4, max=2),
                  indent = sample(0.5:2.0, 60, replace = TRUE))

I nested this data frame

nm <- df%>%
       group_by(tiny)%>%
       nest()

then wrote these functions

library(dplyr)
library(purrr)
library(tidyr)

model <- function(dfr, x, y){
             lm(y~x, data = dfr)
         }

model1 <- function(dfr){
           lm(block~tray, data = dfr)
          }

I want to run this model for all tiny classes, so I did

 nm%>%
   mutate(
     mod = data %>% map(model1)
   )

the above code works fine but if I want to supply the variables as arguments like I have in the model1 function, I get errors. This is what I do

 nm%>%
    mutate(mod = data %>% map(model(x=tray, y=block)))

I keep getting the error Error in mode(x = tray, y = block) : unused argument (y = block).

Also I tried plotting these using ggplot2

plot <- function(dfr, i){
    dfr %>%
    ggplot(., aes(x=tray, y=block))+
geom_point()+
xlab("Soil Properties")+ylab("Slope Coefficient")+
ggtitle(nm$tiny[i])

nm%>%
 mutate(put = data %>% map(plot))

the idea is that I want ggplot to put titles a, b, and c for each of the plots that will be produced. Any help would be greatly appreciated. Thanks

Answer

Sathish picture Sathish · Feb 28, 2017

use base function split to split data into list of groups.

library( purrr )
library( ggplot2 )
df %>% 
  split( .$tiny) %>%
  map(~ lm( block ~ tray, data = .))

df %>% 
  split( .$tiny) %>%
  map(~ ggplot( data = ., aes( x = tray, y = block ) ) +
        geom_point( ) +
        xlab("Soil Properties") + 
        ylab("Slope Coefficient") +
        ggtitle( as.character( unique(.$tiny) ) ) )

Using Functions:

lm_model <- function( data ) 
{
  return( lm( block ~ tray, data = data ) )
}

plot_fun <- function( data )
{
  p <- ggplot( data = data, aes( x = tray, y = block ) ) +
    geom_point( ) +
    xlab("Soil Properties") + 
    ylab("Slope Coefficient") +
    ggtitle( as.character( unique(data$tiny) ) )

  return( p )
}

df %>% 
  split( .$tiny) %>%
  map(~ lm_model( data = . ) )

df %>% 
  split( .$tiny) %>%
  map(~ plot_fun( data = . ) )

Creating formula inside function

lm_model <- function( data, x, y ) 
{
  form <- reformulate( y, x )

  return( lm( formula = form, data = data ) )
}

df %>% 
  split( .$tiny) %>%
  map(~ lm_model( data = ., x = 'tray', y = 'block' ) )

Your solution would have worked if you had your function formulated like below.

model <- function(dfr, x, y){
  lm( formula = eval(parse(text = paste('as.formula( ', y, ' ~ ', x, ')', sep = ''))),
      data = dfr)
}