在R语言生成的表格中插入D1变量及coef-D1计算结果列

解决方法 #

你只需要在原有代码的管道流末尾，先关联df1中对应日期的D1值，再计算result字段即可，注意要统一日期格式避免匹配失败。以下是完整可运行代码：

library(purrr)
library(dplyr)
library(tidyverse)
library(lubridate)

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","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",
                 "2021-07-04","2021-07-05","2021-07-05"),
       Week= c("Friday","Saturday","Thursday","Friday","Saturday","Thursday","Friday","Saturday","Sunday","Monday","Monday"),
       D1 = c(14,11,14,13,13,14,13,16,15,11,13), DR01 = c(14,11,14,13,13,14,13,16,15,11,13), 
       DR02= c(14,12,16,17,13,12,17,14,13,15,18),DR03= c(19,15,14,13,13,12,11,15,13,13,18),
       DR04 = c(15,14,13,13,16,12,11,19,11,12,11),DR05 = c(15,14,15,13,16,12,11,19,14,15,18),
       DR06 = c(21,14,13,13,15,16,17,18,12,12,18),DR07 = c(12,15,14,14,19,14,17,18,14,13,18)),
  class = "data.frame", row.names = c(NA, -11L))

# 提前预处理df1，得到每个date2对应的唯一D1值（默认取每个日期第一条记录的D1）
df1_d1 <- df1 %>% 
  distinct(date2, .keep_all = T) %>% 
  select(date2, D1) %>% 
  # 统一日期格式为和输出一致的日/月/年，方便后续匹配
  mutate(dates = format(ymd(date2), "%d/%m/%Y")) %>% 
  select(dates, D1)

dates <- subset(df1, date2 > date1, select = date2)$date2
map_dfr(dates, ~ {
  
  datas <- df1 %>%
    filter(date2 == ymd(.x)) %>%
    summarize(across(starts_with("DR"), sum)) %>%
    pivot_longer(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)
  tibble(dates = .x, coef = coef(mod)[2])
}) %>%
  mutate(dates = format(ymd(dates), "%d/%m/%Y")) %>%
  distinct() %>%
  # 匹配对应日期的D1值
  left_join(df1_d1, by = "dates") %>%
  # 计算result字段
  mutate(result = coef - D1)

运行输出示例 #

# A tibble: 5 × 4
  dates       coef    D1 result
  <chr>      <dbl> <dbl>  <dbl>
1 01/07/2021  12.2    14  -1.8 
2 02/07/2021  12.4    13  -0.6 
3 03/07/2021  15.6    16  -0.4 
4 04/07/2021  13.3    15  -1.7 
5 05/07/2021  27.9    11  16.9 

如果需要取2021-07-05对应的另一个D1值13，只需修改df1_d1的去重逻辑，按日期分组后取最后一条记录的D1即可：

df1_d1 <- df1 %>% 
  group_by(date2) %>% 
  slice(n()) %>% 
  ungroup() %>% 
  select(date2, D1) %>% 
  mutate(dates = format(ymd(date2), "%d/%m/%Y")) %>% 
  select(dates, D1)

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