Question

我正在做一些建模实验，我需要以特定格式呈现多个模型的输出，以便进一步分析。

以下是一些生成多个模型的代码：

# This to generate the data
resp <- sample(0:1,100,TRUE)
x1 <- c(rep(5,20),rep(0,15), rep(2.5,40),rep(17,25))
x2 <- c(rep(23,10),rep(5,10), rep(15,40),rep(1,25), rep(2, 15))
x3 <- c(rep(2,10),rep(50,10), rep(1,40),rep(112,25), rep(22, 15))
dat <- data.frame(resp,x1, x2, x3)


# This to build multiple models
InitLOogModel<-list()
n <- 3
for (i in 1:n)
{
  ### Create training and testing data
  ## 80% of the sample size
  # Note that I didn't use seed so that random split is performed every iteration.
  smp_sizelogis <- floor(0.8 * nrow(dat))

  train_indlogis <- sample(seq_len(nrow(dat)), size = smp_sizelogis)

  trainlogis <- dat[train_indlogis, ]
  testlogis  <- dat[-train_indlogis, ]

  InitLOogModel[[i]] <- glm(resp ~ ., data =trainlogis, family=binomial)
}

这是输出：

InitLOogModel
[[1]]

Call:  glm(formula = resp ~ ., family = binomial, data = trainlogis)

Coefficients:
(Intercept)           x1           x2           x3  
  -0.007270     0.004585    -0.015271    -0.009911  

Degrees of Freedom: 79 Total (i.e. Null);  76 Residual
Null Deviance:      106.8 
Residual Deviance: 104.5    AIC: 112.5

[[2]]

Call:  glm(formula = resp ~ ., family = binomial, data = trainlogis)

Coefficients:
(Intercept)           x1           x2           x3  
   1.009670    -0.058227    -0.058783    -0.008337  

Degrees of Freedom: 79 Total (i.e. Null);  76 Residual
Null Deviance:      110.1 
Residual Deviance: 108.1    AIC: 116.1

[[3]]

Call:  glm(formula = resp ~ ., family = binomial, data = trainlogis)

Coefficients:
(Intercept)           x1           x2           x3  
    1.51678     -0.06482     -0.07868     -0.01440  

Degrees of Freedom: 79 Total (i.e. Null);  76 Residual
Null Deviance:      110.5 
Residual Deviance: 106.3    AIC: 114.3

请注意，此处的输出是一个列表。现在这是我需要创建的数据框输出（让我们调用outDF）：

    Model   Intercept   x1              x2          x3 
      1     -0.00727    0.004585    -0.015271   -0.009911 
      2     1.00967     -0.058227   -0.058783   -0.008337 
      3     1.51678     -0.06482    -0.07868    -0.0144

请注意，outDF中每列内的数字只是回归系数。例如，这是为模型1获取它们的方法：

as.data.frame(coef(summary(InitLOogModel[[1]]))[,1])

Answer 1

您可以循环浏览模型列表，并使用sapply

获取所需的摘要信息

as.data.frame(t(sapply(InitLOogModel, function(x) coef(summary(x))[,1])))
#   (Intercept)         x1          x2            x3
# 1   0.5047799 0.01932560 -0.01268125 -0.0041356214
# 2  -1.2712605 0.11281741  0.06717180  0.0050441023
# 3  -0.7052121 0.08568746  0.03964437  0.0003167443

在这种情况下，

sapply为每个模型创建一列系数。由于我们希望模型是行而不是列，因此我们使用t来转置结果。

Answer 2

@josliber的答案中的sapply方法是合理的，但我倾向于将结果留在列表中并将它们组合在一起。原则是你sapply所做的简化只是方便 - 如果不方便，不要使用它。只需以适合您具体情况的方式组合结果。该原则导致以下内容：

do.call(rbind, lapply( InitLOogModel, coef))

我知道coef.lm会返回一个向量，因为我知道每个模型具有相同的系数，所以我知道rbind它们是有意义的。请注意，我避免使用每个模型的summary，因为它不会产生我们想要实现的结果所需的任何内容。

当然do.call(rbind ...返回矩阵而不是data.frame。如果需要data.frame，则可以使用as.data.frame

转换矩阵

do.call(rbind, lapply( InitLOogModel, coef))

修改灵感来自@ jake-kaupp的答案就是我如何在tidyverse中做到这一点：

系数的组合看起来与上面的基本R方法非常相似：

library(tidyverse) map(InitLOogModel, coef) %>% reduce(rbind)

用于构建模型列表的for循环可以替换为

library(modelr) smp_sizelogis <- floor(0.8 * nrow(dat)) rows <- seq_len(nrow(dat)) rerun(3, dat %>% resample(sample(rows, size = smp_sizelogis))) %>% map(function(x) glm(resp ~ ., family = binomial, data = x))

把整个事情放在一起给了我们

smp_sizelogis <- floor(0.8 * nrow(dat)) rows <- seq_len(nrow(dat)) rerun(3, dat %>% resample(sample(rows, size = smp_sizelogis))) %>% map(function(x) glm(resp ~ ., family = binomial, data = x)) %>% map(coef) %>% reduce(rbind)

@ jake-kaupp答案的主要优点是：a）我们不计算我们不需要的东西，b）我们从不将结果填入数据框架，所以我们永远不必考虑如何获得我们想要的部分。

Answer 3

您还可以使用tidyverse解决方案，我个人认为该解决方案可以生成更易于阅读的代码，但代价是使用更多的软件包。

编辑：虽然@Ista对于看似复杂的嵌套列表框架方法可能是正确的，但它具有保持分析的全部步骤从数据到模型到模型细节的吸引力。这种方法不会计算额外的任何东西，只是简单地将数据操作到所需的请求结果。

我也更喜欢将它保存在数据框列表中，因为我发现它们使下游工作更容易访问。它归结为方法中的偏好以及它如何适合您的工作流程。

library(tidyverse)

smp_sizelogis <- floor(0.8 * nrow(dat))
rows <- seq_len(nrow(dat))

analysis <- rerun(3, resample(dat, sample(rows, size = smp_sizelogis))) %>%
  tibble(data = .) %>% 
  add_rownames("model_number") %>% 
  mutate(model = map(data, ~glm('resp ~ .', family = binomial, data = .))) %>% 
  mutate(coefs = map(model, tidy))

analysis %>% 
  select(model_number, term, estimate) %>% 
  spread(term, estimate) %>% 
  select(-`(Intercept)`)

# A tibble: 3 × 4
  model_number          x1         x2          x3
*        <chr>       <dbl>      <dbl>       <dbl>
1            1 -0.08160034 0.03156254 0.008613346
2            2 -0.04740939 0.04084883 0.004282003
3            3 -0.05980735 0.01625652 0.002075468

从列表中提取输出并保存在数据框中

3 个答案: