Contents
1. Package “qcr”, data “pcmanufact”
2. Exercises 8.2 from Textbook
Data “pcmanufact”
library(qcr)
library(qcc)
library(SixSigma)
Overview Dataset: A personal computer manufacturer
counts the number of nonconformities per unit on the final assembly
line. He collects data on 20 samples of 5 computers each.
Variables
- x: number of nonconformities(inspection units), total error
in each group of 5 computers
- sample: sample ID
- size: number of computers inspected
data("pcmanufact")
df <- pcmanufact
head(df,10)
## x sample size
## 1 10 1 5
## 2 12 2 5
## 3 8 3 5
## 4 14 4 5
## 5 10 5 5
## 6 16 6 5
## 7 11 7 5
## 8 7 8 5
## 9 10 9 5
## 10 15 10 5
## 'data.frame': 20 obs. of 3 variables:
## $ x : int 10 12 8 14 10 16 11 7 10 15 ...
## $ sample: int 1 2 3 4 5 6 7 8 9 10 ...
## $ size : int 5 5 5 5 5 5 5 5 5 5 ...
## x sample size
## Min. : 5.00 Min. : 1.00 Min. :5
## 1st Qu.: 7.00 1st Qu.: 5.75 1st Qu.:5
## Median :10.00 Median :10.50 Median :5
## Mean : 9.65 Mean :10.50 Mean :5
## 3rd Qu.:11.25 3rd Qu.:15.25 3rd Qu.:5
## Max. :16.00 Max. :20.00 Max. :5
- Create the U-Chart: A U-chart (Unit chart) is a type of
control chart used in Statistical Process Control (SPC) to monitor the
number of nonconformities per unit in a process over time
qcc(df$x, sizes = df$size, type = "u", title= "U-chart: Nonconformities per Unit")
## List of 11
## $ call : language qcc(data = df$x, type = "u", sizes = df$size, title = "U-chart: Nonconformities per Unit")
## $ type : chr "u"
## $ data.name : chr "df$x"
## $ data : int [1:20, 1] 10 12 8 14 10 16 11 7 10 15 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics: Named num [1:20] 2 2.4 1.6 2.8 2 3.2 2.2 1.4 2 3 ...
## ..- attr(*, "names")= chr [1:20] "1" "2" "3" "4" ...
## $ sizes : int [1:20] 5 5 5 5 5 5 5 5 5 5 ...
## $ center : num 1.93
## $ std.dev : num 1.39
## $ nsigmas : num 3
## $ limits : num [1, 1:2] 0.0661 3.7939
## ..- attr(*, "dimnames")=List of 2
## $ violations:List of 2
## - attr(*, "class")= chr "qcc"
Process Capability Analysis
- Target: We expect 0 to 2 defects per unit
LSL <- 0
USL <- 2
# Calculate nonconformities per unit
defect <- pcmanufact$x / pcmanufact$size
# Estimate process mean and std dev
mu <- mean(defect)
mu
## [1] 1.93
sigma <- sd(defect)
sigma
## [1] 0.6266872
# Calculate Cp and Cpk
Cp <- (USL - LSL) / (6 * sigma)
Cp
## [1] 0.5318975
Cpk <- min((USL - mu) / (3 * sigma), (mu - LSL) / (3 * sigma))
Cpk
## [1] 0.03723282
# Visualize with a Histogram and Spec Limits
hist(defect, breaks = 10, col = "lightblue", main = "Defects per Unit with Spec Limits",
xlab = "Defects per Unit ", xlim = c(0, max(USL, max(defect))))
abline(v = c(LSL, USL), col = "red", lty = 2)
abline(v = mu, col = "darkgreen", lwd = 2)
# Check normal distribution
qqnorm(defect);qqline(defect)
##
## Shapiro-Wilk normality test
##
## data: defect
## W = 0.95939, p-value = 0.5318
Cp = 0.5319: The process spread is too wide compared to the
specification limits.
Even in the best case scenario, this process can not consistently
produce with specs.
Cpk =0.0372: this value is very low and close to zero, the
process is not centered
Data does not significantly deviate from a normal
distribution.
Ideal Target (Center)
- Target = (LSL + USL) /2 = 1
- Keep sigma = 0.6267, and adjust mu to 1
# Given data
mu_current <- 1.93
sigma_current <- 0.6267
LSL <- 0
USL <- 2
target <- (LSL + USL) / 2 # 1.0
# Simulate data
set.seed(42)
x_current <- rnorm(1000, mean = mu_current, sd = sigma_current)
x_centered <- rnorm(1000, mean = target, sd = sigma_current)
# Calculate Cp and Cpk
cp <- (USL - LSL) / (6 * sigma_current)
cpk_current <- min((mu_current - LSL), (USL - mu_current)) / (3 * sigma_current)
cpk_centered <- min((target - LSL), (USL - target)) / (3 * sigma_current)
cat("Current Cp: ", round(cp, 3), "\n")
## Current Cp: 0.532
cat("Current Cpk: ", round(cpk_current, 3), "\n")
## Current Cpk: 0.037
cat("Centered Cpk: ", round(cpk_centered, 3), "\n")
## Centered Cpk: 0.532
# Plot histogram
hist(x_current, col=rgb(1,0,0,0.4), breaks=30, xlim=c(-0.5, 2.5),
main="Process Capability: Before vs After Centering", xlab="Measurement")
hist(x_centered, col=rgb(0,0,1,0.4), breaks=30, add=TRUE)
# Spec limits and target
abline(v=LSL, col="black", lwd=2, lty=2)
abline(v=USL, col="black", lwd=2, lty=2)
abline(v=target, col="darkgreen", lwd=2, lty=3)
# Legend
legend("topright", legend=c("Before (μ=1.93)", "After (μ=1.0)", "LSL/USL", "Target"),
fill=c(rgb(1,0,0,0.4), rgb(0,0,1,0.4), NA, NA),
border=NA, lty=c(NA, NA, 2, 3), col=c(NA, NA, "black", "darkgreen"))
- New Cpk = 0.532 is better but still not capable, so we try to reduce
sigma from 0.6267 to 0.25
# Parameters
mu_target <- 1.0
sigma_good <- 0.25
LSL <- 0
USL <- 2
# Simulate process
set.seed(123)
x_capable <- rnorm(1000, mean = mu_target, sd = sigma_good)
# Calculate capability indices
cp_good <- (USL - LSL) / (6 * sigma_good)
cpk_good <- min((mu_target - LSL), (USL - mu_target)) / (3 * sigma_good)
cat("Cp (reduced σ): ", round(cp_good, 3), "\n")
## Cp (reduced σ): 1.333
cat("Cpk (reduced σ): ", round(cpk_good, 3), "\n")
## Cpk (reduced σ): 1.333
# Plot
hist(x_capable, col=rgb(0,1,0,0.5), breaks=30, xlim=c(-0.5, 2.5),
main="Capable Process: Centered and Reduced σ", xlab="Measurement")
# Spec limits and target
abline(v=LSL, col="black", lwd=2, lty=2)
abline(v=USL, col="black", lwd=2, lty=2)
abline(v=mu_target, col="darkgreen", lwd=2, lty=3)
# Legend
legend("topright", legend=c("Simulated Capable Process", "LSL/USL", "Target"),
fill=c(rgb(0,1,0,0.5), NA, NA),
border=NA, lty=c(NA, 2, 3), col=c(NA, "black", "darkgreen"))
- Green histogram tightly centered around 1.0
- Very few points fall near or beyond LSL/USL → high yield
- Cp and Cpk are greater than 1.33
2. Exercise 8.2 - Textbook
# Given data
xbar <- 202.5 # Process mean, use to estimate actual process capability
s <- 2.0 # Sample standard deviation
LSL <- 196 # Lower specification limit
USL <- 206 # Upper specification limit
# Part (a) — Actual Process Capability (Cpk)
Cp <- (USL - LSL) / (6 * s)
Cp
## [1] 0.8333333
Cpu <- (USL - xbar) / (3 * s)
Cpl <- (xbar - LSL) / (3 * s)
Cpk <- min(Cpu, Cpl)
Cpk
## [1] 0.5833333
# Part (b) — Potential Capability (Cp)
Cp
## [1] 0.8333333
# Part (c) — Proportion of scrap (below LSL) and rework (above USL)
z_scrap <- (LSL - xbar) / s
z_rework <- (USL - xbar) / s
P_scrap <- pnorm(z_scrap)
P_scrap
## [1] 0.000577025
P_rework <- 1 - pnorm(z_rework)
P_rework
## [1] 0.04005916
# Part (d) — Optimal mean to minimize cost when scrap is 2× rework
# Optimal target = [2×USL + LSL] / 3
target_mu <- (2 * USL + LSL) / 3
target_mu
## [1] 202.6667