Проблема извлечения ковариатов модели для сводной таблицы модели

Question

Я аспирант, использующий модель линейной регрессии (подсчета), чтобы понять движущие силы движения fi sh в приливно-болотные угодья и из них. В настоящее время я пытаюсь создать сводную таблицу модели, достойную публикации, в r. Я использую функцию sel.table, которая хорошо работает для этой цели.

Однако мне не удалось создать столбец, содержащий отдельные формулы модели. Ниже мой код, основанный на некоторых хороших инструкциях по использованию пакета MuMIn. https://sites.google.com/site/rforfishandwildlifegrads/home/mumin_usage_examples

Итак, напомним, мой вопрос относится к последней строке кода ниже:

Как мне вставить формулы модели в таблицу выбора модели. **

install.packages("MuMIn")
library(MuMIn)

data = mtcars

models = list(
  model1 <- lm(mpg ~ cyl, data = data),
  model2 <- lm(mpg ~ cyl + hp, data = data),
  model3 <- lm(mpg ~ cyl * hp, data = data)
)

#create an object “out.put” that contains all of the model selection information
out.put <- model.sel(models)

#coerce the object out.put into a data frame
sel.table <-as.data.frame(out.put)[6:10]

#add a column for model names
sel.table$Model <- rownames(sel.table)

#replace model name with formulas
for(i in 1:nrow(sel.table)) sel.table$Model[i]<- as.character(formula(paste(sel.table$Model[i])))[3]

#Any help on this topic would be greatly appreciated!

ОБНОВЛЕННЫЙ КОД

Мой метод получения названий моделей довольно неуклюжий, но в остальном этот код, кажется, генерирует то, что я задумал (полная таблица выбора модели). Кроме того, я не уверен, правильно ли отображаются коэффициенты модели, но я надеюсь продолжить это для своего окончательного ответа.

data = mtcars

#write linear models
models = list(
  model1 <- lm(mpg ~ cyl, data = data),
  model2 <- lm(mpg ~ cyl + hp, data = data),
  model3 <- lm(mpg ~ cyl * hp + disp, data = data),
  model4 <- lm(mpg ~ cyl * hp + disp + wt + drat, data = data)
)

#create an object “out.put” that contains all of the model selection information
out.put <- model.sel(models)

#coerce the object out.put into a data frame
sel.table <-as.data.frame(out.put)

#slightly rename intercept column
names(sel.table)[1]="Intercept"

#select variables to display in model summary table
sel.table <- sel.table %>% 
 select(Intercept,cyl,hp,disp,wt,drat,df,logLik,AICc,delta)

#round numerical coumns
sel.table[,1:6]<- round(sel.table[,1:6],2)

sel.table[,8:10]<-round(sel.table[,8:10],2)

#add a column for model (row) names
sel.table$Model <- rownames(sel.table)

#extract model formulas
form <- data.frame(name = as.character(lapply(models, `[[`, c(10,2))))

#generate a column with model (row) numbers (beside associated model formulas)
form <- form %>% 
  mutate(Model=(1:4))

#merge model table and model formulas
sum_table <- merge (form,sel.table,by="Model")

#rename model equation column 
names(sum_table)[2]="Formula"

print <- flextable(head(sum_table))
print <- autofit(print)
print

6/1/20 ОБНОВЛЕНИЕ:

Ниже - изображение, описывающее две проблемы, возникающие у меня с кодом. Я нашел обходной путь к первому вопросу, но я все еще исследую второй. подробности см. Здесь

1. Нумерация моделей заканчивается
2. Для каждой модели создаются столбцы формул модели

Answer 1

Я считаю, что часть кода отсутствует в примерах, которые вы следовали , поэтому ваш код не работает.

Самый простой способ сгенерировать строки, подобные формулам, - просто в deparse правую часть модели formula s (т.е. 3-й элемент):

sapply(get.models(out.put, TRUE), function(mo) deparse(formula(mo)[[3]], width.cutoff = 500))

или, если вы хотите, A*B расширяется до A + B + A:B:

sapply(get.models(out.put, TRUE), function(mo) deparse(terms(formula(mo), simplify = TRUE)[[3]], width.cutoff = 500))

Обновление: улучшен и упрощен исходный пример кода:

library(MuMIn)

data <- mtcars

