Повысить эффективность подгонки многих моделей - PullRequest
Новая
       87

Повысить эффективность подгонки многих моделей

2 голосов
/ 04 октября 2019

Спасибо тем, кто помог мне с предыдущими вопросами о коэффициентах и p значениях от многих моделей. Теперь я могу получить все коэффициенты, значения p и значения AIC из многих моделей. 

md <- "mpg ~ cyl" 
xlist <- c("disp", "hp", "am")
n <- length(xlist)
comb_lst <- unlist(lapply(1:n, function(x) combn(xlist, x, simplify = F)), recursive = F)
md_lst <- lapply(comb_lst, function(x) paste(md, "+", paste(x, collapse = "+")))

coefs <- unlist(lapply(md_lst, function(x) lm(as.formula(x),data = mtcars)$coe[2]))
pvalues <- unlist(lapply(md_lst, function(x) summary(lm(as.formula(x), data = mtcars))$coe["cyl", 4]))
aic <- unlist(lapply(md_lst, function(x) AIC(lm(as.formula(x), data = mtcars))))

Как видно из приведенного выше кода, каждая из последних 3 строк будет соответствовать разным моделям независимо друг от друга. Это означает, что код будет соответствовать одному и тому же набору моделей 3 раза. Это может занять много времени с большими данными и многими переменными. Мой вопрос состоит в том, как подобрать все модели один раз, а затем подобрать коэффициенты, значения p и значения AIC.

Ответы [ 3 ]

3 голосов
/ 04 октября 2019

Для удобства я использовал функцию из пакета , который я написал. Этого можно избежать, используя summary, как показано в другом ответе .

Мы можем сделать: 

models <- lapply(md_lst, function(x) do.call(lm, list(formula =x,
                                                      data=mtcars)) )
sapply(models, function(x) { cbind(coef(x),
 manymodelr::extract_model_info(x, "p_value")["cyl"], AIC(x) )})

Я не хочу использовать пакеты (manymodelr) 

sapply(models, function(x) {
  cbind(coef(x),coef(summary(x))[,4]["cyl"],
        AIC(x)
        )})

Это дает нам списокматриц, где каждый столбец представляет коэффициенты, значения p и AIC соответственно.

Результаты (усеченные) 

   [[1]]
                       [,1]       [,2]     [,3]
    (Intercept) 34.66099474 0.03366495 167.1456
    cyl         -1.58727681 0.03366495 167.1456
    disp        -0.02058363 0.03366495 167.1456

    [[2]]
                      [,1]         [,2]     [,3]
    (Intercept) 36.9083305 0.0004803752 169.5618
    cyl         -2.2646936 0.0004803752 169.5618
    hp          -0.0191217 0.0004803752 169.5618

    [[3]]
                     [,1]        [,2]     [,3]
    (Intercept) 34.522443 1.28456e-07 167.2191
    cyl         -2.500958 1.28456e-07 167.2191
    am           2.567035 1.28456e-07 167.2191

    [[4]]
                       [,1]      [,2]     [,3]
    (Intercept) 34.18491917 0.1349044 168.0184
    cyl         -1.22741994 0.1349044 168.0184
    disp        -0.01883809 0.1349044 168.0184
    hp          -0.01467933 0.1349044 168.0184
2 голосов
/ 04 октября 2019

Используется возможность ввести FUN в вызов combn(). Как и в случае других ответов, линейная регрессия выполняется только один раз. 

md <- "mpg ~ cyl" 
xlist <- c("disp", "hp", "am")

all_models <- unlist(
                lapply(seq_along(xlist),
                       function (k) {
                         combn(xlist,
                               k,
                               FUN = function (x) {
                                 form <- formula(paste(md, '+', paste(x, collapse = '+')))
                                 eval(bquote(lm(.(form), data = mtcars)   ))
                                 },
                               simplify = F
                         )
                         }
                       )
                ,recursive = F
                )

coefs <- sapply(all_models, function(x) x$coe[2])
pvalues <- sapply(all_models, function(x) summary(x)$coe["cyl", 4])
aic <- sapply(all_models, function(x) AIC(x))
2 голосов
/ 04 октября 2019

Вы можете сделать: 

models <- lapply(md_lst, function(x) lm(as.formula(x), data = mtcars))
coefs <- unlist(lapply(models, function(x) x$coef[2]))
pvalues <- unlist(lapply(models, function(x) summary(x)$coef["cyl", 4]))
aic <- unlist(lapply(models, function(x) AIC(x)))
...