spc.individuals.chart<-function(x
#,set = rep(1,length(x))
,xchart.center.line.fn = spc.ungrouped.center.line.mean
,mrchart.center.line.fn = spc.ungrouped.center.line.mean.moving.range
,xchart.control.limits.fn = spc.ungrouped.control.limits.mean.moving.range
,mrchart.control.limits.fn = spc.ungrouped.control.limits.dispersion.mean.moving.range
,n.sigma = 3
,info.xchart = T
,display.xchart = T
,xchart.main = "Individuals Chart"
,xchart.xlab = "Time"
,xchart.ylab = "Criterion Measure"
,xchart.col = c("blue", "orange")
,xchart.line.col = "grey"
,xchart.pch = c(19,19)
,xchart.rules = .spc.default.x.chart.rules
,xchart.center.line.col = "lightblue"
,xchart.control.limit.col = "orange"
,info.mrchart = T
,display.mrchart = T
,mrchart.main = "Moving Range Chart"
,mrchart.xlab = "Time"
,mrchart.ylab = "Moving Range"
,mrchart.col = c("blue", "orange")
,mrchart.line.col = "grey"
,mrchart.pch = c(19,19)
,mrchart.rules = .spc.default.mr.chart.rules
,mrchart.center.line.col = "lightblue"
,mrchart.control.limit.col = "orange"
,combine.charts = c("combine.charts", "separate", "leave.par.alone")
,...) {
warning("Deprecated: Use spc.chart.* functions instead.")
par.backup <- par(no.readonly = T)
if (combine.charts[1] == "leave.par.alone") {
} else if (display.xchart & display.mrchart & combine.charts[1] == "combine.charts") {
par(mfrow=c(2,1))
par(mar=c(4,4,2,2))
par(cex.main=1)
} else {
par(mfrow=c(1,1))
}
mr.series <- c(NA,abs(diff(x)))
xchart.center.line <- xchart.center.line.fn(x)
mrchart.center.line <- mrchart.center.line.fn(x)
xchart.limits <- xchart.control.limits.fn(center.line = xchart.center.line,
standard.error = mrchart.center.line,
n.sigma = n.sigma)
mrchart.limits <- mrchart.control.limits.fn(standard.error = mrchart.center.line, n.sigma = n.sigma)
xchart.ylim <- c(min(na.omit(c(x, xchart.limits$LCL))), max(na.omit(c(x, xchart.limits$UCL))))
mrchart.ylim <- c(min(na.omit(c(mr.series, mrchart.limits$LCL))), max(na.omit(c(mr.series, mrchart.limits$UCL))))
if (length(xchart.rules) > 0 & !all(is.na(xchart.rules))) {
xchart.violations <- matrix(xchart.rules[[1]](x = x
,center.line = xchart.center.line
,standard.error = mrchart.center.line
,upper.control.limit = xchart.limits$UCL
,lower.control.limit = xchart.limits$LCL
)
,nrow=length(x)
,ncol = 1)
if (length(xchart.rules) > 1) {
for (i in 2:length(xchart.rules)) {
xchart.violations <- cbind(xchart.violations,
xchart.rules[[i]](x = x
,center.line = xchart.center.line
,standard.error = mrchart.center.line
,upper.control.limit = xchart.limits$UCL
,lower.control.limit = xchart.limits$LCL
))
}
}
}
xchart.viol <- rep(1,length(x))
xchart.viol <- xchart.viol + ifelse(apply(xchart.violations,1,FUN=sum) > 0, 1, 0)
if (display.xchart) {
plot(1:length(x),
x,
main=xchart.main,
xlab = xchart.xlab,
ylab = xchart.ylab,
ylim = xchart.ylim,
type = "l",
col = xchart.line.col,
xaxt="n",
...)
if (!is.na(xchart.center.line)) {
abline(h=xchart.center.line, col = xchart.center.line.col)
}
limits<-c(xchart.limits$UCL, xchart.limits$LCL)
limits <- na.omit(limits)
if (length(limits > 0)) {
abline(h=limits, col = xchart.control.limit.col)
}
axis(1,at=1:length(x),labels = 1:length(x))
points(1:length(x), x, col = xchart.col[xchart.viol], pch = xchart.pch[xchart.viol])
}
if (length(mrchart.rules) > 0 & !all(is.na(mrchart.rules))) {
mrchart.violations <- matrix(mrchart.rules[[1]](x = mr.series
,center.line = mrchart.center.line
,standard.error = mrchart.center.line #TODO...
,upper.control.limit = mrchart.limits$UCL
,lower.control.limit = mrchart.limits$LCL
)
,nrow=length(x)
,ncol = 1)
if (length(mrchart.rules) > 1) {
for (i in 2:length(mrchart.rules)) {
mrchart.violations <- cbind(mrchart.violations,
mrchart.rules[[i]](x = mr.series
,center.line = mrchart.center.line
,standard.error = mrchart.center.line #TODO...
,upper.control.limit = mrchart.limits$UCL
,lower.control.limit = mrchart.limits$LCL
))
}
}
}
mrchart.viol <- rep(1,length(mr.series))
mrchart.viol <- mrchart.viol + ifelse(apply(mrchart.violations,1,FUN=sum) > 0, 1, 0)
if (display.mrchart) {
plot(1:length(mr.series),
mr.series,
main=mrchart.main,
xlab = mrchart.xlab,
ylab = mrchart.ylab,
ylim = mrchart.ylim,
type = "l",
col = mrchart.line.col,
xaxt="n",
...)
if (!is.na(mrchart.center.line)) {
abline(h=mrchart.center.line, col = mrchart.center.line.col)
}
limits<-c(mrchart.limits$UCL, mrchart.limits$LCL)
limits <- na.omit(limits)
if (length(limits > 0)) {
abline(h=limits, col = mrchart.control.limit.col)
}
axis(1,at=1:length(mr.series),labels = 1:length(mr.series))
points(1:length(mr.series), mr.series, col = mrchart.col[mrchart.viol], pch = mrchart.pch[mrchart.viol])
}
if (combine.charts[1] != "leave.par.alone") {
oldw <- getOption("warn")
options(warn = -1)
par(par.backup)
options(warn = oldw)
}
list(xchart.limits = xchart.limits
,mrchart.limits = mrchart.limits
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.