残差图1 --双轴方式
#：更改 ----号线之间的内容
# ==双坐标轴，3个以上y向量，主次分明= 如何调整左右两个纵坐标轴的界限
# data("women")
# head(women)
# attach(women)
# lm<-lm(weight~height)
#
# prd.weight = predict(lm) #fitted value of [weight] .
# err <- weight-prd.weight #实际值-拟合值=残差
# --演示数据2
data <- read.table("H:\\R\\Data\\HubeiPeakLoad.txt", header = T, sep = "\t")
##-----------------------初始参数设置
# --变量设置
# x = height
# fit = prd.weight
# real = weight
# err = err
x_label = data$date
x = c(1:92)
fit = data$fitted
real = data$real
err = data$err
# x 轴刻度标签
x_at = seq(1:92)
x_label = x_label
# --左纵轴 tick 间隔设置
f_y = 1 # 10的次幂！！根据实际值调节， 假设实际值 类似如：0.135 ，这种很小的数值，适合 f = 100 ; 当数值很大，如10000，考察使用10^(-3)
###################################################
# 确定左纵轴范围和右纵轴范围 -- 拟合和实际图占据 2/3 ， 残差占 1/3
max_fit_real = ceiling(max(fit, real)*f_y) / f_y
min_fit_real = floor(min(fit, real)*f_y) / f_y
y_left_ceil = max_fit_real # 左边纵轴上限
y_left_floor = floor((min_fit_real - (max_fit_real - min_fit_real) / 2)*f_y) / f_y # 左边纵轴下限
min_err = floor(min(err))
max_err = ceiling(max(err))
y_right_ceil = min_err + 3*(max_err - min_err)
y_right_floor = min_err
# 确定 x 轴的范围
x_min = floor(min(x))
x_max = ceiling(max(x))
##------------ 标签、刻度 ###################################
# 左边纵轴刻度、标签
y_left_at = seq(min_fit_real, y_left_ceil , 500)
y_left_label = y_left_at
# 右边纵坐标刻度、标签
y_right_at = seq(y_right_floor, max_err, 100)
y_right_label = y_right_at
################################################
# --实际值图
par(mar=c(5,5,4,5)+0.1)
plot(x, real, xlim=c(x_min, x_max),
ylim=c(y_left_floor, y_left_ceil), axes=F, type="n", xlab="", ylab="") #缩小下限==拉高图形★★
lines(x, real, lwd=2, col="blue")
# points(x, real, bg="blue1", lwd=2)
axis(1, col="black", col.axis="black", las=3, cex.axis = 0.5, at = x_at , labels = x_label)
title(ylab="实际值&拟合值", col.lab="black")
# --拟合值图
par(new=T)
plot(x, fit, type="n", col="black", ylim=c(y_left_floor, y_left_ceil), axes=F, xlab="", ylab="")
##拟合值纵坐标界限与实际值的差不多
##这里的y轴上下界限与上一[plot]一致，则会继续用上图层的y轴，即还是左纵轴★
lines(x, fit, lty=1, col="red", lwd=2) #拟合线
# points(x, fit, pch=23, bg="red", cex=1.2)
axis(2,col="black",col.axis="black",at = y_left_at, labels = y_left_label)
# --残差
par(new=T)
barplot(err, col="gray", xlab="", ylab="", axes=F, axisnames = FALSE ,
ylim = c(y_right_floor, y_right_ceil) ) #缩小上限==拉高图形★★
##这里改变了y轴界限，则会用到右纵轴
axis(4,col="black", at = y_right_at, labels = y_right_label)
title(main = list("实际值和拟合值对比图",cex=1, col="black", font=1))
title(xlab = list("x",cex=1, col="black", font=1 ), line = 3) # 更改 x 轴标题
mtext(text="残差",side=4, col="black", line=2)
# abline(h=mean(err),col="red2",lty=3) #残差均值处绘制一条横线
box()
残差图（双坐标轴方式）
残差图2 -- 组合方式
data <- data <- read.table("H:\\R\\Data\\HubeiPeakLoad.txt", header = T, sep = "\t")
data = data.frame(date_n = c(1:92) , data)
attach(data)
library(ggplot2)
# 绘制上面的实际值、拟合值曲线图
fit_real <- ggplot()+
geom_line(data=data,aes(date_n, fitted)) +
theme(
legend.position="none" ,
axis.title.x = element_blank() ,
axis.ticks.x = element_blank() ,
axis.text.x = element_blank() # 去掉横轴标签
) ##去掉图例
fit_real = fit_real + labs(y = "实际值&拟合值")
fit_real = fit_real + geom_line(aes(date_n, real), colour = "red", alpha = 0.8)
# 绘制残差序列
err = ggplot(data, aes(date_n, err)) +
geom_bar(stat = "identity", fill = "black", alpha = 0.5)
err = err + scale_x_continuous(breaks = data$date_n, labels = data$date)
err = err+ theme(axis.text.x = element_text(size = 8, angle = 90))
err = err + labs(y = "残差", x = "日期")
err
# 组合
library(gridExtra)
grid.arrange(fit_real, err, ncol = 1, nrow = 2, heights=c(1.618,1))
残差图2（组合方式）