使用一个数据帧中的值作为在另一个数据帧上估计的模型的参数

Question

我希望在一个数据框中估计模型，但是每个模型的公式都有一些来自另一个数据框的“移动部分”。例如，假设我想估计以下模型（我不能发布图片，也没有办法输入乳胶方程）:mpg=a+B*log(w_1*drat+w_2*hp)

library(tidyverse)
cars <- mtcars

w <- seq(from=0.5, to=1, by=0.5)
weights <- as_tibble(expand.grid(w1=w,w2=w))


#Doesn't work - the lm model is fit using the formula from the first row only
weights %>%
  mutate(formula_weights = paste0("mpg~log(",w1,"*drat+",w2,"*hp)")) %>%
  mutate(r2 = summary(lm(data=cars, formula = formula_weights))$r.squared)

#Does work - model is fit using the w1 and w2 values from each row (formula_weights)
weights %>%
  mutate(formula_weights = paste0("mpg~log(",w1,"*drat+",w2,"*hp)")) %>%
  group_by(formula_weights) %>%
  mutate(r2 = summary(lm(data=cars, formula = formula_weights))$r.squared)

# A tibble: 4 x 4
     w1    w2 formula_weights             r2
  <dbl> <dbl> <chr>                    <dbl>
1   0.5   0.5 mpg~log(0.5*drat+0.5*hp) 0.715
2   1     0.5 mpg~log(1*drat+0.5*hp)   0.715
3   0.5   1   mpg~log(0.5*drat+1*hp)   0.715
4   1     1   mpg~log(1*drat+1*hp)     0.715

group_by()的输出：

# A tibble: 4 x 4
# Groups:   formula_weights [4]
     w1    w2 formula_weights             r2
  <dbl> <dbl> <chr>                    <dbl>
1   0.5   0.5 mpg~log(0.5*drat+0.5*hp) 0.715
2   1     0.5 mpg~log(1*drat+0.5*hp)   0.709
3   0.5   1   mpg~log(0.5*drat+1*hp)   0.718
4   1     1   mpg~log(1*drat+1*hp)     0.715

Answer 1

我们可以按行方式添加

library(dplyr)
weights %>%
  mutate(formula_weights = paste0("mpg~log(",w1,"*drat+",w2,"*hp)")) %>% 
  rowwise() %>%
  mutate(r2 = summary(lm(data=cars, formula = formula_weights))$r.squared)
#Source: local data frame [4 x 4]
#Groups: <by row>

# A tibble: 4 x 4
#     w1    w2 formula_weights             r2
#  <dbl> <dbl> <chr>                    <dbl>
#1   0.5   0.5 mpg~log(0.5*drat+0.5*hp) 0.715
#2   1     0.5 mpg~log(1*drat+0.5*hp)   0.709
#3   0.5   1   mpg~log(0.5*drat+1*hp)   0.718
#4   1     1   mpg~log(1*drat+1*hp)     0.715

或使用映射

library(purrr)
weights %>%
     mutate(r2 = map_dbl(paste0("mpg~log(",w1,"*drat+",w2,"*hp)"), ~ 
                    summary(lm(data = cars, formula =  .x))$r.squared))
# A tibble: 4 x 3
#     w1    w2    r2
#   <dbl> <dbl> <dbl>
#1   0.5   0.5 0.715
#2   1     0.5 0.709
#3   0.5   1   0.718
#4   1     1   0.715