如何优化R语言生成图表的代码 解决日期重复使用等冗余问题

核心优化点说明 #

• 仅定义1次目标日期变量target_date，两处逻辑统一调用该变量，修改日期时只需调整1次即可
• 移除冗余包加载：tidyverse已经包含dplyr，无需重复引入
• 移除风险较高的attach()函数，改为直接通过数据框引用列，避免环境变量冲突
• 提前统一完成日期列类型转换，避免后续重复转格式
• 调整自定义函数支持传入数据集参数，消除全局变量依赖
• 移除不必要的中间变量与冗余打印步骤，简化代码逻辑

优化后完整代码 #

# 加载依赖包
library(tidyverse)
library(lubridate)

# 数据集
df <- 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(4,1,4,3,3,4,3,6), DR02= c(4,2,6,7,3,2,7,4),DR03= c(9,5,4,3,3,2,1,5),
       DR04 = c(5,4,3,3,6,2,1,9),DR05 = c(5,4,5,3,6,2,1,9),
       DR06 = c(2,4,3,3,5,6,7,8),DR07 = c(2,5,4,4,9,4,7,8)),
  class = "data.frame", row.names = c(NA, -8L))

# 仅需定义一次目标日期，后续所有逻辑统一调用
target_date <- "2021-07-01"
# 提前统一转换日期列格式
df[, 1:2] = lapply(df[, 1:2], FUN = as_date)

# 自定义函数调整为传入数据集参数，消除全局变量依赖
get_cutoff = function(date, df) {
  date2 = as_date(date)
  date1 = df[1,1]
  as.numeric(date2 - date1 + 1)
}
subset_data = function(date, start_index, df) {
  date = as_date(date)
  if (date > df[1,1]) {
    end_index = start_index + get_cutoff(date, df) - 1
    df[, -c(start_index:end_index)] %>%
      filter(date2 == date)
  } else {
    return(df)
  }
} 

# 生成图表基础数据
datas <- df %>%
  filter(date2 == ymd(target_date)) %>%
  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")

# 绘图（移除attach，直接引用列）
plot(Numbers ~ Days, data = datas, ylim=c(0,20))

# 拟合模型并画拟合线
model <- nls(Numbers ~ b1*Days^2+b2, data = datas, start = list(b1 = 47,b2 = 0))
new.data <- data.frame(Days = seq(min(datas$Days),max(datas$Days),len = 45))
lines(new.data$Days,predict(model,newdata = new.data))

# 生成红色点数据，直接调用已经定义的target_date
y <- subset_data(target_date, 4, df)
new_y <- pivot_longer(y, cols=c(starts_with("DR"))) %>% 
  mutate(day = parse_number(name))

# 添加红色点线
lines(x=new_y$day, y=new_y$value, col="red")
points(x=new_y$day, y=new_y$value, col="red")

效果说明 #

优化后代码运行效果与原代码完全一致，效果图如下：

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