从线性模型创建 dataframe 的 r2、残差和系数

Question

完全像这个问题，但你如何也得到每个 model 的 R 平方值？ 关联

样本数据

test <- data.frame(row=c(1:16),
plot = c(1,1,1,1,1,2,2,2,3,3,3,3,3,3,3,3),
                 logT = c(1.092,1.091,1.0915,1.09,1.08,1.319,1.316,1.301,1.2134,1.213,1.21,1.22,1.23,1.20,1.19,1.19),
                 utc_datetime = c(2020-03-05T00:00:00Z,2020-03-05T00:30:00Z,2020-03-05T01:00:00Z,2020-03-05T01:30:00Z,2020-03-05T02:00:00Z, 2020-03-06T01:00:00Z,2020-03-06T01:30:00Z,2020-03-06T02:00:00Z,
2020-03-10T02:00:00Z,2020-03-10T02:30:00Z,2020-03-10T03:00:00Z,2020-03-10T03:30:00Z,2020-03-10T04:00:00Z,2020-03-10T04:30:00Z,2020-03-10T05:00:00Z,2020-03-10T05:30:00Z,), 
hrs_since = 1,2,3,4,5,1,2,3,1,2,3,4,5,6,7,8))

此处对我正在处理的数据进行了更深入的解释，但我相信上面提供的样本数据就足够了data 。 理想情况下，我想使用 utc_datetime 作为 x 轴/IV 值，但我尝试过的代码都无法使用它，所以我创建了 hrs_since 变量，它可以工作。

我正在寻找一个看起来像这样的 output datframe：

plot	斜率（系数）	r2值	标准差
1个	2.1	.96	.01
2个	1.3	.85	.01
3个	.8	.99	.02

当我运行下面的代码时......

output <- ddply(test, "plot", function(x) {
  model <- lm(logT ~ hrs_since, data = x)
  coef(model)
})

我创建了一个如下所示的 dataframe：

plot	（截距）	hrs_since
1个	2.1	.96
2个	1.3	.85
3个	.8	.99

但是当我向它添加 summary(model)$r.squared 时，如下所示......

output <- ddply(test, "plot", function(x) {
  model <- lm(logT ~ hrs_since, data = x)
  coef(model)
  summary(model)$r.squared
})

我创建了一个如下所示的 dataframe：

plot	V1
1个	0.98
2个	0.97
3个	0.89

正确的 R 平方值已作为 V1 列添加到 df“输出”，但由于某种原因我丢失了 coeff 列？ 理想情况下，我还想添加 rsd 和 st.dev 列，但尚未尝试，因为让 R 平方和 coeff 列正确是我需要的最重要参数。 此外，最初我尝试在 coef(model) 下面的行中使用 r.squared(model) 而不是 summary(model)$r.squared，但这导致出现错误“Error in UseMethod("pmodel.response")：没有适用于“pmodel.response”的方法应用于 class“lm”的 object

另外，我也尝试了一种使用此代码的方法并且它有效但在为每个 plot 返回的参数中未返回系数

output <- test %>%
  group_by(plot) %>%
  do(glance(lm(lnT~hrs_since, data=.)))

先感谢您！

Answer 1

这是一种将每个模型嵌套在 dataframe 中并将结果也捕获在 dataframe 中的方法。 然后使用扫帚 package 提取统计信息。 提取截距和r2有两个不同的扫帚函数，所以我分别运行它们并组合成一个dataframe。

library(dplyr)
library(modelr)
library(tidyverse)

dat_all <- data.frame()

#nest the datasets as separate dataframes
for (p in unique(test$plot)){
    data <- data.frame(x = test$logT[test$plot == p], y = test$hrs_since[test$plot == p])
    names(data) <- c("logT", "hrs_since")
    dd <- data.frame(plot = p, data = data) %>%
        group_by(plot) %>%
        nest()
    dat_all <- rbind(dat_all, dd)
}



myModel <- function(x){
    lm(data.logT ~ data.hrs_since, data = x)
}

#use map to run the model and each of the nested dataframes
dat_all <- dat_all %>%
    mutate(model = map(data, myModel))

#extract the intercepts
i <- dat_all %>% 
    mutate(tidy = map(model, broom::tidy)) %>% 
    unnest(tidy) %>%
    filter(term == "(Intercept)") %>%
    select(plot, intercept = estimate)

#extract r2
r <- dat_all %>% 
    mutate(glance = map(model, broom::glance)) %>% 
    unnest(glance) %>%
    select(plot, r.squared)

#combine statistics by plot
results <- i %>%
    left_join(r, by = "plot")

   plot intercept r.squared
  <dbl>     <dbl>     <dbl>
1     1      1.10     0.618
2     2      1.33     0.871
3     3      1.22     0.380