How to change title of IQCC::cchart.p function output?

Question

I am using cchart.p function of IQCC package to generate p-charts, but title of the graph is "Standardized p-chart (phase II)". I want to change the title and axes label names.

Code tried:

library(IQCC)

#get arguments
args <- commandArgs(TRUE)
pdfname <- args[1]
datafile <- args[2]

pdf(pdfname)
tasks <- read.csv(datafile , header = T,sep=",")
p <- cchart.p(x1 = tasks$x, n1 = tasks$y,phat = 0.02)
print(p)
dev.off()

Any function or package I can use with it?

How I can use with ggplot2 package?

Answer 1

In IQCC package the function cchart.p does not permit arguments to change title and/or axis labels. However you can modify cchart.p code itself. In the body of the function there are calls for qcc function, which has argument to change title and axes labels. Please see the code below for modified cchart.p (the changes for title and labels are indicated by comments):

cchart.p2 <- function (x1 = NULL, n1 = NULL, type = "norm", p1 = NULL, x2 = NULL, 
                       n2 = NULL, phat = NULL, p2 = NULL) 
{
  if ((!is.null(n1)) && (!is.null(x1) || !is.null(p1))) 
    OK1 = TRUE
  else OK1 = FALSE
  if (!is.null(n2) && (!is.null(x2) || !is.null(p2)) && (OK1 || 
                                                         !is.null(phat))) 
    OK2 = TRUE
  else OK2 = FALSE
  if (!OK1 && !OK2) {
    if (is.null(x1) && is.null(n1) && is.null(p1)) 
      return("Phase I data and samples sizes are missing")
    else {
      if (is.null(n1)) 
        return("Phase I samples sizes not specified")
      else return("Phase I data is missing")
    }
  }
  if (!OK2) {
    if (is.null(n2) && (!is.null(x2) || !is.null(p2))) 
      return("Phase II samples sizes not specified")
    if (!is.null(n2) && (is.null(x2) && is.null(p2))) 
      return("Phase II data is missing")
    if (!is.null(x2) && !is.null(n2) && !is.null(p2)) 
      return("Information about phase I is missing")
  }
  if (OK1 && !OK2) {
    if (!is.null(x1)) {
      m1 <- length(x1)
      if (length(n1) != length(x1)) 
        return("The arguments x1 and n1 must have the same length")
    }
    if (!is.null(p1)) {
      m1 <- length(p1)
      if (length(n1) != length(p1)) 
        return("The arguments p1 and n1 must have the same length")
    }
    if (is.null(p1)) 
      p1 <- x1/n1
    if (is.null(x1)) 
      x1 <- p1 * n1
    phat <- mean(p1)
    l <- matrix(nrow = m1, ncol = 1)
    if (type == "norm") {
      u <- matrix(nrow = m1, ncol = 1)
      for (i in 1:m1) {
        UCL <- phat + (3 * sqrt((phat * (1 - phat))/n1[i]))
        u[i, ] <- UCL
        LCL <- phat - (3 * sqrt((phat * (1 - phat))/n1[i]))
        l[i, ] <- LCL
      }
      ############## Customized title and axes labels ############################
      return(qcc(x1, type = "p", n1, limits = c(l, u), center = phat, 
          title = "Custom Title", xlab = "Custom X", ylab = "Custom Y"))
      #########################################################################

    }
    if (type == "CF") {
      u <- matrix(nrow = m1, ncol = 1)
      for (i in 1:m1) {
        UCL <- phat + (3 * sqrt((phat * (1 - phat))/n1[i])) + 
          (4 * (1 - 2 * phat)/(3 * n1[i]))
        u[i, ] <- UCL
        LCL <- phat - (3 * sqrt((phat * (1 - phat))/n1[i])) + 
          (4 * (1 - 2 * phat)/(3 * n1[i]))
        l[i, ] <- LCL
      }
      qcc(x1, type = "p", n1, limits = c(l, u), center = phat, 
          title = "Cornish-Fisher p-chart (phase I)")
    }
    if (type == "std") {
      for (i in 1:m1) {
        z <- (p1[i] - phat)/sqrt((phat * (1 - phat))/n1[i])
        l[i, ] <- z
      }
      std <- l * n1
      qcc(std, type = "p", n1, center = 0, limits = c(-3, 
                                                      3), title = "Standardized p-chart (phase I)")
    }
  }
  if (OK2) {
    if (!is.null(x2)) {
      m2 <- length(x2)
      if (length(n2) != length(x2)) 
        return("The arguments x2 and n2 must have the same length")
    }
    if (!is.null(p2)) {
      m2 <- length(p2)
      if (length(n2) != length(p2)) 
        return("The arguments p2 and n2 must have the same length")
    }
    if (is.null(p2)) 
      p2 <- x2/n2
    if (is.null(x2)) 
      x2 <- p2 * n2
    if (is.null(phat)) {
      if (is.null(p1)) 
        p1 <- x1/n1
      phat <- mean(p1)
    }
    l <- matrix(nrow = m2, ncol = 1)
    if (type == "norm") {
      u <- matrix(nrow = m2, ncol = 1)
      for (i in 1:m2) {
        UCL <- phat + (3 * sqrt((phat * (1 - phat))/n2[i]))
        u[i, ] <- UCL
        LCL <- phat - (3 * sqrt((phat * (1 - phat))/n2[i]))
        l[i, ] <- LCL
      }
      qcc(x2, type = "p", n2, limits = c(l, u), center = phat, 
          title = "Shewhart p-chart (phase II)")
    }
    if (type == "CF") {
      u <- matrix(nrow = m2, ncol = 1)
      for (i in 1:m2) {
        UCL <- phat + (3 * sqrt((phat * (1 - phat))/n2[i])) + 
          (4 * (1 - 2 * phat)/(3 * n2[i]))
        u[i, ] <- UCL
        LCL <- phat - (3 * sqrt((phat * (1 - phat))/n2[i])) + 
          (4 * (1 - 2 * phat)/(3 * n2[i]))
        l[i, ] <- LCL
      }
      qcc(x2, type = "p", n2, limits = c(l, u), center = phat, 
          title = "Cornish-Fisher p-chart (phase II)")
    }
    if (type == "std") {
      for (i in 1:m2) {
        z <- (p2[i] - phat)/sqrt((phat * (1 - phat))/n2[i])
        l[i, ] <- z
      }
      std <- l * n2
      qcc(std, type = "p", n2, center = 0, limits = c(-3, 
                                                      3), title = "Standardized p-chart (phase II)")
    }
  }
}

The excerpt below shows the only part which is changed in the function cchart.p2 in comaprison with initial function cchart.p:

 ############## Customized title and axes labels + qcc object return from the function (for further use in ggplot2) ############################
  return(qcc(x1, type = "p", n1, limits = c(l, u), center = phat, 
      title = "Custom Title", xlab = "Custom X", ylab = "Custom Y"))
  #########################################################################

Then you can call the modified function:

library(qcc)
data(binomdata)
cc <- cchart.p2(x1 = binomdata$Di[1:12], n1 = binomdata$ni[1:12], phat = 0.02, type = "norm")

And get desired output:

As for ggplot2 usage, you need to extract information about upper & lower control limits and central line from qcc object. Please see the code below.

library(ggplot2)
df <- data.frame(gr = as.numeric(row.names(cc$data)), 
                value = cc$statistics,
                cc$limits,
                CL = cc$center)

ggplot(df, aes(gr, value)) +
  geom_point() +
  geom_line(group = 1) +
  geom_step(aes(gr, LCL., group = 1)) +
  geom_step(aes(gr, UCL, group = 1)) +
  geom_line(aes(gr, CL, group = 1))

Output: