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

我有一个这样的数据框

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

上面的代码工作得很好，但是如果我想像在

model1

函数中那样提供变量作为参数，我会得到错误。我就是这么做的

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

我一直在犯错误

模式错误（x=托盘，y=块）：未使用的参数（y=块）

我还尝试使用

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（，aes（x=托盘，y=块））+
几何点（）+
xlab（“土壤性质”）+ylab（“坡度系数”）+
ggtitle（nm$tiny[i]）
纳米%>%
变异（put=data%>%map（plot））

我的想法是希望

ggplot

为将要生成的每个绘图放置标题a、b和c。

---

任何帮助都将不胜感激。谢谢

使用基本函数

拆分

将数据拆分为组列表

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_型号%
拆分（.$tiny）%>%
地图（~plot_fun（数据=））

在函数内部创建公式

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

lm_型号%
映射（~lm_模型（数据=，x='托盘'，y='块'））

如果你的函数公式如下，你的解决方案就会起作用

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

---

model如果您想使用
mutate
与
map
一起使用，您还需要使用
tidyr
进行
nest
。您将使用TIBLES存储输出（或包含数据帧列表列的数据帧）

我使用了@Sathish详细回答中的函数（经过一些修改）

看起来不像
model1（）parameters@PierreLafortune，它不起作用。我得到了错误：is.data.frame（.data）| | is.list（.data）| | is.environment（.data）不是真的
总有一天你们这些孩子会停止尝试用管道输送所有东西，就像我在问题中给出的模型示例一样。我学会了另一种做这件事的方法，这是很棒的。但是，我希望能够使用函数并在using
map
中为函数提供任何参数。您确实回答了部分问题。在
lm_model
函数中，我是否可以更改
block
和
tray
并将它们作为函数中的参数提供？我该怎么做？是的。因此，在本例中，我将把数据帧、
x
变量和
y
变量传递给
lm_模型
函数，并使用
map
函数进行评估。您的解决方案工作得非常好。我不明白为什么
df%>%group\u by（tiny）%%>%mutate（mod=data%>%map（lm\u model（x='tray'，y='block'，data=））
不起作用。在
lm\u model
函数的第二行，放入
print（form）
。你会看到魔法的。有关更多信息，请阅读《重新格式化》

，我现在可以将标题添加到绘图中。谢谢

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

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

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

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

# Altered function to include title parameter with purrr::map2
plot_fun <- function( data, title )
{
  p <- ggplot( data = data, aes( x = tray, y = block ) ) +
    geom_point( ) +
    xlab("Soil Properties") + 
    ylab("Slope Coefficient") +
    ggtitle( as.character( title ) )

  return( p )
}


results <- df %>% 
  group_by(tiny) %>% 
  nest() %>% 
  mutate(model = map(data, lm_model),
         plot = map2(data, tiny, plot_fun))

> results

# A tibble: 3 × 4
    tiny              data    model     plot
  <fctr>            <list>   <list>   <list>
1      a <tibble [20 × 3]> <S3: lm> <S3: gg>
2      b <tibble [20 × 3]> <S3: lm> <S3: gg>
3      c <tibble [20 × 3]> <S3: lm> <S3: gg>

> results$model[[1]]

Call:
lm(formula = block ~ tray, data = data)

Coefficients:
(Intercept)         tray  
    -0.3461       0.3998