使用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