1

我正在使用包的cchart.p功能IQCC来生成 p 图，但图表的标题是“标准化 p 图（第二阶段）”。我想更改标题和轴标签名称。

代码尝试：

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

我可以使用任何功能或包吗？

我如何使用 ggplot2 包？

4

1 回答 1

0

在IQCC包中，该函数cchart.p不允许参数更改标题和/或轴标签。但是，您可以修改cchart.p代码本身。在函数体中有对函数的调用qcc，该函数具有更改标题和轴标签的参数。修改请看下面的代码cchart.p（标题和标签的变化由注释指出）：

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)")
    }
  }
}

下面的摘录显示了cchart.p2与初始函数比较的函数中唯一更改的部分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"))
  #########################################################################

然后就可以调用修改后的函数了：

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

并获得所需的输出： 在此处输入图像描述

至于ggplot2用法，您需要从对象中提取有关上下控制限和中心线的信息qcc。请看下面的代码。

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

输出：

在此处输入图像描述

于 2019-12-24T06:05:20.317 回答