使用 purrr::map 将多个参数应用于一个函数
Use purrr::map to apply multiple arguments to a function
我有一个这样的数据框
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 用于将生成的每个地块。
任何帮助将不胜感激。谢谢
使用基本函数 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)
}
如果要将 mutate
与 map
一起使用,则还需要将 tidyr
与 nest
一起使用。您将使用 tibbles 来存储输出(或带有数据帧列表列的数据帧)。
我使用了@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
我有一个这样的数据框
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 用于将生成的每个地块。
任何帮助将不胜感激。谢谢
使用基本函数 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)
}
如果要将 mutate
与 map
一起使用,则还需要将 tidyr
与 nest
一起使用。您将使用 tibbles 来存储输出(或带有数据帧列表列的数据帧)。
我使用了@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