39 4 qcc: R 4.1 qcc SQC [36] ˆ ˆ cusum EWMA ˆ OC: Operating Characteristic ˆ ˆ 1. circuit 3 x size trial k = 48 ˆ x 100 ˆ size ˆ trial TRUE FALSE 2 2. dyedcloth k = 10 ˆ x 50 ˆ size 3. orangejuice ˆ sample ID ˆ D ˆ size ˆ trial TRUE FALSE 2 4. orangejuice2 5. pcmanufact Scrucca[36]
40 4 qcc: R k = 20 ˆ sample ˆ D 6. pistonrings n = 5 ˆ sample ID ˆ diameter ˆ size ˆ trial TRUE FALSE 2 4.2 qcc R qcc qcc qcc qcc() Shewhart qcc() 4.1 qcc.groups() pistonrings diameter pistonrings > library(qcc) # qcc > data(pistonrings) > attach(pistonrings) # > dim(pistonrings) # dimension [1]200 3 > pistonrings diameter sample trial 1 74.030 1 TRUE 2 74.002 1 TRUE 3 74.019 1 TRUE 4 73.992 1 TRUE 5 74.008 1 TRUE 6 73.995 2 TRUE... 199 74.000 40 FALSE 200 74.020 40 FALSE > str(pistonrings) data.frame : 200 obs. of 3 variables: $ diameter: num 74 74 74 74 74... $ sample : int 1 1 1 1 1 2 2 2 2 2...
4.2 qcc 41 $ trial : logi TRUE TRUE TRUE TRUE TRUE TRUE... > hist(pistonrings$diameter) # pistonrings > boxplot(pistonrings$diameter) # pistonrings > qqnorm(pistonrings$diameter) # pistonrings QQ > diameter <- qcc.groups(diameter, sample) # > dim(diameter) [1]40 5 > diameter [,1] [,2] [,3] [,4] [,5] 1 74.030 74.002 74.019 73.992 74.008 2 73.995 73.992 74.001 74.011 74.004... 40 74.010 74.005 74.029 74.000 74.020 4.1 diameter QQ 25 X > obj <- qcc(diameter[1:25,], type="xbar") qcc() 4.2 qcc summary summary() > summary(obj) Call: qcc(data = diameter[1:25, ], type = "xbar") xbar chart for diameter[1:25, ] Summary of group statistics: Min. 1st Qu. Median Mean 3rd Qu. Max. 73.99 74.00 74.00 74.00 74.00 74.01 Group sample size: 5 Number of groups: 25 Center of group statistics: 74.00118 Standard deviation: 0.009887547
42 4 qcc: R 4.1 qcc type "xbar" X "xbar.one" X 1 "R" R "S" s type "np" np 2 "p" p np 2 n "c" c "u" u c n Control limits: LCL UCL 73.98791 74.01444 4.2 X 4.2 Number of groups k LCL UCL Center X StdDev standard deviation
4.3 43 Center Line ±3σ nsigmas confidence.level ±3σ 0.0027 24 3.4(c) Montgomery[33] Wetherill and Brown[39] center std.dev limits 4.3 qcc plot=false qcc() > plot(obj) 4.2 add.stats=false 5 > obj <- qcc(diameter[1:25,], type="xbar", newdata=diameter[26:40,]) X 4.3 25 qcc() chart.all=false plot() > plot(obj, chart.all=false) qcc() help(qcc) 4.1 n = 1 X type="xbar.one" l 2 size p
44 4 qcc: R 4.3 X > data(orangejuice) > attach(orangejuice) > orangejuice sample D size trial 1 1 12 50 TRUE 2 2 15 50 TRUE 3 3 8 50 TRUE... 53 53 3 50 FALSE 54 54 5 50 FALSE > obj2 <- qcc(d[trial], sizes=size[trial], type="p") 30 trial 4.4 OC 2 OC qcc > par(mfrow=c(1,2)) > oc.curves(obj) > oc.curves(obj2) oc.curves() 2 help(oc.curves) ) identify=true e
4.5 45 4.4 OC 4.5 n = 1 Montgomery[33] C i = i (x j µ 0 ) (4.1) j=1 i C i µ 0 1 i qcc qcc 4.5 cusum() cumulative sum > cusum(obj) 1 qcc target 2 decision.int 5 se.shift 1
46 4 qcc: R 4.5 4.6 EWMA *1 z i = λx i + (1 λ)z i 1 (4.2) λ 0 < λ < = 1 i = 1 z 0 = µ 0 (4.3) x (4.2) i 1 z i = λ (1 λ) j x i j + (1 λ) i z 0 (4.4) j=0 λ(1 λ) j i 1 λ(1 λ) j = 1 (4.5) j=0 qcc λ 0.2 *1 Exponentially Weighted Moving Average
4.7 47 lambda qcc EWMA 4.6 > ewma(obj) 4.6 EWMA 4.7 process.capability() qcc xbar xbar.one spec.limits LSL USL qcc > process.capability(obj, spec.limits=c(73.95,74.05)) Process Capability Analysis Call: process.capability(object = obj, spec.limits = c(73.95, 74.05)) Number of obs = 125 Target = 74 Center = 74.00118 LSL = 73.95 StdDev = 0.009887547 USL = 74.05 Capability indices: Value 2.5% 97.5% Cp 1.686 1.476 1.895 Cp_l 1.725 1.539 1.912 Cp_u 1.646 1.467 1.825
48 4 qcc: R Cp_k 1.646 1.433 1.859 Cpm 1.674 1.465 1.882 Exp<LSL 0% Obs<LSL 0% Exp>USL 0% Obs>USL 0% 4.7 pistonrings diameter target qcc std.dev confidence.level 0.95 4.7 process.capability.sixpack.plots() 1 ˆ X ˆ R n > 10 s ˆ run chart ˆ ˆ QQ ˆ
4.8 49 > process.capability.sixpack(obj, spec.limits=c(73.95,74.05), + target= 74.01) 4.8 pareto.chart() > defect <- c(80, 27, 66, 94, 33) > names(defect) <- c("price code", "schedule date", "supplier code", + "contact num.", "part num.") > pareto.chart(defect) > # QCtools > defect <- data.frame(defect, names(defect)) 4.8 help(pareto.chart) 4.8 1
50 4 qcc: R qcc cause.and.effect() 2 1 cause 1 effect cex fonts > cause.and.effect( + cause=list(measurements=c("microscopes", "Inspectors") + Materials=c("Alloys", "Suppliers"), + Personnel=c("Supervisors", "Operators"), + Environment=c("Condensation", "Moisture"), + Methods=c("Brake", "Engager", "Angle"), + Machines=c("Speed", "Bits", "Sockets")), + effect="surface Flaws") 4.9 4.9 qcc.options() qcc help(qcc.options) n p p
4.9 51 1 z *2 3 1 0 2 type stats.type,sd.type and limits.type p stats.p.std <- function(data, sizes) { data <- as.vector(data) sizes <- as.vector(sizes) pbar <- sum(data)/sum(sizes) z <- (data/sizes - pbar)/sqrt(pbar*(1-pbar)/sizes) list(statistics = z, center = 0) } sd.p.std <- function(data, sizes) return(1) limits.p.std <- function(center, std.dev, sizes, conf) { if (conf >= 1) { lcl <- -conf ucl <- +conf } else { if (conf > 0 & conf < 1) { nsigmas <- qnorm(1 - (1 - conf)/2) lcl <- -nsigmas ucl <- +nsigmas } else stop("invalid conf argument.") } limits <- matrix(c(lcl, ucl), ncol = 2) rownames(limits) <- rep("", length = nrow(limits)) colnames(limits) <- c("lcl", "UCL") return(limits) } 4.10 # n > n <- c(rep(50,5), rep(100,5), rep(25, 5)) # n =0.2 > x <- rbinom(length(n), n, 0.2) > par(mfrow=c(1,2)) # > qcc(x, type="p", size=n) # > qcc(x, type="p.std", size=n) *2 6.3 z
52 4 qcc: R 4.10 p