在具有预测变量列表的单个 lm 对象上应用函数答案

【问题标题】：Applying a function over a Single lm object with a list of predictor variables在具有预测变量列表的单个 lm 对象上应用函数
【发布时间】：2019-07-24 11:31:16
【问题描述】：

我正在尝试创建一个 visual_lm 函数，该函数返回 lm() 中所有预测变量的所有 effect_plots 列表，并在绘图屏幕上输出最多 4 个图形的图形。

这是我的变量和到目前为止我尝试过的代码。

summary(samsung_multifit)



Call:

lm(formula = samsung ~ ., data = stockNfirm[-(2:11)])

Residuals:

     Min       1Q   Median       3Q      Max 
-10052.6  -1861.0    -32.9   2175.9   7301.3 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept) -3.877e+04  9.186e+02 -42.208  < 2e-16 ***
sse         -1.309e+00  1.873e-01  -6.991 3.58e-12 ***
nikkei      -3.730e-01  5.092e-02  -7.326 3.27e-13 ***
kosdaq      -1.770e+01  1.449e+00 -12.214  < 2e-16 ***
kospi        2.518e+01  6.109e-01  41.212  < 2e-16 ***
dji          2.171e+00  5.400e-02  40.199  < 2e-16 ***
Individual  -2.548e-01  8.726e-02  -2.920  0.00354 ** 
Foreigner   -2.399e-01  8.386e-02  -2.861  0.00426 ** 
Institution -1.976e-01  8.569e-02  -2.306  0.02119 *  

Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 3197 on 2287 degrees of freedom
Multiple R-squared:  0.9098,    Adjusted R-squared:  0.9095 
F-statistic:  2884 on 8 and 2287 DF,  p-value: < 2.2e-16

pred_string <-names(samsung_multifit$model)[-1]

 pred_string

[1] "sse"         "nikkei"      "kosdaq"      "kospi"       "dji"        

[6] "Individual"  "Foreigner"   "Institution"

> str(samsung_multifit)
List of 12
 $ coefficients : Named num [1:9] -3.88e+04 -1.31 -3.73e-01 -1.77e+01 2.52e+01 ...
  ..- attr(*, "names")= chr [1:9] "(Intercept)" "sse" "nikkei" "kosdaq" ...
 $ residuals    : Named num [1:2296] 818 640 452 430 464 ...
  ..- attr(*, "names")= chr [1:2296] "1" "2" "3" "4" ...
 $ effects      : Named num [1:2296] -1487856 156486 385095 75598 201526 ...
  ..- attr(*, "names")= chr [1:2296] "(Intercept)" "sse" "nikkei" "kosdaq" ...
 $ rank         : int 9
 $ fitted.values: Named num [1:2296] 14322 14820 15148 15170 15136 ...
  ..- attr(*, "names")= chr [1:2296] "1" "2" "3" "4" ...
 $ assign       : int [1:9] 0 1 2 3 4 5 6 7 8
 $ qr           :List of 5
  ..$ qr   : num [1:2296, 1:9] -47.9166 0.0209 0.0209 0.0209 0.0209 ...
  .. ..- attr(*, "dimnames")=List of 2
  .. .. ..$ : chr [1:2296] "1" "2" "3" "4" ...
  .. .. ..$ : chr [1:9] "(Intercept)" "sse" "nikkei" "kosdaq" ...
  .. ..- attr(*, "assign")= int [1:9] 0 1 2 3 4 5 6 7 8
  ..$ qraux: num [1:9] 1.02 1.01 1.03 1 1.01 ...
  ..$ pivot: int [1:9] 1 2 3 4 5 6 7 8 9
  ..$ tol  : num 1e-07
  ..$ rank : int 9
  ..- attr(*, "class")= chr "qr"
 $ df.residual  : int 2287
 $ xlevels      : Named list()
 $ call         : language lm(formula = samsung ~ ., data = stockNfirm[-(2:11)])
 $ terms        :Classes 'terms', 'formula'  language samsung ~ sse + nikkei + kosdaq + kospi + dji + Individual + Foreigner + Institution
  .. ..- attr(*, "variables")= language list(samsung, sse, nikkei, kosdaq, kospi, dji, Individual, Foreigner, Institution)
  .. ..- attr(*, "factors")= int [1:9, 1:8] 0 1 0 0 0 0 0 0 0 0 ...
  .. .. ..- attr(*, "dimnames")=List of 2
  .. .. .. ..$ : chr [1:9] "samsung" "sse" "nikkei" "kosdaq" ...
  .. .. .. ..$ : chr [1:8] "sse" "nikkei" "kosdaq" "kospi" ...
  .. ..- attr(*, "term.labels")= chr [1:8] "sse" "nikkei" "kosdaq" "kospi" ...
  .. ..- attr(*, "order")= int [1:8] 1 1 1 1 1 1 1 1
  .. ..- attr(*, "intercept")= int 1
  .. ..- attr(*, "response")= int 1
  .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv> 
  .. ..- attr(*, "predvars")= language list(samsung, sse, nikkei, kosdaq, kospi, dji, Individual, Foreigner, Institution)
  .. ..- attr(*, "dataClasses")= Named chr [1:9] "numeric" "numeric" "numeric" "numeric" ...
  .. .. ..- attr(*, "names")= chr [1:9] "samsung" "sse" "nikkei" "kosdaq" ...
 $ model        :'data.frame':  2296 obs. of  9 variables:
  ..$ samsung    : num [1:2296] 15140 15460 15600 15600 15600 ...
  ..$ sse        : num [1:2296] 2602 2599 2589 2592 2592 ...
  ..$ nikkei     : num [1:2296] 9510 9626 9626 9602 9566 ...
  ..$ kosdaq     : num [1:2296] 481 483 484 484 484 ...
  ..$ kospi      : num [1:2296] 1812 1827 1833 1833 1833 ...
  ..$ dji        : num [1:2296] 10595 10608 10754 10761 10739 ...
  ..$ Individual : num [1:2296] -1428 -4237 -289 -289 -289 ...
  ..$ Foreigner  : num [1:2296] 2051 2722 1320 1320 1320 ...
  ..$ Institution: num [1:2296] -331 1645 -1116 -1116 -1116 ...
  ..- attr(*, "terms")=Classes 'terms', 'formula'  language samsung ~ sse + nikkei + kosdaq + kospi + dji + Individual + Foreigner + Institution
  .. .. ..- attr(*, "variables")= language list(samsung, sse, nikkei, kosdaq, kospi, dji, Individual, Foreigner, Institution)
  .. .. ..- attr(*, "factors")= int [1:9, 1:8] 0 1 0 0 0 0 0 0 0 0 ...
  .. .. .. ..- attr(*, "dimnames")=List of 2
  .. .. .. .. ..$ : chr [1:9] "samsung" "sse" "nikkei" "kosdaq" ...
  .. .. .. .. ..$ : chr [1:8] "sse" "nikkei" "kosdaq" "kospi" ...
  .. .. ..- attr(*, "term.labels")= chr [1:8] "sse" "nikkei" "kosdaq" "kospi" ...
  .. .. ..- attr(*, "order")= int [1:8] 1 1 1 1 1 1 1 1
  .. .. ..- attr(*, "intercept")= int 1
  .. .. ..- attr(*, "response")= int 1
  .. .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv> 
  .. .. ..- attr(*, "predvars")= language list(samsung, sse, nikkei, kosdaq, kospi, dji, Individual, Foreigner, Institution)
  .. .. ..- attr(*, "dataClasses")= Named chr [1:9] "numeric" "numeric" "numeric" "numeric" ...
  .. .. .. ..- attr(*, "names")= chr [1:9] "samsung" "sse" "nikkei" "kosdaq" ...
 - attr(*, "class")= chr "lm"

