Descripción del problema

Característica de Calidad: % de humedad de un producto alimenticio (avena).

Consideraciones:

Si la humedad es mayor al 12%: el producto puede requerir más tiempo de cocción del especificado, haciendo que el consumidor consuma avena cruda.
Si la humedad es menor al 6%: el usuario podría darle más tiempo del necesario, perdiendo propiedades proteínicas.

Límites de Especificación:

Límite	Valor
LIE (Límite Inferior de Especificación)	6%
LSE (Límite Superior de Especificación)	12%

Ingreso de los datos

Los datos corresponden a 37 subgrupos de tamaño n = 4 (fase de instalación del gráfico).

library(readxl)
datos <- read_excel("Datos - Porcentaje de humedad de un producto alimenticio.xls")

knitr::kable(
  head(datos, 10),
  caption = "Primeras 10 observaciones de la base de datos"
)

Primeras 10 observaciones de la base de datos
Muestra	X1	X2	X3	X4	XMedia	Rango
1	9.759814	10.104303	10.361062	9.398791	9.905993	0.9622709
2	8.977854	9.716616	9.646849	9.150366	9.372921	0.7387625
3	10.195406	11.929526	10.708613	9.068135	10.475420	2.8613904
4	11.021179	9.350442	9.786002	9.336473	9.873524	1.6847061
5	10.958680	10.924549	11.160759	10.624019	10.917002	0.5367401
6	11.386506	10.004620	10.942684	9.941105	10.568729	1.4454017
7	8.253130	9.994584	10.426990	11.307049	9.995438	3.0539195
8	9.812655	9.008916	10.362825	11.186611	10.092752	2.1776941
9	10.876018	9.672908	9.921140	8.952999	9.855766	1.9230192
10	9.130639	9.782194	9.886370	10.390793	9.797499	1.2601531

Punto a – Tipo de gráfico adecuado

Para este proceso se evaluó la conveniencia de utilizar una carta de control X̄-R o una carta X̄-S.

El tamaño del subgrupo utilizado fue n = 4. Debido a que el tamaño de muestra es pequeño (n ≤ 10), la carta más adecuada es la carta X̄-R, ya que el rango es una medida eficiente de la variabilidad para muestras pequeñas.

La carta X̄ controla el comportamiento de las medias del proceso, mientras que la carta R controla la dispersión o variabilidad dentro de cada subgrupo.

Punto b – Construcción de las cartas de control

El archivo de los datos ya contiene los calculos correspondientes a las medias y rangos de cada muestra Xᵢ.

Cálculo de estadísticos por subgrupo

# Parámetros generales
X_bar <- mean(datos$XMedia)
R_bar <- mean(datos$Rango)

# Constantes para n = 4
A2 <- 0.729
D3 <- 0
D4 <- 2.282

Límites con α = 0.0027 (k=3)

# Límites para carta X̄
LCS_x <- X_bar + A2*R_bar
LCI_x <- X_bar - A2*R_bar

# Límites para carta R
LCS_R <- D4*R_bar
LCI_R <- D3*R_bar

# data frame
df <- data.frame(datos,
                 Fuera_X = (datos$XMedia<LCI_x | datos$XMedia>LCS_x),
                 Fuera_R = (datos$Rango<LCI_R | datos$Rango>LCS_R)
)

=== Límites con α = 0.0027 (k=3) ===

Carta X̄:

LSC = 11.5217
CL = 10.1649
LIC = 8.8081

Carta R:

LSC = 4.2471
CL = 1.8611
LIC = 0

Gráfico X̄ – R con α = 0.0027

library(ggplot2)

# Gráfico X-barra
q_xbar <- ggplot(df, aes(x = Muestra, y =XMedia)) +
  geom_line() +
  geom_point(aes(color = Fuera_X), size = 3) +
  scale_color_manual(values = c("FALSE" = "blue", "TRUE" = "red")) +
  geom_hline(yintercept = X_bar, linetype = "dashed", color = "black", size = 1) +
  geom_hline(yintercept = LCS_x, linetype = "dashed", color = "red", size = 1) +
  geom_hline(yintercept = LCI_x, linetype = "dashed", color = "red", size = 1) +
  
  labs(title = "Carta de Control X̄ (α = 0.0027)(n = 4)", y = "Media", x = "Subgrupo") +
  theme_minimal()+
  theme(legend.position = "none")


