创建一个循环，为每个日期创建线性回归

Question

每次在实验室分析样品时，我都需要使用线性回归模型创建单独的标准曲线。下面的代码使我可以过滤掉每个日期的观察结果，然后将该数据框插入回归模型并绘图，以便我得到该日期的标准曲线，显示曲线的 R 平方值和方程。

我的数据可以在https://github.com/derekpagenkopp/ghg_flux找到

#------------------------------------------
# Load packages
library(tidyverse)
library(here)


#-------------------------------------------
# Read in data

ch4_standards <- read_csv(here::here("data",
                                     "ch4_standard_raw.csv"))

#-------------------------------------------
# Use lm(), linear model function, to create regression model

### Change dates in name and filter

fit_ch4_20190830 <- lm(ppm ~ area, data = ch4_standards %>% filter(date == "2019_08_30"))

#-------------------------------------------
#Use summary function to get summary information about linear model

### Changes dates

summary(fit_ch4_20190830)

#--------------------------------------------
#Function to create standard curve
### Change date in labs

ggplot_regression <- function (fit) {

  require(ggplot2)

  ggplot(fit$model, aes_string(x = names(fit$model)[1], y = names(fit$model)[2])) + 
    geom_point() +
    stat_smooth(method = "lm", col = "red") +
    labs(title = "20190830 CH4 Standard Curve", caption = paste("Adj R2 = ",signif(summary(fit)$adj.r.squared, 5),
                                                                "Intercept =",signif(fit$coef[[1]],5 ),
                                                                " Slope =",signif(fit$coef[[2]], 5),
                                                                " P =",signif(summary(fit)$coef[2,4], 5)))
}

### Change date in filter




ggplot_regression(lm(ppm ~ area, data = ch4_standards %>% 
                       filter(date == "2019_08_30")))+
  coord_flip()+
  theme_classic()+
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        plot.title = element_text(hjust = 0.5),
        title = element_text(vjust=3))

我想编写一个循环，为每个日期运行线性回归，然后让 R 使用 facet_wrap(~date) 为每个日期提供一个图表，并在每个图表上显示 R 平方值和回归方程。

Answer 1

不是facet_wrap() 解决方案，但这是使用gridExtra 包中的grid.arrange() 的解决方案。

它首先创建一个包含每个日期的lm() 输出的列表，每个元素都以该日期命名。然后是包含所有 ggplot 对象的第二个列表。最后，grid.arrange() 显示所有图。

library(gridExtra)

ggplot_regression <- function (fit, date) {

  require(ggplot2)

  ggplot(fit$model, aes_string(x = names(fit$model)[1], y = names(fit$model)[2])) + 
    geom_point() +
    stat_smooth(method = "lm", col = "red") +
    labs(title = paste(date, " CH4 Standard Curve"), 
         caption = paste("Adj R2 = ",
                         signif(summary(fit)$adj.r.squared, 5),
                         "Intercept =",signif(fit$coef[[1]],5 ),
                         " Slope =",signif(fit$coef[[2]], 5),
                         " P =",
                         signif(summary(fit)$coef[2,4], 5)))
}

dates_list <- unique(ch4_standards$date) %>% 
  sort() %>% 
  as.list()

reg_list <- map(dates_list, 
                ~ lm(ppm ~ area, data = ch4_standards %>% filter(date == .x))) %>% 
  set_names(dates_list)

reg_ggplot_list <- map2(reg_list, 
                        dates_list, 
                       ~ ggplot_regression(fit = .x, date = .y))

通过列表元素索引或名称访问绘图。

reg_ggplot_list[[4]]
reg_ggplot_list[["2019_08_30"]]

显示所有图。

n <- length(reg_ggplot_list)
nCol <- floor(sqrt(n))
do.call("grid.arrange", c(reg_ggplot_list, ncol=nCol))