使用purrr :: map将多个参数应用于函数

Question

我有一个这样的数据框

   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))

我嵌套了这个数据框

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

然后写了这些功能

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

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

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

我想为所有微小的类运行该模型，所以我做了

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

上面的代码工作正常，但是如果我想像函数中一样提供变量作为参数，则会model1出错。这就是我所做的

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

我不断收到错误消息 Error in mode(x = tray, y = block) : unused argument (y = block)。

我也尝试使用 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))

我的想法是我要ggplot为将要生成的每个图放置标题a，b和c。任何帮助将不胜感激。谢谢

Answer 1

使用基本函数split将数据拆分为组列表。

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) ) ) )

使用功能：

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 = . ) )

在函数内部创建公式

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' ) )

如果您具有如下所示的功能，则您的解决方案将奏效。

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

Answer 2

如果您想使用mutatewith map，则还需要使用tidyrfor nest。您将使用 tibbles 来存储输出（或带有数据帧列表列的数据帧）。

\n\n

我使用了@Sathish\'s 详细答案中的函数（经过一些修改）。

\n\n

library(purrr)\nlibrary(dplyr)\nlibrary(tidyr) \n\ndf <- data.frame(tiny = rep(letters[1:3], 20), \n                 block = rnorm(60), tray = runif(60, min=0.4, max=2),\n                 indent = sample(0.5:2.0, 60, replace = TRUE))\n\nlm_model <- function( data ) \n{\n  return( lm( block ~ tray, data = data ) )\n}\n\n# Altered function to include title parameter with purrr::map2\nplot_fun <- function( data, title )\n{\n  p <- ggplot( data = data, aes( x = tray, y = block ) ) +\n    geom_point( ) +\n    xlab("Soil Properties") + \n    ylab("Slope Coefficient") +\n    ggtitle( as.character( title ) )\n\n  return( p )\n}\n\n\nresults <- df %>% \n  group_by(tiny) %>% \n  nest() %>% \n  mutate(model = map(data, lm_model),\n         plot = map2(data, tiny, plot_fun))\n

\n\n

你最终会得到：

\n\n

> results\n\n# A tibble: 3 \xc3\x97 4\n    tiny              data    model     plot\n  <fctr>            <list>   <list>   <list>\n1      a <tibble [20 \xc3\x97 3]> <S3: lm> <S3: gg>\n2      b <tibble [20 \xc3\x97 3]> <S3: lm> <S3: gg>\n3      c <tibble [20 \xc3\x97 3]> <S3: lm> <S3: gg>\n

\n\n

您可以使用unnest或通过提取（[和[[）来访问您需要的内容

\n\n

> results$model[[1]]\n\nCall:\nlm(formula = block ~ tray, data = data)\n\nCoefficients:\n(Intercept)         tray  \n    -0.3461       0.3998  \n

\n