CUSUM plots have seen application within time series and quality analysis.
For both numeric, binary, ordinal and polytomous outcomes we often use residuals based on regression models instead of empirical means.
Below I apply a standard unpublished technique for adjusted CUSUM plots for operating times using a series based on information from 174 operations performed by the same team.
Simulations are added to illustrate randomness of the phenomena, based on residual standard deviation from a regression analysis.
optime<-c(375,205,255,190,195,235,255,235,305,225,225,255,255,274,255,255,195,270,235,235,255,295,195,375,259,185,205,255,205,285,175,155,215,190,195,315,185,255,405,255,235,135,255,215,255,175,215,195,205,195,345,315,195,135,233,135,315,180,155,315,255,200,315,375,255,375,270,255,210,255,185,235,195,225,145,215,230,278,245,280,230,271,270,213,290,325,375,202,214,435,165,175,325,195,435,245,225,220,215,195,285,315,230,275,355,255,175,160,255,165,145,255,225,265,255,172,375,221,195,355,255,185,205,185,135,375,315,195,225,195,255,375,315,435,255,195,285,255,155,235,255,340,185,245,255,195,285,195,255,249,178,195,205,255,235,185,305,195,289,196,248,205,240,188,231,175,205,299,260,255,279,205,292,182)
#Average operating time
mean(optime)
cusum<-rep(0,length(optime))
cusum[1]<-optime[1]-mean(optime)
for(i in 2:length(optime)) cusum[i]<-cusum[i-1]+(optime[i]-mean(optime))
plot(cusum,type="l",col="blue",lwd="3")
#Simulation of error term, 100 CUSUM curves
err<-as.data.frame(matrix(rnorm(174*100,mean=0,sd=sd(optime)),nrow=100,ncol=174))
for(j in 1:100){
cusum_tmp<-rep(0,length(optime))
cusum_tmp[1]<-optime[1]+as.numeric(err[j,1])-(mean(optime)+mean(as.numeric(err[j,])))
for(i in 2:length(optime)) cusum_tmp[i]<-cusum_tmp[i-1]+as.numeric(err[j,i])+(optime[i]-(mean(optime)+mean(as.numeric(err[j,]))))
lines(cusum_tmp,col="grey",lwd="1")
}
lines(cusum,type="l",col="blue",lwd="3")
#Residual standard deviation from regression analysis
#59.622792
#plot(cusum, type="l", col="blue", lwd="2")
#Predicted values from regression
reg<-c(254.0156,267.2587,306.1491,245.9932,227.6446,234.8840,265.6493,248.3018,257.3252,249.0010,261.9423,242.9064,270.2665,264.2509,254.9376,250.6104,210.7063,254.9376,232.7501,269.3564,258.7236,244.5948,255.9386,265.6493,249.2120,258.9345,244.5948,249.3984,246.6016,246.6924,231.2726,221.9309,239.9776,238.0664,249.7002,244.9922,215.6253,237.2882,258.2353,250.6104,226.9573,217.7111,217.0119,199.9827,235.5714,243.5938,237.5782,230.6643,243.3038,249.2120,214.7033,237.3672,216.2337,223.0275,246.6016,234.3594,232.2736,252.9189,206.5901,238.6866,239.6758,249.7002,248.3018,246.6924,223.0275,252.6171,236.9698,215.3235,221.3391,240.6768,227.6446,256.0342,231.2726,231.6535,228.2648,242.6836,246.9152,255.2275,200.2845,241.2852,252.0088,268.2597,237.2882,217.6321,252.9189,261.0322,269.3564,226.5480,236.4816,258.2353,232.3527,241.2852,274.6727,192.3578,256.3241,227.6446,237.5782,235.7579,252.6171,219.0305,236.6680,202.9905,238.0664,236.6799,216.0227,227.6446,233.8712,263.5517,282.2977,240.5860,212.3157,220.2425,239.6758,238.0664,216.6311,242.9854,236.9698,262.6415,223.0275,248.3018,253.6182,262.4306,249.6094,261.6405,251.7188,245.6914,229.9532,251.9298,240.5860,240.9952,249.7168,264.9620,255.9268,267.2587,270.2665,250.0186,242.2862,256.6260,228.3438,261.2431,260.3330,273.2743,267.2587,262.6415,223.6477,222.9366,263.1464,226.9454,246.3906,250.6104,253.4072,208.0959,232.0509,253.6182,252.2197,271.2675,276.6795,230.9542,232.2736,258.6327,258.2353,255.6249,250.6104,255.3350,238.9884,222.9484,249.0010,247.6026,246.9034,266.3485,228.8566,234.3594,252.2197,239.2784)
cusum_adj<-rep(0,length(optime))
cusum_adj[1]<-optime[1]-reg[1]
for(i in 2:length(reg)) cusum_adj[i]<-cusum_adj[i-1]+optime[i]-reg[i]
plot(cusum_adj,type="l",col="blue",lwd="3")
#Simulation of error term, 100 cusum_adj curves
err<-as.data.frame(matrix(rnorm(174*100,mean=0,sd=29.622792),nrow=100,ncol=174))
for(j in 1:100){
cusum_adj_tmp<-rep(0,length(reg))
cusum_adj_tmp[1]<-optime[1]-reg[1]+as.numeric(err[j,1])-mean(as.numeric(err[j,]))
for(i in 2:length(reg)) cusum_adj_tmp[i]<-cusum_adj_tmp[i-1]+optime[i]-reg[i]+as.numeric(err[j,i])-mean(as.numeric(err[j,]))
lines(cusum_adj_tmp,col="grey",lwd="1")
}
lines(cusum,type="l",col="lightblue",lwd="3")
lines(cusum_adj,type="l",col="blue",lwd="3")
Comentários