R - 循环 lm() 按列遍历具有缺失值的 Dataframe

Question

我正在处理一个由至少三个变量（波长、辐照度、x）组成的数据框，我已经对这些变量进行了调整，以便每个波长都是一个新行，从而允许我运行 lm( ) 在每个波长上提取系数，这样我就可以看到 x 如何随波长和辐照度变化。

但是，我能够让它工作的唯一方法是在每个波长上显式运行ning lm()。这对于较大的数据帧是不可行的，这些数据帧将具有数百个参数，这些参数会随着波长和辐照度的变化而变化。

我觉得可以使用 'apply' 或编写循环来解决这个问题，但我没有运气让它们起作用。

请参阅下面的问题示例。

我还是个新手，所以不胜感激

irr = rnorm(33, 10, 3)
wave = c(290, 290, 290, 300, 300, 300, 310, 310, 310, 320, 320, 320, 330, 330, 330, 340, 340, 340, 350, 350, 350, 360, 360, 360, 370, 370, 370, 380, 380, 380, 400, 400, 400)
x = rnorm(33, 50, 2)
df <- as.data.frame(cbind(wave, irr, x))
df_wide <- df %>%
  pivot_wider(names_from = "wave",
              values_from = "x")
"290_lm" <- lm(df_wide$`290` ~ df_wide$irr) 
"300_lm" <- lm(df_wide$`300` ~ df_wide$irr) #etc through each wavelength

## Attempt at loop

for (i in 2:(ncol(df_wide))){
  irr <- df_wide[2][i]
  lm_function <- paste(irr,
                       sep = "~")
  df_lm = lm(lm_function, 
             data = df_wide[2:12])
}

Answer 1

当您使用长格式时，这可能会容易很多。只需使用 lapply 对您的数据进行子集化。使用 setNames 生成的列表会得到好听的名字。

res <- setNames(lapply(unique(df$wave), function(w) 
  lm(x ~ irr, data=df[df$wave %in% w, ])),
  paste0("wave.", unique(df$wave)))
res
# $wave.290
# 
# Call:
#   lm(formula = x ~ irr, data = df[df$wave %in% w, ])
# 
# Coefficients:
#   (Intercept)          irr  
# 36.837        1.503  
# 
# 
# $wave.300
# 
# Call:
#   lm(formula = x ~ irr, data = df[df$wave %in% w, ])
# 
# Coefficients:
#   (Intercept)          irr  
# 54.3785      -0.5586 
# [...]

Answer 2

据我所知，根据你的描述，你的问题与 purrr::map 的示例相同，这避免了扩大范围的需要。

library(dplyr)
library(purrr)

results_list <- 
  df %>% 
  split(.$wave) %>% 
  map(~ lm(x ~ irr, data = .x)) %>% 
  map(summary)

results_list$`350`
#> 
#> Call:
#> lm(formula = x ~ irr, data = .x)
#> 
#> Residuals:
#>      19      20      21 
#>  0.2924 -2.2947  2.0023 
#> 
#> Coefficients:
#>             Estimate Std. Error t value Pr(>|t|)  
#> (Intercept)  52.7276     6.2200   8.477   0.0748 .
#> irr          -0.4977     0.6229  -0.799   0.5708  
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 3.059 on 1 degrees of freedom
#> Multiple R-squared:  0.3897, Adjusted R-squared:  -0.2206 
#> F-statistic: 0.6385 on 1 and 1 DF,  p-value: 0.5708

根据您的数据

irr = rnorm(33, 10, 3)
wave = c(290, 290, 290, 300, 300, 300, 310, 310, 310, 320, 320, 320, 330, 330, 330, 340, 340, 340, 350, 350, 350, 360, 360, 360, 370, 370, 370, 380, 380, 380, 400, 400, 400)
x = rnorm(33, 50, 2)
df <- as.data.frame(cbind(wave, irr, x))

^{由 reprex package (v0.3.0)}

于 2020-05-12 创建

Answer 3

附加解决方案

library(tidyverse)
library(generics)
df %>% 
  group_by(wave) %>% 
  nest() %>% 
  mutate(model = map(data, ~ lm(x ~ irr, data = .x) %>% tidy)) %>% 
  select(-data) %>% 
  unnest(model)

Answer 4

或如下：

df <- data.frame(
  irr = rnorm(33, 10, 3),
  wave = c(290, 290, 290, 300, 300, 300, 310, 310, 310, 
           320, 320, 320, 330, 330, 330, 340, 340, 340, 350, 350, 350, 
           360, 360, 360, 370, 370, 370, 380, 380, 380, 400, 400, 400),
  x = rnorm(33, 50, 2)

)

mylm <- function(w) {
  m <- lm(x ~ irr, data = df, subset = (wave == w))
  ## outcomment the following if you just need the parameters
  # coef(m)
}

lapply(df$wave, mylm)

R - 循环 lm() 按列遍历具有缺失值的 Dataframe

R - Loop lm() columnwise through Dataframe with missing Values

loops

r

apply

lm