Remove Control Limits With qcc Package in R (Quality Control Charts)

Question

I need to remove the lower control limit and center line (and their labels) from my control chart.

Here's the code:

# install.packages('qcc')
library(qcc)
nonconforming <- c(3, 4, 6, 5, 2, 8, 9, 4, 2, 6, 4, 8, 0, 7, 20, 6, 1, 5, 7)
samplesize <- rep(50, 19)
control <- qcc(nonconforming, type = "p", samplesize, plot = "FALSE")
warn.limits <- limits.p(control$center, control$std.dev, control$sizes, 2)
par(mar = c(5, 3, 1, 3), bg = "blue")
plot(control, restore.par = FALSE, title = "P Chart for Medical Insurance Claims", 
     xlab = "Day", ylab = "Proportion Defective")
abline(h = warn.limits, lty = 3, col = "blue")
v2 <- c("LWL", "UWL")  # the labels for warn.limits
mtext(side = 4, text = v2, at = warn.limits, col = "blue", las = 2) 

Answer 1

Not a QC expert by any means but would this work for you? Looking at the qcc function it seems to control what needs to be plotted, so what i've done here is manipulate the limits of the LCL and CENTRE lines. I then changed the plot function to plot between some y limits which does not cover the -1 value. The description unfortunately reflects the manipulated limit values of -1.

control$limits[1] <- -1
control$center <- -1

    plot(control, restore.par = FALSE, title = "P Chart for Medical Insurance Claims", 
     xlab = "Day", ylab = "Proportion Defective", ylim=c(0.0,0.4))

Answer 2

The following function will do the required chart, and you don't need to change your control object, neither to know the control's limits. Load the function, then just call:

plot.qcc2(control, restore.par = FALSE, title = "P Chart for Medical Insurance    Claims", +      xlab = "Day", ylab = "Proportion Defective")

Function:

#Function plotting only UCL:  
plot.qcc2 <- function (x, add.stats = TRUE, chart.all = TRUE, label.limits = c( "UCL"), title, xlab, ylab, ylim, axes.las = 0, digits = getOption("digits"), 
restore.par = TRUE, ...) 
{
object <- x
if ((missing(object)) | (!inherits(object, "qcc"))) 
       stop("an object of class `qcc' is required")
type <- object$type
std.dev <- object$std.dev
data.name <- object$data.name
center <- object$center
stats <- object$statistics
limits <- object$limits
lcl <- limits[, 1]
ucl <- limits[, 2]
newstats <- object$newstats
newdata.name <- object$newdata.name
violations <- object$violations
if (chart.all) {
    statistics <- c(stats, newstats)
    indices <- 1:length(statistics)
}
else {
    if (is.null(newstats)) {
        statistics <- stats
        indices <- 1:length(statistics)
    }
    else {
        statistics <- newstats
        indices <- seq(length(stats) + 1, length(stats) + 
            length(newstats))
    }
}
if (missing(title)) {
    if (is.null(newstats)) 
        main.title <- paste(type, "Chart\nfor", data.name)
    else if (chart.all) 
        main.title <- paste(type, "Chart\nfor", data.name, 
            "and", newdata.name)
    else main.title <- paste(type, "Chart\nfor", newdata.name)
}
else main.title <- paste(title)
oldpar <- par(bg = qcc.options("bg.margin"), cex = qcc.options("cex"), 
    mar = if (add.stats) 
        pmax(par("mar"), c(8.5, 0, 0, 0))
    else par("mar"), no.readonly = TRUE)
if (restore.par) 
    on.exit(par(oldpar))
plot(indices, statistics, type = "n", ylim = if (!missing(ylim)) 
    ylim
else range(statistics, limits, center), ylab = if (missing(ylab)) 
    "Group summary statistics"
else ylab, xlab = if (missing(xlab)) 
    "Group"
else xlab, axes = FALSE, main = main.title)
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], 
    col = qcc.options("bg.figure"))
axis(1, at = indices, las = axes.las, labels = if (is.null(names(statistics))) 
    as.character(indices)
else names(statistics))
axis(2, las = axes.las)
box()
lines(indices, statistics, type = "b", pch = 20)
if (length(center) == 1) 
  alpha <- 1
else lines(indices, c(center, center[length(center)]), type = "s")
if (length(lcl) == 1) {
    abline(h = ucl, lty = 2)
}
else {
    lines(indices, ucl[indices], type = "s", lty = 2)
}
mtext(label.limits, side = 4, at = c(rev(ucl)[1],rev(ucl)[1]), 
    las = 1, line = 0.1, col = gray(0.3))