#! Feed the models directly to `model.sel`. No need to create a separate list of
#! models.
gm <- lm(mpg ~ cyl, data = data)
out.put <- model.sel(
  model1 = gm,
  model2 = update(gm, . ~. + hp),
  model3 = update(gm, . ~ . * hp + disp),
  model4 = update(gm, . ~ . * hp + disp + wt + drat)
  )

sel.table <- out.put
sel.table$family <- NULL
sel.table <- round(sel.table, 2)
#! Use `get.models` to get the list of models in the same order as in the
#! selection table
sel.table <- cbind(
    Model = 
#! Update (2): model number according to their original order, use:
       attr(out.put, "order"),
#!     otherwise: seq(nrow(sel.table)),
#!
#! Update (2): add a large `width.cutoff` to `deparse` so that the result is
#!         always a single string and `sapply` returns a character vector
#!         rather than a list.
#!         For oversize formulas, use `paste0(deparse(...), collapse = "")`  
    formula = sapply(get.models(out.put, TRUE),
        function(mo) deparse(formula(mo)[[3]], width.cutoff = 500)),
#!
    sel.table
    )

Answer 2

library(MuMIn)

data <- mtcars

#! Feed the models directly to `model.sel`. No need to create a separate list of
#! models.
gm <- lm(mpg ~ cyl, data = data)
out.put <- model.sel(
  model1 = gm,
  model2 = update(gm, . ~. + hp),
  model3 = update(gm, . ~ . * hp + disp),
  model4 = update(gm, . ~ . * hp + disp + wt + drat)
)

sel.table <- out.put
sel.table$family <- NULL
sel.table <- round(sel.table, 2)
#! Use `get.models` to get the list of models in the same order as in the
sel.table <- cbind(
  Model = 
    #! Update (2): model number according to their original order, use:
    attr(out.put, "order"),
  #!     otherwise: seq(nrow(sel.table)),
  #!
  #! Update (2): add a large `width.cutoff` to `deparse` so that the result is
  #!         always a single string and `sapply` returns a character vector
  #!         rather than a list.
  #!         For oversize formulas, use `paste0(deparse(...), collapse = "")`  
  formula = sapply(get.models(out.put, TRUE),
                   function(mo) deparse(formula(mo)[[3]], width.cutoff = 500)),
  #!
  sel.table
)

#slightly rename intercept column  
colnames(sel.table)[3] <- 'Intercept' 

# #select summary columns for model selection table
# sel.table <- sel.table %>%
#   select(Model,formula,Intercept,df,logLik,AICc,delta,weight)

print <- flextable(head(sel.table))
print <- autofit(print)
print

Answer 3

Поскольку ваш вопрос не воспроизводится, я попробую что-нибудь еще, и, возможно, это то, что вы ищете:

data = mtcars

models = list(
  model1 = lm(mpg ~ cyl, data = data),
  model2 = lm(mpg ~ cyl + hp, data = data)
  )

data.frame(name = as.character(lapply(models, `[[`, c(10,2))),
           other.column = NA)
#>             name other.column
#> 1      mpg ~ cyl           NA
#> 2 mpg ~ cyl + hp           NA

^{Создано 28 мая 2020 года пакет REPEX (v0.3.0)}

Формула (вызов) объекта lm находится на позиции 10 в списке. Вы действительно можете посчитать, набрав model1$. Вы можете использовать rownames() вместо столбца, но это не рекомендуется.

РЕДАКТИРОВАТЬ ПОСЛЕ ВОСПРОИЗВОДИМОГО ПРИМЕРА

library(MuMIn)

data = mtcars

models = list(
  model1 <- lm(mpg ~ cyl, data = data),
  model2 <- lm(mpg ~ cyl + hp, data = data),
  model3 <- lm(mpg ~ cyl * hp, data = data)
)

# create an object that contains all of the model selection information
out.put <- model.sel(models)

#coerce the object out.put into a data frame
sel.table <-as.data.frame(out.put)[6:10]

# formulas as names
sel.table$name = as.character(lapply(models, `[[`, c(10,2)))

# reordering
sel.table = sel.table[, c(6,1,2,3,4,5)]

sel.table
#>             name df    logLik     AICc    delta    weight
#> 3      mpg ~ cyl  5 -78.14329 168.5943 0.000000 0.5713716
#> 1 mpg ~ cyl + hp  3 -81.65321 170.1636 1.569298 0.2607054
#> 2 mpg ~ cyl * hp  4 -80.78092 171.0433 2.449068 0.1679230

^{Создано 31.05.2020 пакет REPEX (v0.3.0)}