# Gráfico R
q_xr <- ggplot(df, aes(x = Muestra, y = Rango)) +
  geom_line() +
  geom_point(aes(color = Fuera_R), size = 3) +
  scale_color_manual(values = c("FALSE" = "blue", "TRUE" = "red")) +
  geom_hline(yintercept = R_bar, linetype = "dashed", color = "black", size = 1) +
  geom_hline(yintercept = LCS_R, linetype = "dashed", color = "red", size = 1) +
  geom_hline(yintercept = LCI_R, linetype = "dashed", color = "red", size = 1) +
  
  labs(title = "Carta de Control R (α = 0.0027)(n = 4)", y = "Rango", x = "Subgrupo") +
  theme_minimal()+
  theme(legend.position = "none")

# Combinar ambos gráficos en una sola ventana

library(patchwork)


q_xbar/q_xr

Teniendo en cuenta los resultados obtenidos en los gráficos de las cartas de control X̄ y R, se evidencin que el proceso no se encuentra bajo un total control estadístico. Aunque durante la mayor parte del monitoreo las observaciones permanecen dentro de los límites de control, en los últimos subgrupos se detectan señales de variación.

En la carta X̄ se observa un desplazamiento significativo de la media con varios puntos fuera de los límites de control, mientras que en la carta R aparece un punto que supera el límite superior de control, indicando un aumento anormal de la variabilidad. Por tanto, es necesario identificar los puntos que se salen de control y eliminarlos de la base de datos para instalar formalmente la carta de control.

Identificamos caules datos se salen de los limites de control

# Medias
which(datos$XMedia>LCS_x)

[1] 34 35 36 37

which(datos$XMedia<LCI_x)

[1] 31 32

#Rangos
which(datos$Rango>LCS_R)

[1] 33

Eliminamos los datos fuera de control

Datos_0027 <- datos[
  datos$XMedia >= LCI_x &
    datos$XMedia <= LCS_x &
    datos$Rango  >= LCI_R &
    datos$Rango  <= LCS_R,
]

Luego de eliminar los datos que se encuentran fuera de control calculamos nuevamente los límites:

Recalcular los limites

X_bar <- mean(Datos_0027$XMedia)
R_bar <- mean(Datos_0027$Rango)

# Nuevos límites carta X̄
LCS_x <- X_bar + A2*R_bar
LCI_x <- X_bar - A2*R_bar

# Nuevos límites carta R
LCS_R <- D4*R_bar
LCI_R <- D3*R_bar

Verificar si aún quedan puntos fuera de control

df_final <- data.frame(
  Datos_0027,
  Fuera_X = (Datos_0027$XMedia < LCI_x | Datos_0027$XMedia > LCS_x),
  Fuera_R = (Datos_0027$Rango < LCI_R | Datos_0027$Rango > LCS_R)
)

which(df_final$Fuera_X)

integer(0)

which(df_final$Fuera_R)

integer(0)

Graficamos nuevamente:

Nuevo gráfico X̄ – R con α = 0.0027

# Gráfico X-barra 
q_xbar_final <- ggplot(df_final, aes(x = Muestra, y = XMedia)) +
  geom_line() +
  geom_point(aes(color = Fuera_X), size = 3) +
  scale_color_manual(values = c("FALSE" = "blue", "TRUE" = "red")) +
  geom_hline(yintercept = X_bar, linetype = "dashed", color = "black", size = 1) +
  geom_hline(yintercept = LCS_x, linetype = "dashed", color = "red", size = 1) +
  geom_hline(yintercept = LCI_x, linetype = "dashed", color = "red", size = 1) +
  
  labs(title = "Carta de Control X̄ (α = 0.0027)(n = 4)", y = "Media", x = "Subgrupo") +
  theme_minimal()+
  theme(legend.position = "none")


