2

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) 
CanofDrink
  • 89
  • 9

3 Answers3

2

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)
JasonAizkalns
  • 20,243
  • 8
  • 57
  • 116
  • I tried something similar to this myself and it didn't work (because of the error). Your code gets rid of both limits! Thanks again. – CanofDrink Jan 21 '16 at 21:12
  • @HarrisonO'Neill You could always add the UCL back in later. In addition, it may be worth trying to contact the `qcc` package maintainer directly -- seems like their ought to be a way to do this. Otherwise, since this is such a stripped down version, you may want to consider just "rolling your own" with `ggplot2` or another plotting package. Finally, if this doesn't get any more hits, message me or add a comment in a week or two and throw up a bounty to see if it can generate more interest or more complete answers. – JasonAizkalns Jan 22 '16 at 01:13
  • The other solution in this thread worked fine, I just used `add.stats="FALSE"` to hide the fact that the LCL was -1. I've considered using `ggplot2` but I'm already setting myself a challenge by plotting this stuff using R, I don't really have the time to learn everything from scratch. – CanofDrink Jan 22 '16 at 15:20
  • If you're interested, I've posted another question which hasn't got an answer yet haha. – CanofDrink Jan 22 '16 at 17:45
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))

enter image description here

andrnev
  • 410
  • 2
  • 12
1

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()

}

Thanos
  • 27
  • 4