将函数应用于具有预测变量列表的单个 lm 对象
Applying a function over a Single lm object with a list of predictor variables
我正在尝试创建一个 visualize_lm 函数，该函数 returns 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 个对象的列表，并打印最多 4 个 effect_plots 的多个图形，其中 y 轴为 samsung，x 轴为 dji（道琼斯指数）。
P.S。
天哪，我设法实现了我想要的功能。有没有办法加快这个功能？
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)
}
我做了一些事情，希望通过使用 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"。
另一件事是，当您将函数、循环和 apply 语句组合在一起时，会造成很大的混乱。很难解读您想要实现的目标。
我正在尝试创建一个 visualize_lm 函数，该函数 returns 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 个对象的列表，并打印最多 4 个 effect_plots 的多个图形，其中 y 轴为 samsung，x 轴为 dji（道琼斯指数）。
P.S。 天哪，我设法实现了我想要的功能。有没有办法加快这个功能？
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)
}
我做了一些事情，希望通过使用 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"。
另一件事是，当您将函数、循环和 apply 语句组合在一起时，会造成很大的混乱。很难解读您想要实现的目标。