# Gráfico R
q_xr_final <- ggplot(df_final, aes(x = Muestra, y = Rango)) +
  geom_line() +
  geom_point(aes(color = Fuera_R), size = 3) +
  scale_color_manual(values = c("FALSE" = "blue", "TRUE" = "red")) +
  geom_hline(yintercept = R_bar, linetype = "dashed", color = "black", size = 1) +
  geom_hline(yintercept = LCS_R, linetype = "dashed", color = "red", size = 1) +
  geom_hline(yintercept = LCI_R, linetype = "dashed", color = "red", size = 1) +
  
  labs(title = "Carta de Control R (α = 0.0027)(n = 4)", y = "Rango", x = "Subgrupo") +
  theme_minimal()+
  theme(legend.position = "none")

# Combinar ambos gráficos en una sola ventana

q_xbar_final / q_xr_final

Ahora, como podemos observar en ambos gráficos todos los subgrupos permanecen dentro de los límites de control y no se identifican patrones que indiquen la presencia de causas especiales de variación. En consecuencia, se puede instalar formalmente la carta de control.

Límites con α = 0.05 (k=1.96)

alpha <- 0.05

# Valor z correspondiente
z <- qnorm(1 - alpha/2)

# Factor de ajuste respecto a k=3
k <- z/3

A2_05 <- A2*k


# Nuevos límites para x-

LCS_x_05 <- X_bar + A2_05*R_bar
LCI_x_05 <- X_bar - A2_05*R_bar

# Constantes

D4_05 <- 1 + (D4 - 1)*k
D3_05 <- max(0, 1 - (1 - D3)*k)

# Limites para carta R

LCS_R_05 <- D4_05*R_bar
LCI_R_05 <- D3_05*R_bar


# Data frame
df_05 <- data.frame(datos,
                 Fuera_X = (datos$XMedia<LCI_x_05 | datos$XMedia>LCS_x_05),
                 Fuera_R = (datos$Rango<LCI_R_05 | datos$Rango>LCS_R_05)
)


LCS_x_05; LCI_x_05; LCS_R_05; LCI_R_05

[1] 10.81088

[1] 9.176013

[1] 3.153845

[1] 0.595013

=== Límites con α = 0.05 (k=1.96) ===

Carta X̄:

LSC = 11.05133
CL = 10.1649
LIC = 9.278508

Carta R:

LSC = 3.419967
CL = 1.8611
LIC = 0.6452203

Gráfico X̄ – R con α = 0.05

# Gráfico X-barra
q_xbar_05 <- ggplot(df_05, aes(x = Muestra, y = XMedia)) +
  geom_line() +
  geom_point(aes(color = Fuera_X), size = 3) +
  scale_color_manual(values = c("FALSE" = "blue", "TRUE" = "red")) +
  geom_hline(yintercept = X_bar, linetype = "dashed", color = "black", size = 1) +
  geom_hline(yintercept = LCS_x_05, linetype = "dashed", color = "red", size = 1) +
  geom_hline(yintercept = LCI_x_05, linetype = "dashed", color = "red", size = 1) +
  
  labs(title = "Carta de Control X̄ (α = 0.05) (n = 4)", y = "Media", x = "Subgrupo") +
  theme_minimal()+
  theme(legend.position = "none")


# Gráfico R
q_xr_05 <- ggplot(df_05, aes(x = Muestra, y = Rango)) +
  geom_line() +
  geom_point(aes(color = Fuera_R), size = 3) +
  scale_color_manual(values = c("FALSE" = "blue", "TRUE" = "red")) +
  geom_hline(yintercept = R_bar, linetype = "dashed", color = "black", size = 1) +
  geom_hline(yintercept = LCS_R_05, linetype = "dashed", color = "red", size = 1) +
  geom_hline(yintercept = LCI_R_05, linetype = "dashed", color = "red", size = 1) +
  
  labs(title = "Carta de Control R (α = 0.05)(n = 4)", y = "Rango", x = "Subgrupo") +
  theme_minimal()+
  theme(legend.position = "none")

# Combinar ambos gráficos en una sola ventana

q_xbar_05 / q_xr_05

Al igual que la carta de control con α = 0.0027, estas gráficas presentan algunos puntos fuera de los límites de control previamente estabelcidos. Por tanto, nuevamenten identificaremos los puntos que se salen de control y los eliminaremos de la base de datos para después instalar formalmente la carta de control.

Identificamos cuales datos se salen de los limites de control

# Medias
which(datos$XMedia>LCS_x_05)

[1]  5 28 33 34 35 36 37

which(datos$XMedia<LCI_x_05)

[1] 12 31 32

# Rangos
which(datos$Rango>LCS_R_05)

[1] 28 33

which(datos$Rango<LCI_R_05)

[1]  5 14

Eliminamos los datos fuera de control

Luego de identificar losd atos fuera de control para ambos gráficos, procedemos a eliminarlos de la base de datos:

Datos_05 <- datos[
  datos$XMedia >= LCI_x_05 &
    datos$XMedia <= LCS_x_05 &
    datos$Rango  >= LCI_R_05 &
    datos$Rango  <= LCS_R_05,
]

Recalcular los límites

X_bar_05 <- mean(Datos_05$XMedia)
R_bar_05 <- mean(Datos_05$Rango)

LCS_x_05 <- X_bar_05 + A2_05*R_bar_05
LCI_x_05 <- X_bar_05 - A2_05*R_bar_05

LCS_R_05 <- D4_05*R_bar_05
LCI_R_05 <- D3_05*R_bar_05

Verificar si aún quedan puntos fuera de control

df_05_final <- data.frame(
  Datos_05,
  Fuera_X = (Datos_05$XMedia < LCI_x_05 |Datos_05$XMedia > LCS_x_05),
  
  Fuera_R = (Datos_05$Rango < LCI_R_05 |Datos_05$Rango > LCS_R_05)
)

which(df_05_final$Fuera_X)

integer(0)

which(df_05_final$Fuera_R)

integer(0)

Nuevo gráfico X̄ – R con α = 0.05

Ya verificado que no hay puntos fuera de control graficamos nuevamente las cartas de control:

# Gráfico X-barra
q_xbar_05_final <- ggplot(df_05_final, aes(x = Muestra, y = XMedia)) +
  geom_line() +
  geom_point(aes(color = Fuera_X), size = 3) +
  scale_color_manual(values = c("FALSE" = "blue", "TRUE" = "red")) +
  geom_hline(yintercept = X_bar_05, linetype = "dashed", color = "black", size = 1) +
  geom_hline(yintercept = LCS_x_05, linetype = "dashed", color = "red", size = 1) +
  geom_hline(yintercept = LCI_x_05, linetype = "dashed", color = "red", size = 1) +
  
  labs(title = "Carta de Control X̄ (α = 0.05) (n = 4)", y = "Media", x = "Subgrupo") +
  theme_minimal()+
  theme(legend.position = "none")


# Gráfico R
q_xr_05_final <- ggplot(df_05_final, aes(x = Muestra, y = Rango)) +
  geom_line() +
  geom_point(aes(color = Fuera_R), size = 3) +
  scale_color_manual(values = c("FALSE" = "blue", "TRUE" = "red")) +
  geom_hline(yintercept = R_bar_05, linetype = "dashed", color = "black", size = 1) +
  geom_hline(yintercept = LCS_R_05, linetype = "dashed", color = "red", size = 1) +
  geom_hline(yintercept = LCI_R_05, linetype = "dashed", color = "red", size = 1) +
  
  labs(title = "Carta de Control R (α = 0.05)(n = 4)", y = "Rango", x = "Subgrupo") +
  theme_minimal()+
  theme(legend.position = "none")

# Combinar ambos gráficos en una sola ventana

q_xbar_05_final / q_xr_05_final

