在 lapply 中使用特定列计算几个回归分析答案

【问题标题】：Calculating several regression analysis with specific columns in lapply在 lapply 中使用特定列计算几个回归分析
【发布时间】：2019-11-30 14:47:38
【问题描述】：

这是我的数据：

df1<-read.table(text=" Time1    Time2   Time3   MNR1    MNR2    MNR3

36  36  43  5   4   5
40  41  51  4   6   4
38  36  50  7   8   3
35  51  43  8   3   2
52  55  57  3   2   4
",header=TRUE)

我想使用 lapply 进行循环（最好）使用回归模型分析 Time1 与 MNR1、Time2 与 MNR2 以及 Time 3 与 MRN3 使用回归模型和 ....

我尝试了以下功能，但没有得到结果：

R <- lapply(1:ncol(df1), function(x) lm(Time[,x] ~ MNR[,x]))

但它并没有给我每个组的结果。我们可以使用 lapply 吗？

【问题讨论】：

您尚未定义 Time 或 MNR，如果您定义了，则索引会从 1 变为 3，而不是 1 到 6。Time <- df1[1:3]; MNR <- df1[4:6]; lapply(1:3, function(x) lm(Time[,x] ~ MNR[,x]))

标签： r regression lapply

【解决方案1】：

我们可以使用Map 粘贴相应的列名或使用reformulate 创建公式，方法是在Map 中分别传递“Times”和“MNR”列名

Map(function(x, y) lm(reformulate(y, x), data = df1),
        names(df1)[1:3], names(df1)[4:6])

或者paste

Map(function(x, y) lm(paste(x, y, sep="~"), data = df1),
        names(df1)[1:3], names(df1)[4:6])

或使用lapply

lapply(paste(names(df1)[1:3], "~", names(df1)[4:6]), function(x) lm(x, data = df1))

或者用map2 来自purrr

library(purrr)
map2(names(df1)[1:3], names(df1)[4:6], ~ lm(reformulate(.y, .x), data = df1)

【讨论】：

【解决方案2】：

lapply(1:3, function(i) lm(as.formula(paste0('Time', i, ' ~ ', 'MNR', i)), data = df1))

【讨论】：

虽然这是一个公认的答案，但它并不是一个很好的答案，因为它没有解释它为什么起作用。你会考虑添加一些文字吗？

【解决方案3】：

reshape 到一个 15x4 长格式 data.frame long 具有列名称 No、Time、MNR 和 id。 No 列包含值 1、2 和 3，Time 和 MNR 列包含来自原始数据帧的相应数据。不使用 id 列。它由reshape 自动生成，包含long 的那一行中的数据来自的行号。这个长数据框不仅可用于生成问题中要求的结果，还可用于生成图形，如下所示。

然后我们在 nlme 中使用lmList（R 自带，无需安装）一次性执行所有回归。根据您的需要，您可以设置pool = TRUE 来汇集错误（而不是pool = FALSE）。请注意，out[[1]]、out[[2]] 和 out[[3]] 分别是 3 个 lm 对象。

library(nlme)

v <- list(Time = 1:3, MNR = 4:6)
long <- reshape(df1, dir = "long", varying = v, v.names = names(v), timevar = "No")
out <- lmList(Time ~ MNR | No, long, pool = FALSE)
out

给予：

Call:
  Model: Time ~ MNR | No 
   Data: long 

Coefficients:
  (Intercept)        MNR
1    53.82558 -2.5232558
2    56.96552 -2.8620690
3    45.61538  0.8846154

图形

library(ggplot2)
ggplot(long, aes(MNR, Time)) +
  geom_point() +
  geom_smooth(method = "lm") +
  facet_wrap(~ No)

或使用经典图形：

old.par <- par(mfrow = c(2,2))
for(nm in names(out)) { 
  fm <- out[[nm]]
  fo <- formula(fm)
  plot(fo, long, type = "n", main = nm)
  points(fo, model.frame(fm))
  abline(fm)
}
par(old.par)

【讨论】：