使用purrr ::地图将多个论点也适用于功能

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把标题绘制这些一个，b和ç每个将要产生的地块。 任何帮助将不胜感激。谢谢

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

如果你想使用mutate与map，你也需要使用tidyr为nest。你将使用骰子来存储输出（或数据框与数据框的列表）。

我使用了@ Sathish的详细答案（以及一些修改）中的函数。

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> 

，您可以访问你所需要的使用unnest或通过萃取（[和[[）

> results$model[[1]] 

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

Coefficients: 
(Intercept)   tray 
    -0.3461  0.3998