Las cartas de control X̄ y R indican que el proceso se encuentra bajo control estadístico. Todas las observaciones permanecen dentro de los límites de control y no se identifican patrones que sugieran causas de variación. Tanto la media como la variabilidad muestran un comportamiento estable, por lo que las fluctuaciones observadas pueden atribuirse a causas comunes inherentes al proceso. Aunque los límites de control son más estrechos debido al uso de α=0.05, el proceso evidencia estabilidad y predictibilidad, por lo cual las cartas de control pueden ser instaladas.

Punto c - Estimación del centramiento del proceso y la desviación estándar

Para estimar el centramiento del proceso usamos la media global de los subgrupos que quedaron bajo control estadístico, es decir, después de quitar las muestras que salieron de los límites. Básicamente, recalculamos la media solo con los datos limpios, porque esos son los que mejor representan cómo se comporta el proceso cuando está funcionando bien.

La estimaccion del centramiento se calcula con:

\[ \hat{\mu}_0 = \bar{\bar{X}} \]

Y como se usaron cartas \(\bar{X}-R\), la desviación estándar del proceso se estima a partir del rango promedio limpio. Para subgrupos de tamaño \(n = 4\), la constante \(d_2\) correspondiente es:

\[ d_2 = 2.059 \]

La desviacion estandar es:

\[ \hat{\sigma}_0 = \frac{\bar{R}}{d_2} \]

# Punto C: Estimar el centramiento y la desviación estándar

# Constante d2 para subgrupos de n = 4
d2 <- 2.059
n <- 4

# 
if (!exists("X_bar")) {
  X_bar <- 10.16492
}

if (!exists("R_bar")) {
  sigma_referencia <- 0.9039086
  R_bar <- sigma_referencia * d2
}

# Centramiento estimado
mu_estimada <- X_bar

# Desviación estándar estimada
sigma_estimada <- R_bar / d2

=== PUNTO C: ESTIMACIÓN DEL PROCESO ===

Centramiento del proceso: 9.99345
Rango promedio limpio: 1.71632
Desviación estándar estimada: 0.83357

Entonces mu_estimada es el porcentaje promedio de humedad cuando el proceso está bajo control, y sigma_estimada es la variabilidad natural del proceso calculada a partir del rango promedio de los subgrupos limpios.

Punto d - Curva característica de operación

La curva OC muestra qué tan probable es que la carta de control no detecte un cambio en la media del proceso. Esa probabilidad se llama \(\beta\) o error tipo II.

Para una carta de medias, si la media se desplaza en \(\Delta\) unidades, la probabilidad de no detectar ese cambio es:

\[\beta = P\left(Z < z_{\alpha/2} - \delta\sqrt{n}\right) - P\left(Z < -z_{\alpha/2} - \delta\sqrt{n}\right)\]

Se comparan dos configuraciones:

\(\alpha = 0.0027\), con \(k = 3\).
\(\alpha = 0.05\), con \(k = 1.96\).

# Punto D: Curva característica de operación

library(ggplot2)

# Rango de cambios en la media de humedad, de 0 a 3%
delta_nominal <- seq(0, 3, by = 0.01)

# Función para calcular beta, es decir, la probabilidad de no detectar el cambio
calcular_beta <- function(k, sigma, delta, n) {
  lambda <- (delta * sqrt(n)) / sigma
  beta <- pnorm(k - lambda) - pnorm(-k - lambda)
  return(beta)
}

# Valores de k según cada nivel de significancia
k_0027 <- 3
k_05 <- qnorm(1 - 0.05 / 2)

# Beta para alpha = 0.0027
beta_0027 <- calcular_beta(
  k = k_0027,
  sigma = sigma_estimada,
  delta = delta_nominal,
  n = n
)

# Beta para alpha = 0.05
beta_05 <- calcular_beta(
  k = k_05,
  sigma = sigma_estimada,
  delta = delta_nominal,
  n = n
)

#dataframe para graficar
df_oc <- data.frame(
  Delta = rep(delta_nominal, 2),
  Beta = c(beta_0027, beta_05),
  Grafico = rep(
    c("alpha = 0.0027, k = 3", "alpha = 0.05, k = 1.96"),
    each = length(delta_nominal)
  )
)


grafico_oc <- ggplot(
  df_oc,
  aes(x = Delta, y = Beta, color = Grafico, linetype = Grafico)
) +
  geom_line(linewidth = 1.2) +
  scale_color_manual(
    values = c(
      "alpha = 0.0027, k = 3" = "blue",
      "alpha = 0.05, k = 1.96" = "red"
    )
  ) +
  scale_linetype_manual(
    values = c(
      "alpha = 0.0027, k = 3" = "solid",
      "alpha = 0.05, k = 1.96" = "dashed"
    )
  ) +
  labs(
    title = "Curva Característica de Operación",
    subtitle = "Comparación entre alpha = 0.0027 y alpha = 0.05",
    x = "Cambio nominal en la media de humedad",
    y = "Probabilidad de no detectar el cambio (Beta)"
  ) +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    plot.title = element_text(face = "bold"),
    legend.title = element_blank()
  )

print(grafico_oc)

Análisis de la curva OC

Al ver las dos curvas se nota que la de \(\alpha = 0.05\) cae más rápido. Eso quiere decir que, para un mismo cambio en la humedad, esa carta tiene menos probabilidad de dejarlo pasar sin detectarlo, o sea, es más sensible.

Eso pasa porque con \(\alpha = 0.05\) los límites de control son más estrechos, ya que se usa \(k \approx 1.96\). Entonces la carta reacciona antes ante cualquier variación minima.

Con \(\alpha = 0.0027\) los límites son más amplios porque se usa \(k = 3\). Esto hace que la carta no genere muchas falsas alarmas, pero también puede tardar más en notar que hubo algun cambio.

En este caso podemos decir que más sensibilidad implica más falsas alarmas, y menos falsas alarmas implica que se pueden escapar algunos cambios reales.

Para este proceso en particular eso importa bastante, debido a que la humedad del producto tiene límites definidos, es decir, si la humedad sube mucho, el producto puede necesitar más cocción (puede quedar crudo) y si baja demasiado, puede perder sus propiedades. Entonces, si el costo de sacar producto fuera de especificación es alto, conviene usar la carta de \(\alpha = 0.05\). Pero si parar la línea es muy costoso, puede ser mejor la carta de \(\alpha = 0.0027\).

Punto e - Probabilidad de detectar un cambio de δ = 1.4%

Para evaluar la capacidad del gráfico de detectar un desplazamiento en la media del proceso, se calcula la probabilidad de error tipo II (β), definida como la probabilidad de que el gráfico no detecte el cambio cuando este ya ha ocurrido. La probabilidad de detección corresponde entonces a (1 − β), también llamada potencia del gráfico. La expresión utilizada es:

\[\beta = P\left(Z < z_{\alpha/2} - \delta\sqrt{n}\right) - P\left(Z < -z_{\alpha/2} - \delta\sqrt{n}\right)\]

donde δ = 1.4 es el cambio expresado en unidades de desviación estándar y n = 4 es el tamaño del subgrupo.

Para α = 0.0027 (k=3)

potencia=function(n,delta,alpha){
  z=-qnorm(alpha/2)
  potencia=1-(pnorm(z-delta*sqrt(n))-pnorm(-z-delta*sqrt(n))  )
  return(potencia)
}

potencia1 <- potencia(4,1.4,0.0027)
potencia1

[1] 0.4207493

Existe un 42.07% de probabilidad de que el gráfico sí detecte el cambio en una muestra dada.

Para α = 0.05 (k=1.96)

potencia2 <- potencia(4,1.4,0.05)
potencia2

[1] 0.7995569

Existe un 79.96% de probabilidad de que el gráfico sí detecte el cambio en una muestra dada.