if (is.null(qcc.options("violating.runs"))) 
    stop(".qcc.options$violating.runs undefined. See help(qcc.options).")
if (length(violations$violating.runs)) {
    v <- violations$violating.runs
    if (!chart.all & !is.null(newstats)) {
        v <- v - length(stats)
        v <- v[v > 0]
    }
    points(indices[v], statistics[v], col = qcc.options("violating.runs")$col, 
        pch = qcc.options("violating.runs")$pch)
}
if (is.null(qcc.options("beyond.limits"))) 
    stop(".qcc.options$beyond.limits undefined. See help(qcc.options).")
if (length(violations$beyond.limits)) {
    v <- violations$beyond.limits
    if (!chart.all & !is.null(newstats)) {
        v <- v - length(stats)
        v <- v[v > 0]
    }
    points(indices[v], statistics[v], col = qcc.options("beyond.limits")$col, 
        pch = qcc.options("beyond.limits")$pch)
}
if (chart.all & (!is.null(newstats))) {
    len.obj.stats <- length(object$statistics)
    len.new.stats <- length(statistics) - len.obj.stats
    abline(v = len.obj.stats + 0.5, lty = 3)
    mtext(paste("Calibration data in", data.name), at = len.obj.stats/2, 
        adj = 0.5, cex = 0.8)
    mtext(paste("New data in", object$newdata.name), at = len.obj.stats + 
        len.new.stats/2, adj = 0.5, cex = 0.8)
}
if (add.stats) {
    plt <- par()$plt
    usr <- par()$usr
    px <- diff(usr[1:2])/diff(plt[1:2])
    xfig <- c(usr[1] - px * plt[1], usr[2] + px * (1 - plt[2]))
    at.col <- xfig[1] + diff(xfig[1:2]) * c(0.1, 0.4, 0.65)
    mtext(paste("Number of groups = ", length(statistics), 
        sep = ""), side = 1, line = 5, adj = 0, at = at.col[1], 
        font = qcc.options("font.stats"), cex = qcc.options("cex.stats"))
    center <- object$center
    if (length(center) == 1) {
        mtext(paste("Center = ", signif(center[1], digits), 
            sep = ""), side = 1, line = 6, adj = 0, at = at.col[1], 
            font = qcc.options("font.stats"), cex = qcc.options("cex.stats"))
    }
    else {
        mtext("Center is variable", side = 1, line = 6, adj = 0, 
            at = at.col[1], qcc.options("font.stats"), cex = qcc.options("cex.stats"))
    }
    mtext(paste("StdDev = ", signif(std.dev, digits), sep = ""), 
        side = 1, line = 7, adj = 0, at = at.col[1], font = qcc.options("font.stats"), 
        cex = qcc.options("cex.stats"))
    if (length(unique(lcl)) == 1) 
         alpha <- 0
        #mtext(paste("LCL = ", signif(lcl[1], digits), sep = ""), 
        #    side = 1, line = 6, adj = 0, at = at.col[2], 
        #    font = qcc.options("font.stats"), cex = qcc.options("cex.stats"))
    else mtext("LCL is variable", side = 1, line = 6, adj = 0, 
        at = at.col[2], font = qcc.options("font.stats"), 
        cex = qcc.options("cex.stats"))
    if (length(unique(ucl)) == 1) 
        mtext(paste("UCL = ", signif(ucl[1], digits), sep = ""), 
            side = 1, line = 7, adj = 0, at = at.col[2], 
            font = qcc.options("font.stats"), cex = qcc.options("cex.stats"))
    else mtext("UCL is variable", side = 1, line = 7, adj = 0, 
        at = at.col[2], font = qcc.options("font.stats"), 
        cex = qcc.options("cex.stats"))
    if (!is.null(violations)) {
        mtext(paste("Number beyond limits =", length(unique(violations$beyond.limits))), 
            side = 1, line = 6, adj = 0, at = at.col[3], 
            font = qcc.options("font.stats"), cex = qcc.options("cex.stats"))
        mtext(paste("Number violating runs =", length(unique(violations$violating.runs))), 
            side = 1, line = 7, adj = 0, at = at.col[3], 
            font = qcc.options("font.stats"), cex = qcc.options("cex.stats"))
    }
}
invisible()

}

Answer 3

This approach seems more like a "hack" than an answer and it throws a warning:

control$center <- NULL
control$limits <- NULL
plot(control, add.stats = FALSE)