R语言datas变量值相等时nls函数失效无法生成预测线图表求助

解决思路 #

在执行nls拟合前增加判断逻辑：检查datas中Numbers列的所有取值是否一致，如果一致就跳过拟合直接绘制水平线，否则执行原有的非线性拟合逻辑。

修改后完整代码 #

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

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,0,0), DR02= c(14,12,16,17,13,12,0,0),DR03= c(19,15,14,13,13,12,0,0),
       DR04 = c(15,14,13,13,16,12,13,0),DR05 = c(15,14,15,13,16,12,13,11),
       DR06 = c(21,14,13,13,15,16,13,11),DR07 = c(12,15,14,14,19,14,13,11)),
  class = "data.frame", row.names = c(NA, -8L))

dmda<-"2021-07-03" # 测试全为11的日期也可正常出图

datas<-df1 %>%
  filter(date2 == ymd(dmda)) %>%
  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")

dif <- as.Date(dmda) - as.Date(df1$date1[1]) + 1
datas <- datas[dif:max(datas$Days, na.rm = TRUE),]

plot(Numbers ~ Days, xlim=c(0,8), ylim=c(0,20), data = datas,xaxs='i')

# 新增判断逻辑
if (length(unique(datas$Numbers)) == 1) {
  # 所有值相等的情况，直接取固定值
  fixed_val <- datas$Numbers[1]
  new.data <- data.frame(Days = seq(0, max(datas$Days, na.rm = TRUE), len = 45))
  lines(new.data$Days, rep(fixed_val, nrow(new.data)))
  points(0, fixed_val, col="red", pch=19, cex=1.2, xpd=TRUE)
} else {
  # 原有的nls拟合逻辑
  mod <- nls(Numbers ~ b1*Days^2+b2,start = list(b1 = 0,b2 = 0), data = datas)
  new.data <- data.frame(Days = with(datas, seq(min(Days),max(Days),len = 45)))
  new.data <- rbind(0, new.data)
  lines(new.data$Days, predict(mod, newdata=new.data))
  points(0, coef(mod)[2], col="red", pch=19, cex=1.2, xpd=TRUE)
}

说明 #

• 用length(unique(datas$Numbers)) == 1判断所有数值是否一致，逻辑简单直接，额外计算开销极低
• 数值一致时直接生成水平的预测线，红色点取值和预测线完全匹配，符合预期效果
• 原有正常日期的拟合逻辑完全保留，不会影响之前的出图效果

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