Teniendo en cuenta los resultados obtenidos podemos resaltar que el gráfico con α = 0.05 tiene una potencia casi el doble que el de α = 0.0027 (79.96% vs 42.07%), lo que significa que detecta cambios de esta magnitud con mucha mayor facilidad. Sin embargo, esta ventaja tiene un costo, daod que al usar límites más estrechos, el gráfico también emite más falsas alarmas.

Punto f – Probabilidad de que el cambio sea detectado exactamente en la 4ª muestra

Una vez ocurrido el cambio, cada muestra tomada representa un intento independiente de detección. Dado que en cada muestra el gráfico detecta el cambio con probabilidad (1 − β) o falla con probabilidad β, el número de muestras hasta la primera detección sigue una distribución geométrica.

La probabilidad de que el cambio sea detectado exactamente en la muestra k es:

\[ P(X=k) = \beta^{(k-1)}*(1-\beta) \]

Esta expresión indica que las primeras (k − 1) muestras no detectan el cambio (cada una con probabilidad β), y que la k-ésima muestra sí lo detecta (con probabilidad 1 − β).

Para α = 0.0027, k=4

k <- 4
beta=function(n,delta,alpha){
  z=-qnorm(alpha/2)
  beta=(pnorm(z-delta*sqrt(n))-pnorm(-z-delta*sqrt(n))  )
  return(beta)
}

beta1 <- beta(4,1.4,0.0027)


Prob1 <- beta1^(k-1)*(potencia1)
Prob1

[1] 0.08177548

Existe un 8.18% de probabilidad de que el cambio sea detectado exactamente en la cuarta muestra posterior a su ocurrencia.

Para α = 0.05, k=4

beta2 <- beta(4,1.4,0.05)

prob2 <- beta2^(k-1)*(potencia2)
prob2

[1] 0.006439066

Existe un 0.64% de probabilidad de que el cambio sea detectado exactamente en la cuarta muestra posterior a su ocurrencia.

Con α = 0.0027, la probabilidad de detección en k = 4 es mayor que con α = 0.05. Esto ocurre porque con α = 0.05 el gráfico detecta tan rápido (alta potencia) que es muy poco probable que el cambio llegue sin ser detectado hasta la cuarta muestra; lo más probable es que ya haya sido detectado antes. Con α = 0.0027, como la potencia es menor, hay más probabilidad de que el cambio este sin ser detectado durante las primeras muestras y se detecte en la cuarta.

Punto g y h – ARL₁: Muestras esperadas para detectar el cambio y ARL₀: Muestras esperadas hasta una falsa alarma

# Parámetros del proceso (usando datos finales limpios α=0.0027)
  d2 <- 2.059          # Constante para n = 4
  n  <- 4
  delta <- 1.4         # Cambio en la media (%)

Estimación de sigma del proceso

sigma_hat <- R_bar/d2
sigma_hat

[1] 0.8335718

Función general para calcular β, ARL₁, ARL₀

calcular_ARL <- function(k, sigma, delta, n, alpha, label) {
    
    # Desplazamiento estandarizado
    lambda <- (delta * sqrt(n)) / sigma
    
    # β = P(no detectar el cambio en una muestra)
    beta <- pnorm(k - lambda) - pnorm(-k - lambda)
    
    # Potencia = 1 - β
    potencia <- 1 - beta
    
    # PUNTO G: ARL₁ = número esperado de muestras para DETECTAR el cambio
    ARL1 <- 1 / potencia
    
    # PUNTO H: ARL₀ = número esperado de muestras para FALSA ALARMA
    ARL0 <- 1 / alpha
    
    return(list(beta=beta, potencia=potencia, ARL1=ARL1, ARL0=ARL0, lambda=lambda))
  }

α = 0.0027, k = 3

resultado_0027 <- calcular_ARL(
    k      = 3,
    sigma  = sigma_hat,
    delta  = delta,
    n      = n,
    alpha  = 0.0027,
    label  = "α = 0.0027 (3 sigma)"
  )
resultado_0027

$beta
[1] 0.359783

$potencia
[1] 0.640217

$ARL1
[1] 1.56197

$ARL0
[1] 370.3704

$lambda
[1] 3.359039

