R/cchart.p.R

In flaviobarros/IQCC: Improved Quality Control Charts

#' p-chart
#' 
#' This function builds p-charts.
#' 
#' For a phase I p-chart, n1 must be specified and either x1 or p1.  For a
#' phase II p-chart, n2 must be specified, plus x2 or p2 and either phat, x1
#' and n1, or p1 and n1.  The Shewhart is based on normal-aprroximation and
#' should be used only for large values of np or n*p (n*p > 6).
#' 
#' @param x1 The phase I data that will be plotted (if it is a phase I chart).
#' @param n1 A value or a vector of values specifying the sample sizes
#' associated with each group for the phase I data.
#' @param type The type of p-chart to be plotted. The options are "norm"
#' (traditional Shewhart p-chart), "CF" (Cornish Fisher p-chart) and "std"
#' (standardized p-chart). If not specified, a Shewhart p-chart will be
#' plotted.
#' @param p1 The data used to estimate the phat (x1 / n1).
#' @param x2 The phase II data that will be plotted in a phase II chart.
#' @param n2 A value or a vector of values specifying the sample sizes
#' associated with each group for the phase II data.
#' @param phat The estimate of p.
#' @param p2 The values corresponding to x2 / n2.
#' @return Return a p-chart.
#' @export
#' @author Daniela R. Recchia, Emanuel P. Barbosa
#' @references Montgomery, D.C.,(2008)."Introduction to Statistical Quality
#' Control". Chapter 11. Wiley
#' @examples
#' 
#' data(binomdata)
#' attach(binomdata)
#' cchart.p(x1 = Di[1:12], n1 = ni[1:12])
#' cchart.p(x1 = Di[1:12], n1 = ni[1:12], type = "CF", x2 = Di[13:25], n2 = ni[13:25])
#' cchart.p(type = "std", p2 = Di[13:25], n2 = ni[13:25], phat = 0.1115833)
#' 
cchart.p <- 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
    
#-- Error messages
    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")
    }

#-- Phase I
    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)
#------ Shewhart
        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
            }
            qcc(x1, type = "p", n1, limits = c(l, u), center = phat, title = "Shewhart p-chart (phase I)")
        }
#------ Cornish-Fisher
        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)")
        }
#------ Standardized
        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)")
        }
    }
    
#-- Phase II
    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)
#------ Shewhart
        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)")
        }
#------ Cornish-Fisher
        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)")
        }
#------ Standardized
        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)")
        }
    }
}