NOTA: Consulte lo que es el indice de capacidad Cp y Cpk, y lo que es estar un procesos bajo control estadístico
En este trabajo se realiza una simulación estadística para analizar el proceso de soldadura de dos barras metálicas que serán unidas para producir una barra final.
Una barra tiene longitud X1 y la otra X2. Ambas longitudes tienen comportamiento aleatorio y se modelan como distribuciones normales.
El diseño exige que la barra total mida 50 ± 5 cm, es decir, debe estar entre 45 y 55 cm.
El objetivo principal es evaluar:
Aquí definimos los parámetros que da el enunciado y la semilla para que los resultados sean reproducibles.
# Semilla y tamaño de la simulación
set.seed(508) # Fija la semilla para que la simulación sea reproducible
n <- 500 # Número de barras a simular
# Parámetros de las dos barras
mu1 <- 30 # media X1
sigma1 <- sqrt(0.81) # sd X1 = 0.9
mu2 <- 18 # media X2
sigma2 <- 0.3 # sd X2
# Límites de especificación
LSL <- 45
USL <- 55
Explicación: definimos la semilla, el número de simulaciones y los parámetros (medias y desviaciones) para cada componente. Los límites LSL y USL son 45 y 55 respectivamente.
# Simulación de X1 y X2
x1 <- rnorm(n, mean = mu1, sd = sigma1)
x2 <- rnorm(n, mean = mu2, sd = sigma2)
# Longitud total
L <- x1 + x2
# Vistazo rápido a los datos
head(L)
## [1] 47.63257 47.17322 48.62302 49.25110 46.75049 47.30176
summary(L)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 45.34 47.34 48.13 48.06 48.78 50.78
Explicación: rnorm genera valores
aleatorios normales para cada componente. Al sumar elemento a elemento
obtenemos la longitud final de cada barra soldada. head() y
summary() permiten revisar rápidamente si los valores están
en rangos esperados.
hist(L, main="Histograma de longitudes totales", xlab="Longitud final (cm)")
# Estadísticos muestrales
media_L <- mean(L)
sd_L <- sd(L)
# Conteo y proporción fuera de especificaciones
fuera_logico <- (L < LSL) | (L > USL)
conteo_fuera <- sum(fuera_logico)
prop_fuera <- mean(fuera_logico)
# Mostrar resultados
media_L
## [1] 48.06196
sd_L
## [1] 0.9875069
conteo_fuera
## [1] 0
prop_fuera
## [1] 0
Explicación:
- media_L y sd_L resumen la ubicación y la
dispersión de las longitudes simuladas. - prop_fuera es el estimador
empírico de la probabilidad de una pieza fuera de especificación (es la
proporción de observaciones fuera).
Interpretación:
La media está cerca del objetivo (48 cm aprox.) La desviación estándar es pequeña → poca variabilidad
La Probabilidad de estar fuera de especificaciones es ( 0 ) Esto nos dice qué porcentaje de producción sería rechazada.
Calculamos Cp y Cpk tanto usando la desviación teórica como la muestral.
# Cálculos teóricos para la longitud total L
mu_teor <- mu1 + mu2 # media teórica de L
sd_teor <- sqrt(sigma1^2 + sigma2^2) # desviación teórica de L
# Probabilidad teórica de estar fuera de especificaciones
p_teor_fuera_inferior <- pnorm(LSL, mean = mu_teor, sd = sd_teor)
p_teor_fuera_superior <- 1 - pnorm(USL, mean = mu_teor, sd = sd_teor)
p_teor_total <- p_teor_fuera_inferior + p_teor_fuera_superior
# Cp y Cpk teóricos
Cp_teor <- (USL - LSL) / (6 * sd_teor)
Cpk_teor <- min((mu_teor - LSL) / (3 * sd_teor), (USL - mu_teor) / (3 * sd_teor))
# Cp y Cpk muestrales
Cp_mues <- (USL - LSL) / (6 * sd_L)
Cpk_mues <- min((media_L - LSL) / (3 * sd_L), (USL - media_L) / (3 * sd_L))
# Mostrar
Cp_teor; Cpk_teor
## [1] 1.756821
## [1] 1.054093
Cp_mues; Cpk_mues
## [1] 1.687752
## [1] 1.033565
Explicacion: Cp mide la capacidad potencial (solo variabilidad) Cpk mide la capacidad real (considerando centramiento)
Presento los números ordenados para que los muestres en la exposición.
cat("Media Total =", round(media_L,4), "cm\n")
## Media Total = 48.062 cm
cat("Desviacion Estandar=", round(sd_L,4), "cm\n")
## Desviacion Estandar= 0.9875 cm
cat("Observaciones fuera =", conteo_fuera, "de", n, "\n")
## Observaciones fuera = 0 de 500
cat("Proporción empírica fuera =", round(prop_fuera,6), "\n\n")
## Proporción empírica fuera = 0
cat("Indices Cp/Cpk (teórico y muestral):\n")
## Indices Cp/Cpk (teórico y muestral):
cat("Cp_teor =", round(Cp_teor,4), " Cpk_teor =", round(Cpk_teor,4), "\n")
## Cp_teor = 1.7568 Cpk_teor = 1.0541
cat("Cp_mues =", round(Cp_mues,4), " Cpk_mues =", round(Cpk_mues,4), "\n")
## Cp_mues = 1.6878 Cpk_mues = 1.0336
Explicación:
Simulé 500 piezas resultantes de soldar dos barras. Las componentes siguen normales con medias 30 y 18 cm. Sumando ambas obtenemos la longitud final. Evalué la probabilidad de que una pieza quede fuera de la tolerancia 50±5, y calculé Cp y Cpk para investigar la capacidad y centrado del proceso
La media teórica de la longitud final es 48 cm y su desviación teórica es aproximadamente 0.95 cm. Calculando la probabilidad teórica, la probabilidad de producir una pieza fuera de 45–55 cm es muy baja, en torno a 0.078%. En la simulación de 500 muestras no observamos piezas fuera, lo cual concuerda con la probabilidad muy pequeña
El índice Cp, que compara el ancho de especificación con 6 sigmas del proceso, resultó alrededor de 1.75 teórico (1.69 muestral), lo cual muestra que la variabilidad natural es pequeña en comparación con las especificaciones. El índice Cpk, que incluye el efecto del centrado, es de aproximadamente 1.05, lo que indica que el proceso está ligeramente descentrado hacia el límite inferior. En términos prácticos: el proceso tiene buena capacidad pero podría mejorar su centrado
# Evaluación del control del proceso (usamos Cpk muestral)
if (Cpk_mues >= 1.33) {
cat("El proceso está bajo control y es capaz.\n")
} else if (Cpk_mues >= 1) {
cat("El proceso es aceptable pero puede mejorarse.\n")
} else {
cat("El proceso NO está bajo control (Cpk < 1).\n")
}
## El proceso es aceptable pero puede mejorarse.
Con los datos de esta simulación, los índices sugieren un proceso estable y con baja variabilidad. Sin embargo, para afirmar formalmente que está bajo control estadístico sería necesario analizar datos en el tiempo mediante cartas de control (X̄–R o I–MR) y verificar ausencia de causas especiales. Por tanto, la evidencia apunta a que está probablemente bajo control, pero se recomienda monitoreo continuo.
hist(L, breaks = 30, main = "Histograma de longitudes L = X1 + X2",
xlab = "Longitud total (cm)", col = "lightblue", border = "white")
abline(v = c(LSL, USL), col = "red", lwd = 2, lty = 2) # límites
abline(v = mu_teor, col = "darkgreen", lwd = 2) # media teórica
abline(v = media_L, col = "blue", lwd = 2, lty = 3) # media muestral
legend("topright", legend = c("LSL/USL", "Media teórica", "Media muestral"),
col = c("red","darkgreen","blue"), lty = c(2,1,3), lwd = 2, bty = "n")