Para α = 0.0027, se obtuvo un ARL₁ = 1.56, por lo que el cambio de 1.4% sería detectado en promedio entre la primera y la segunda muestra.

Para α = 0.0027, se obtuvo un ARL₀ = 370.37, por lo que se espera una falsa alarma aproximadamente cada 370 muestras.

α = 0.05, k = 1.96

resultado_05 <- calcular_ARL(
    k      = qnorm(1 - 0.05/2),
    sigma  = sigma_hat,
    delta  = delta,
    n      = n,
    alpha  = 0.05,
    label  = "α = 0.05 (1.96 sigma)"
  )
resultado_05

$beta
[1] 0.0808952

$potencia
[1] 0.9191048

$ARL1
[1] 1.088015

$ARL0
[1] 20

$lambda
[1] 3.359039

Para α = 0.05, se obtuvo un ARL₁ = 1.09, indicando que el cambio sería detectado prácticamente en la primera muestra.

Para α = 0.05, se obtuvo un ARL₀ = 20, por lo que se espera una falsa alarma aproximadamente cada 20 muestras.

Resumen

resumen <- data.frame(
    Alpha     = c("0.0027", "0.05"),
    k         = c(3, round(qnorm(0.975), 4)),
    Beta      = round(c(resultado_0027$beta, resultado_05$beta), 6),
    Potencia  = round(c(resultado_0027$potencia, resultado_05$potencia), 6),
    ARL1_PtoG = round(c(resultado_0027$ARL1, resultado_05$ARL1), 2),
    ARL0_PtoH = round(c(resultado_0027$ARL0, resultado_05$ARL0), 2)
  )
knitr::kable(resumen)

Alpha	k	Beta	Potencia	ARL1_PtoG	ARL0_PtoH
0.0027	3.00	0.359783	0.640217	1.56	370.37
0.05	1.96	0.080895	0.919105	1.09	20.00

Como podemos ver en los resultados obtenido, ambos gráficos detectan rápidamente el cambio, aunque el de α = 0.05 lo hace más rápido por tener límites de control más estrechos. Además, el gráfico con α = 0.05 detecta cambios más rápido, pero genera falsas alarmas con mayor frecuencia. El gráfico con α = 0.0027 es más estable y por eso suele preferirse en la práctica.

Taller 5 – Gráficos de Control por Variables

Control de Calidad – Ingeniería Industrial

Sara Bolívar, Tatiana López, Oscar Martínez y Verónica Vidal

2026-06-08

Descripción del problema

Ingreso de los datos

Punto a – Tipo de gráfico adecuado

Punto b – Construcción de las cartas de control

Cálculo de estadísticos por subgrupo

Límites con α = 0.0027 (k=3)

Gráfico X̄ – R con α = 0.0027

Identificamos caules datos se salen de los limites de control

Eliminamos los datos fuera de control

Recalcular los limites

Verificar si aún quedan puntos fuera de control

Nuevo gráfico X̄ – R con α = 0.0027

Límites con α = 0.05 (k=1.96)

Gráfico X̄ – R con α = 0.05

Identificamos cuales datos se salen de los limites de control

Eliminamos los datos fuera de control

Recalcular los límites

Verificar si aún quedan puntos fuera de control

Nuevo gráfico X̄ – R con α = 0.05

Punto c - Estimación del centramiento del proceso y la desviación estándar

Punto d - Curva característica de operación

Análisis de la curva OC

Punto e - Probabilidad de detectar un cambio de δ = 1.4%

Para α = 0.0027 (k=3)

Para α = 0.05 (k=1.96)

Punto f – Probabilidad de que el cambio sea detectado exactamente en la 4ª muestra

Para α = 0.0027, k=4

Para α = 0.05, k=4

Punto g y h – ARL₁: Muestras esperadas para detectar el cambio y ARL₀: Muestras esperadas hasta una falsa alarma

Estimación de sigma del proceso

Función general para calcular β, ARL₁, ARL₀

α = 0.0027, k = 3

α = 0.05, k = 1.96

Resumen