version 0.1

cran · Nov 12, 2016 · 1168bba · 1168bba
commit 1168bba
Show file tree

Hide file tree

Showing 49 changed files with 1,953 additions and 0 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -0,0 +1,15 @@
+Package: XRSCC
+Type: Package
+Title: Statistical Quality Control Simulation
+Version: 0.1
+Date: 2016-11-10
+Author: Erick Marroquin
+Maintainer: Erick Marroquin <ericksuhel@gmail.com>
+Description: This is a set of statistical quality control functions,  that allows plotting control charts and its iterations, process capability for variable and attribute control, highlighting the xrs_gr() function, like a first iteration for variable chart, meanwhile the we_rules() function detects non random patterns in sample.
+License: GPL (>= 2)
+LazyData: TRUE
+Imports: stats, graphics, utils, grDevices
+NeedsCompilation: no
+Packaged: 2016-11-11 17:09:13 UTC; Erick Marroquin
+Repository: CRAN
+Date/Publication: 2016-11-12 01:05:48
diff --git a/MD5 b/MD5
@@ -0,0 +1,48 @@
+4c2316d7efa6a638c4ed0928b1b3208f *DESCRIPTION
+74b0106856e664355d6becf9f8766447 *NAMESPACE
+f4d31a1b9ebe791e804f7135dd8f448a *R/Beta.X.R
+2305b86166120f77b008c8a63e5b206e *R/C_it.R
+f47e19c5d0f85ccfec3d56942c944e31 *R/Cp_X.R
+ca436158937623366483bfbeeaef6947 *R/NP_it.R
+de471bd9a298276b2dbf6b90258731a4 *R/P_it.R
+01273a97b6bc5116af5172131c5eab76 *R/R_it.R
+08bbbea021102d0b51e14803915752ef *R/U_it.R
+b29e3749f6a4b16119c47fd14baf0c78 *R/X_it.R
+1f1bf2012a03c90d287adbead606e0db *R/c_gr.R
+35bccdbaa419671a2e2ad3117fa9849c *R/np_gr.R
+114f5bc70a5579df6ad9dd6fcf15eba7 *R/p_gr.R
+84e92685f3947b1ed7617d33e3e94fac *R/sysdata.rda
+e342873c2613f04ec3cefe73a1b05c09 *R/u_gr.R
+6e64425425fcaf28f0d368c49850df14 *R/we_rules.R
+f78c3d9a0f8eb593022dbefc1c6ed1a8 *R/xrs_gr.R
+766ed390c9bd0f32938613ebc2feabd2 *data/bottles.rda
+6fee6cbc8a312357f43f4d5523a89db1 *data/clothes.rda
+59d5a17f391101cdcc2c0754bd6cbbd6 *data/clothes2.rda
+f6c55329b6999d3f493082ba6d8da019 *data/dato2.rda
+32fda2e469d7e69accbdcca0cf173232 *data/factor.a.rda
+e0890592b9a67851be4415e17b505dfc *data/qqsugar.rda
+aae3dee03d7f438e19d89e0ac2164488 *data/udata2.rda
+446fd0b2eb4cc2a9a119b0a222557ef7 *data/vol_sample.rda
+a90a1380417dea892219140998370c23 *man/Beta.X.Rd
+d6d3db537fcd5e428396ad40cf4208a4 *man/C_it.Rd
+1021be0780e67c28c0c8b44572de9f1a *man/Cp_X.Rd
+5037c5de3b81f2ea1d4e0df7d47b588c *man/NP_it.Rd
+56be4e383c9361f338ad4ca24698df03 *man/P_it.Rd
+f13c71c5c4e83f172fc911a250153315 *man/R_it.Rd
+a8e97c3e0ddf90719b83f56ceae81046 *man/U_it.Rd
+690ea159f3e0751263722161aae3457f *man/XRSCC-package.Rd
+f08b1da21894c2e4694a2eae9a0a986e *man/X_it.Rd
+9e615e451f4a5f19cc031a36b9b82c19 *man/bottles.Rd
+b50e9c9c009309891c3b2a21e97266ce *man/c_gr.Rd
+3bfd68319310f4c0cb5b57888b91021f *man/clothes.Rd
+ba3617b8dcdb30c794170e51ad456dfa *man/clothes2.Rd
+b9d348be55005f1292c4f6eb746b77bc *man/dato2.Rd
+d0a2efc7320bfdcecf577e11818fd378 *man/factor.a.Rd
+1b45473f0bc0a462867b5caac488526f *man/np_gr.Rd
+ee50f4ce82c40ea5f8ffc214b736c947 *man/p_gr.Rd
+66c1e26bc472c2a4f98b57c4cc1c9449 *man/qqsugar.Rd
+697e47f515a4ed52bf11dbbfc5a02113 *man/u_gr.Rd
+99023922ded44ca91f14e07f86497368 *man/udata2.Rd
+ece77b0c72b7a880a0995887b9e49b92 *man/vol_sample.Rd
+c831b04e661bc4e1654d9d4be0f82f6d *man/we_rules.Rd
+bf94bce08b3f3d3103ab480015ccbaa2 *man/xrs_gr.Rd
diff --git a/NAMESPACE b/NAMESPACE
@@ -0,0 +1,3 @@
+exportPattern("^[[:alpha:]]+")
+import(stats, graphics, utils, grDevices)
+
diff --git a/R/Beta.X.R b/R/Beta.X.R
@@ -0,0 +1,55 @@
+Beta.X<-function(k,n){
+  beta.x1<-function(k,n,L=3){
+    phi1 <- pnorm(c(L-k*sqrt(n)), mean=0, sd=1, lower.tail=TRUE)
+    phi2 <- pnorm(c(-L-k*sqrt(n)), mean=0, sd=1, lower.tail=TRUE)
+    beta.1<-phi1-phi2
+    return(beta.1)
+  }
+  beta.2<-beta.x1(k,n)
+  k.1<-seq(0,k*1.5,length.out=100)
+  beta.x2<-beta.x1(k.1,n)
+  ARL.x2<-1/(1-beta.x2)
+  #Marco de graficos
+  mat<-matrix(1:2,1,2,byrow=TRUE)
+  layout(mat)
+  layout.show(length(1:2))
+  #CO
+  plot(k.1, beta.x2, type = "l", lty = 1, lwd = 2,
+       lend = par("lend"),
+       col = "green", cex = 2, bg = NA,
+       xlab = expression(kappa), ylab = expression(beta),
+       xlim = c(0, k*1.5),
+       ylim = c(0,1),
+       pch = 19,
+       main ="Curva Caracteristica de Operacion
+       Corrimiento de la Media")
+  # Agrega opciones de graficas de bajo nivel
+  grid(10, 10, lwd = 0)
+  segments(x0=0, y0=0, x1=k*1.5, y1=0, col="black",lwd=1)
+  segments(x0=0, y0=0, x1=0, y1=1, col="black",lwd=1)
+  segments(x0=k, y0=0, x1=k, y1=eval(beta.2), col=2,lwd=2)
+  segments(x0=0, y0=eval(beta.2), x1=k, y1=eval(beta.2), col=2,lwd=2)
+  text(k*1.1,eval(beta.2),expression(beta), cex = 1)
+  text(k*1.15,eval(beta.2),paste(" = "), cex = 1)
+  text(k*1.25,eval(beta.2),paste(round(beta.2,3)), cex = 1)
+  #ARL
+  plot(k.1, ARL.x2, type = "l", lty = 1, lwd = 2,
+       lend = par("lend"),
+       pch = NULL,
+       col = "red", cex = 2, bg = NA,
+       xlab = expression(kappa), ylab = paste("ARL"),
+       xlim = c(0, k*1.5), ylim = c(0,eval(1/(1-beta.2))*1.2),
+       main ="Ancho medio de la corrida
+       para detectar corrimiento de la Media")
+  # Agrega opciones de graficas de bajo nivel
+  grid(10, 10, lwd = 0)
+  segments(x0=0, y0=0, x1=k*1.5, y1=0, col="black",lwd=1)
+  segments(x0=0, y0=0, x1=0, y1=eval(1/(1-beta.2))*1.2, col="black",lwd=1)
+  segments(x0=k, y0=0, x1=k, y1=eval(1/(1-beta.2)), col="blue",lwd=2)
+  segments(x0=0, y0=eval(1/(1-beta.2)), x1=k, y1=eval(1/(1-beta.2)), col="blue",lwd=2)
+  text(k*1.05,eval(1/(1-beta.2)),paste("ARL"), cex = 1)
+  text(k*1.10,eval(1/(1-beta.2)),paste(" = "), cex = 1)
+  text(k*1.25,eval(1/(1-beta.2)),paste(round(eval(1/(1-beta.2)),3)), cex = 1)
+  structure(list("beta"= beta.2,
+                 "ARL"=1/(1-beta.2)))
+}
diff --git a/R/C_it.R b/R/C_it.R
@@ -0,0 +1,57 @@
+C_it<-function(prev.results){
+  if (missing(prev.results)){
+    stop("No hay muestras para leer, No sample to read")
+  } else {
+    if(prev.results$bin[1]==0){
+      stop("El proceso ya esta bajo control, The process is already under control")
+      } else {
+        c.1 <- prev.results$data.1
+        m <- length(c.1)
+        # Calculo de limites de control para la grafica c
+        LCS.c.1<-expression(mean(c.1)+3*sqrt(mean(c.1)))
+        LCI.c.1<-expression(mean(c.1)-3*sqrt(mean(c.1)))
+        LC.c.1<-expression(mean(c.1))
+        if (eval(LCI.c.1)>0){
+          LCI.c.1<-eval(LCI.c.1)
+          } else {
+            LCI.c.1 <- 0
+            }
+        c.pos<-which(c.1 >= eval(LCI.c.1)  & c.1 < eval(LCS.c.1))
+        c.2<-c.1[c.pos]
+        c.fi.1<-which(c.1 < eval(LCI.c.1))
+        c.fs.1<-which(c.1 >= eval(LCS.c.1))
+        bin.c<-if(length(c.pos)< m){
+          bin.c<-1
+          } else {
+            bin.c<-0
+            }
+        #
+        # Script para Grafica c inicial
+    plot.c<-function(C=c.1,type="b",col="blue",pch =19){
+      plot(C, xlab= "Numero de muestra", ylab="Numero de inconformidades",
+           main="Grafica c, Control Estadistico de la Calidad",type=type, col=col,
+           ylim=c(eval(LCI.c.1)-mean(c.1)*0.05, max(eval(LCS.c.1)*1.1, max(c.1)*1.1)),
+           xlim=c(-0.05*m, 1.05*m), pch = pch)
+      abline(h= c(eval(LCS.c.1), eval(LCI.c.1), eval(LC.c.1)),col="lightgray")
+      text(c(rep(1,3),rep(7,3)), rep(c(eval(LCS.c.1),eval(LC.c.1),eval(LCI.c.1)),2),
+           c(c("LCS = ","LC = ","LCI = "), c(round(eval(LCS.c.1),3), round(eval(LC.c.1),3),
+                                             round(eval(LCI.c.1),3))),
+           col="red") }
+    plot.c()
+    # Crea la lista de los resultados
+    structure(list("in.control" = c.pos,
+                   "out.control"= c(c.fi.1,c.fs.1),
+                   "Iteraciones" = prev.results$Iteraciones + 1,
+                   "data.0"= C,
+                   "data.1"= c.2,
+                   "bin" = bin.c,
+                   "Limites de Control Grafica c" = c("LCI.c"=eval(LCI.c.1),"LCS.c"=eval(LCS.c.1),
+                                                      "LC.c"=eval(LC.c.1)),
+                   "Conclusion del proceso"= c(if(length(c.pos)< m){
+                     print("Proceso fuera de Control en Grafica c")
+                   } else {
+                     print("El proceso esta bajo control en Grafica c")
+                   })))
+      }
+  }
+}
diff --git a/R/Cp_X.R b/R/Cp_X.R
@@ -0,0 +1,78 @@
+Cp_X<-function(prev.results,LES,LEI,mu){
+  if (missing(prev.results)){
+    stop("No elementos para evaluar")
+  } else {
+    if(missing(LES) | missing(LEI)){
+      stop("Al menos uno de los limites de especificacion no esta definido")
+    } else {
+      data(factor.a, envir = environment())
+      n<-ncol(prev.results$data.1)
+      LCR<-as.numeric(prev.results$LR[2])
+      if (missing(mu)){
+        mu<-prev.results$LX[2]
+        X.sigma<-expression(eval(LCR)/(factor.a$d2[n-1]*sqrt(n)))
+      } else {
+        X.sigma<-expression(eval(LCR)/(factor.a$d2[n-1]))
+      }
+      #Sequencia
+      sd<-eval(X.sigma)
+      .x<-seq(mu -4*sd,mu +4*sd, length = 1000)
+      fx0<-expression((1/(sd*sqrt(2*pi)))*exp(-0.5*(((.x-mu)/sd)^2)))
+      plot(eval(fx0)~.x,type="l", xlab="X", ylab="Densidad",
+           main=paste("Distribucion Normal: Normalizacion Grafica X"),
+           xlim=c(min(mu -4*sd, LEI), max(mu +4*sd,LES)))
+      x0<-c(mu -3*eval(X.sigma), mu,  mu +3*eval(X.sigma))
+      y0<-rep(0,3)
+      # Definir la funcion de densidad
+      fx0<-expression((1/(sd*sqrt(2*pi)))*exp(-0.5*(((x0-mu)/sd)^2)))
+      segments(x0, y0, x1=x0, y1=eval(fx0), col=2,lwd=2)
+      abline(a=0,b=0)
+      # Se agregan las siguientes lineas que los limites de especificacion
+      # bajo la misma funcion de densidad
+      x0<-c(eval(LEI), eval(LES))
+      xt.1<-eval(LES)
+      y0<-rep(0,2)
+      #Densidades
+      fx1<-expression((1/(sd*sqrt(2*pi)))*exp(-0.5*(((x0-mu)/sd)^2)))
+      fx2<-expression((1/(sd*sqrt(2*pi)))*exp(-0.5*(((xt.1-mu)/sd)^2)))
+      fx3<-expression((1/(sd*sqrt(2*pi)))*exp(-0.5*(((0)/sd)^2)))
+      segments(x0, y0, x1=x0,y1=eval(fx1), col=4,lwd=2)
+      # Definir el texto de los limites para mostrar
+      text(c(mu -3*sd, mu,  mu +3*sd,
+             eval(LEI), eval(LES),mu -3*sd, mu +3*sd, mu), c(rep(eval(fx3)*0.3,3),
+                                                         rep(eval(fx3)*0.15,2),
+                                                         rep(eval(fx3)*0.25,3)),
+           c(expression(-3*hat(sigma)),expression(mu), expression(+3*hat(sigma)),
+             paste(c("LEI =","LES ="), c(round(eval(LEI),1), round(eval(LES),1))),
+             paste(c(round(mu -3*sd,3), round(mu +3*sd,3), round(mu,3)))), cex = 1, col="blue")
+      # Define la ecuacion simbolica de la funcion de densidad
+      text(mu -3*sd,eval(fx3)*0.9,
+           expression(f(x) == paste(frac(1, sigma * sqrt(2 * pi)), " ", e^{frac(-(x - mu)^2, 2 * sigma^2)})),
+           cex = 1.25, col="black")
+      # Muestra la funcion simbolica de la capacidad del proceso
+      text(mu + 3*sd,eval(fx3)*0.9,
+           expression(Cp == paste(frac("LES - LEI", 6 * hat(sigma)))),cex = 1.25, col="black")
+      # Define el indicador de la Capacidad del proceso Cp
+      Cp <- (LES - LEI)/(6 * sd)
+      Cpk<- min(LES - mu, mu - LEI)/(3 * sd)
+      # Muestra El resultado de la capacidad del proceso
+      text(mu + 3*sd,eval(fx3)*0.7, paste("Cp =", round(eval(Cp),2)))
+      # Define el indicador del porcentaje del uso de los limites de especificacion
+      P.cp <- (1/eval(Cp))*100
+      # Muestra El resultado del porcentaje del uso de los limites de especificacion
+      text(mu + 3*sd,eval(fx3)*0.6, paste("P =", round(eval(P.cp),2), "%"))
+      #
+      # Crear la lista de los resultados Cp y P
+      structure(list("Cp"=eval(Cp), "Cpk" = eval(Cpk), "P"=eval(P.cp), "X.sigma"= eval(X.sigma)),
+                "Concluision del Proceso" = if(eval(Cp)>1){
+                  print("Los limites naturales estan dentro de los limites de especificacion")
+                } else {
+                  if(eval(Cp)<1){
+                    print("Los limites naturales sobrepasan  los limites de especificacion")
+                  } else {
+                    print("Los limites naturales son iguales a los limites de especificacion")
+                    }
+                })
+    }
+  }
+}
diff --git a/R/NP_it.R b/R/NP_it.R
@@ -0,0 +1,60 @@
+NP_it<-function(prev.results){
+  if (missing(prev.results)){
+    stop("No elementos para iteracion, No elements for iteration")
+  } else {
+    if(prev.results$bin[1]==0){
+      stop("El proceso ya esta bajo control, The process is already under control")
+    } else {
+      np.0<-prev.results$data.1
+      p.0<-prev.results$data.1/prev.results$data.n
+      m <-length(np.0)
+      n <-prev.results$data.n
+      # Calculo de limites de control para la grafica P
+      LCS.np.0<-expression(n*mean(p.0)+3*sqrt(n*mean(p.0)*(1-mean(p.0))))
+      LCI.np.0<-expression(n*mean(p.0)-3*sqrt(n*mean(p.0)*(1-mean(p.0))))
+      LC.np.0<-expression(n*mean(p.0))
+      if (eval(LCI.np.0)>0){
+        LCI.p.0<-eval(LCI.np.0)
+      } else {
+        LCI.np.0 <- 0
+      }
+      np.pos<-which(np.0 >= eval(LCI.np.0)  & np.0 < eval(LCS.np.0))
+      np.1<-np.0[np.pos]
+      np.fi.0<-which(np.0 < eval(LCI.np.0))
+      np.fs.0<-which(np.0 >= eval(LCS.np.0))
+      bin.np<-if(length(np.pos)< m){
+        bin.np<-1
+      } else {
+        bin.np<-0
+      }
+      #
+      # Script para Grafica NP iestima iteracion
+      plot.np<-function(NP=np.0,type="b",col="blue",pch =19){
+        plot(NP, xlab= "Numero de muestra", ylab="Numero de No conformes",
+             main="Grafica NP, Control Estadistico de la Calidad",type=type, col=col,
+             ylim=c(eval(LCI.np.0)-mean(np.0)*0.05, max(eval(LCS.np.0)*1.1, max(np.0)*1.1)),
+             xlim=c(-0.05*m, 1.05*m), pch = pch)
+        abline(h= c(eval(LCS.np.0), eval(LCI.np.0), eval(LC.np.0)),col="lightgray")
+        text(c(rep(1,3),rep(7,3)), rep(c(eval(LCS.np.0),eval(LC.np.0),eval(LCI.np.0)),2),
+             c(c("LCS = ","LC = ","LCI = "), c(round(eval(LCS.np.0),3), round(eval(LC.np.0),3),
+                                               round(eval(LCI.np.0),3))),
+             col="red") }
+      plot.np()
+      # Crea la lista de los resultados
+      structure(list("in.control" = np.pos,
+                     "out.control"= c(np.fi.0,np.fs.0),
+                     "Iteraciones" = prev.results$Iteraciones + 1,
+                     "data.n"= prev.results$data.n,
+                     "data.0"= prev.results$data.0,
+                     "data.1"= np.1,
+                     "bin" = bin.np,
+                     "Limites de Control Grafica np" = c("LCI.np"=eval(LCI.np.0),"LCS.np"=eval(LCS.np.0),
+                                                         "LC.np"=eval(LC.np.0)),
+                     "Conclusion del proceso"= c(if(length(np.pos)< m){
+                       print("Proceso fuera de Control en Grafica np")
+                     } else {
+                       print("El proceso esta bajo control en Grafica np")
+                     })))
+    }
+  }
+}
diff --git a/R/P_it.R b/R/P_it.R
@@ -0,0 +1,59 @@
+P_it<-function(prev.results){
+  if (missing(prev.results)){
+    stop("No elementos para iteracion, No elements for iteration")
+  } else {
+    if(prev.results$bin[1]==0){
+      stop("El proceso ya esta bajo control, The process is already under control")
+    } else {
+      p.0<-prev.results$data.1
+      m <-length(p.0)
+      n <-prev.results$data.n
+      # Calculo de limites de control para la grafica P
+      LCS.p.0<-expression(mean(p.0)+3*sqrt((mean(p.0)*(1-mean(p.0)))/n))
+      LCI.p.0<-expression(mean(p.0)-3*sqrt((mean(p.0)*(1-mean(p.0)))/n))
+      LC.p.0<-expression(mean(p.0))
+      if (eval(LCI.p.0)>0){
+        LCI.p.0<-eval(LCI.p.0)
+        } else {
+          LCI.p.0 <- 0
+          }
+      p.pos<-which(p.0 > eval(LCI.p.0)  & p.0 < eval(LCS.p.0))
+      p.1<-p.0[p.pos]
+      p.fi.0<-which(p.0 < eval(LCI.p.0))
+      p.fs.0<-which(p.0 >= eval(LCS.p.0))
+      bin.p<-if(length(p.pos)< m){
+        bin.p<-1
+        } else {
+          bin.p<-0
+          }
+      #
+      # Script para Grafica p inicial
+      plot.p<-function(P=p.0,type="b",col="blue",pch =19){
+        plot(P, xlab= "Numero de muestra", ylab="Proporcion de los no conformes de cada muestra",
+             main="Grafica P, Control Estadistico de la Calidad",type=type, col=col,
+             ylim=c(eval(LCI.p.0)-mean(p.0)*0.05, max(eval(LCS.p.0)*1.1, max(p.0)*1.1)),
+             xlim=c(-0.05*m, 1.05*m), pch = pch)
+        abline(h= c(eval(LCS.p.0), eval(LCI.p.0), eval(LC.p.0)),col="lightgray")
+        text(c(rep(1,3),rep(7,3)), rep(c(eval(LCS.p.0),eval(LC.p.0),eval(LCI.p.0)),2),
+             c(c("LCS = ","LC = ","LCI = "), c(round(eval(LCS.p.0),3), round(eval(LC.p.0),3),
+                                               round(eval(LCI.p.0),3))),
+             col="red") }
+      plot.p()
+      # Crea la lista de los resultados
+      structure(list("in.control" = p.pos,
+                     "out.control"= c(p.fi.0, p.fs.0),
+                     "Iteraciones" = prev.results$Iteraciones + 1,
+                     "data.n"= prev.results$data.n,
+                     "data.0"= prev.results$data.0,
+                     "data.1"= p.1,
+                     "bin" = bin.p,
+                   "Limites de Control Grafica p" = c("LCI.p"=eval(LCI.p.0),"LCS.p"=eval(LCS.p.0),
+                                                      "LC.p"=eval(LC.p.0)),
+                   "Conclusion del proceso"= c(if(length(p.pos)< m){
+                     print("Proceso fuera de Control en Grafica p")
+                     } else {
+                       print("El proceso esta bajo control en Grafica p")
+                       })))
+    }
+  }
+}