我尝试过使用 for 循环、映射、应用函数，但到目前为止都没有运气。


visualize_lm <- function(lm_model ){

  for(i in 2:length(lm_model$model)){
    q <- effect_plot(samsung_multifit, pred =!!(pred_string[i]), interval = TRUE, plot.points = TRUE)
  }

  result <- mapply(FUN = effect_plot, samsung_multifit, MoreArgs = list(quote(pred_string))) 

  grid.arrange(q,q1,q2,q3, ncol = 2, nrow = 2)
  grid.arrange(q4,q5,q6,q7, ncol = 2, nrow = 2)

  rm(list = c("q","q1","q2","q3","q4","q5","q6","q7"))
}

我希望该函数将输出一个 effect_plot 对象列表，并打印多个带有 y 轴三星和 x 轴 dji（道琼斯指数）的最多 4 个 effect_plots 的图形。

附：天哪，我设法实现了我想要的功能。有没有办法加快这个功能？

visualize_lm <- function(lm_model ){

  pred_string <-names(lm_model$model)[-1]
  return_list <- list(length(pred_string))


  for(i in 1:length(pred_string)){
    q <- effect_plot(lm_model, pred = !!(pred_string[i]), interval = TRUE, plot.points = TRUE)
    return_list[i] <- list(q)
  }

  nCol <- floor(sqrt(length(pred_string)))
  do.call("grid.arrange", c(return_list, ncol=nCol))
  return(return_list)
}

【问题讨论】：

标签： r purrr mapply

【解决方案1】：

通过使用 mtcars 数据，我做了一些希望能满足您要求的事情。我的代码如下所示。希望对您有所帮助。

library(jtools)
library(gridExtra)

mtcars <- mtcars[, 1:9]

MyModel <- lm(mpg ~ ., mtcars)

pred_string <- names(MyModel[["model"]])[-1]

for(i in 1:length(pred_string)){
  assign(paste0("q", i), effect_plot(MyModel, pred =!! pred_string[i],
                                 interval = TRUE, plot.points = TRUE))
}

grid.arrange(q1, q2, q3, q4, ncol = 2, nrow = 2)
grid.arrange(q5, q6, q7, q8, ncol = 2, nrow = 2)

话虽如此，您的代码中有一些事情没有按预期进行。

例如，您仅将绘图分配给对象“q”，因此您根本没有“q1”到“q7”。

另一件事是，当您将函数、循环和应用语句组合在一起时，它会引起很大的混乱。要破译你想要达到的目标可能非常困难。

【讨论】：