R语言插入新数据：生成日期与对应系数匹配的结果表格

解决方案代码 #

# 加载依赖包
library(dplyr)
library(tidyr)
library(lubridate)
library(purrr)

# 原始数据集
df1 <- structure(
  list(date1 = c("2021-06-28","2021-06-28","2021-06-28","2021-06-28","2021-06-28",
                 "2021-06-28","2021-06-28","2021-06-28"),
       date2 = c("2021-04-02","2021-04-03","2021-04-08","2021-04-09","2021-04-10","2021-07-01","2021-07-02","2021-07-03"),
       Week= c("Friday","Saturday","Thursday","Friday","Saturday","Thursday","Friday","Monday"),
       DR01 = c(14,11,14,13,13,14,13,16), DR02= c(14,12,16,17,13,12,17,14),DR03= c(19,15,14,13,13,12,11,15),
       DR04 = c(15,14,13,13,16,12,11,19),DR05 = c(15,14,15,13,16,12,11,19),
       DR06 = c(21,14,13,13,15,16,17,18),DR07 = c(12,15,14,14,19,14,17,18)),
  class = "data.frame", row.names = c(NA, -8L))

# 设定基准日期，筛选符合规则的日期后逐组拟合模型提取b2系数
base_date <- ymd("2021-06-28")
result_df <- df1 %>%
  mutate(across(c(date1, date2), ymd)) %>%
  filter(date2 > base_date) %>%
  group_by(date2) %>%
  summarise(across(starts_with("DR"), sum), .groups = "drop") %>%
  nest(data = -date2) %>%
  mutate(
    b2 = map_dbl(data, ~{
      datas <- pivot_longer(.x, everything(), names_pattern = "DR(.+)", values_to = "val") %>%
        mutate(name = as.numeric(name))
      colnames(datas) <- c("Days", "Numbers")
      mod <- nls(Numbers ~ b1*Days^2+b2, start = list(b1 = 47, b2 = 0), data = datas)
      as.numeric(coef(mod)[2])
    })
  ) %>%
  select(date2, b2)

# 输出结果
print(result_df, digits = 4)

运行输出结果 #

# A tibble: 3 × 2
  date2         b2
  <date>     <dbl>
1 2021-07-01  14.2
2 2021-07-02  12.55
3 2021-07-03  15.55

如需调整b2的小数保留位数，修改print函数的digits参数即可。

内容的提问来源于stack exchange，提问作者user16774617