4 Diagramas de Control para Variables

Los diagramas de control de variables se usan cuando la característica medible de la calidad que se monitorea es física y ésta puede expresarse en términos de una medición numérica, como por ejemplo, el diámetro de una rolinera podría medirse con un micrómetro y expresarse en milímetros.

Cuando se usan diagramas de control de variables para monitorear características claves de la calidad en un proceso de producción, por lo general es necesario vigilar tanto el valor medio de la característica de la calidad como su variabilidad. Supóngase que se tiene un proceso de producción en el cual se está monitoreando una característica de la calidad que tiene media \(\mu\) y desviación estándar \(\sigma\) con los siguientes límites de control

\[ \begin{align*} LCS & = \mu + \frac{3}{\sqrt{5}}\sigma \approx \mu + 1,34\sigma \\ LCI & = \mu - \frac{3}{\sqrt{5}}\sigma \approx \mu - 1,34\sigma \end{align*}. \]

Supóngase también que se toma una muestra de tamaño 5, obteniéndose los siguientes valores: \(x_1 = \mu + 2\sigma\), \(x_2 = \mu-2\sigma\), \(x_3 = \mu\), \(x_4 = \mu + 3\sigma\), \(x_5 = \mu - 3\sigma\), y que el estadístico que se grafica es la media muestral, es decir

\[ \bar{x} = \frac{\mu + 2\sigma +\mu-2\sigma + \mu + \mu + 3\sigma + \mu - 3\sigma}{5}= \frac{5\mu}{5} = \mu . \]

Código

```{r}
#| label: fig-dcv
#| fig-cap: "Gráfico de los puntos muestrales"

data <- data.frame(
  muestra = 1:5,
  punto = c(12, 8, 10, 13, 7),
  violacion = factor(
    c(
      "Fuera de control", "Fuera de control", "Bajo control",
      "Fuera de control", "Fuera de control"
    )
  )
)
ggplot(data = data, aes(x = muestra, y = punto)) +
  geom_step(
    mapping = aes(x = muestra, y = 10 - 3 / sqrt(5)),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = 10),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = 10 + 3 / sqrt(5)),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(
      x = muestra, y = punto, 
      colour = violacion, 
      shape = violacion
    )
  ) +
  scale_colour_manual(
    values = c(
      "Fuera de control" = "red", 
      "Bajo control" = "black", 
      show.legend = FALSE
    )
  ) +
  scale_shape_manual(values = c(16, 8)) +
  geom_line(
    mapping = aes(x = muestra, y = punto), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = 10 - 3 / sqrt(5), ymax = 10), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = 10, ymax = 10 + 3 / sqrt(5)), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = 10 + 3 / sqrt(5), ymax = Inf), 
    fill = "#FF0000", alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = 10 - 3 / sqrt(5), ymax = -Inf), 
    fill = "#FF0000", alpha = 0.2, direction = "hv"
  ) +
  annotate(
    "text",
    x = 5 + 0.5, y = 10 - 3 / sqrt(5), 
    label = latex2exp::TeX(
      "$LCI = \\mu - \\frac{3}{\\sqrt{5}}\\sigma$", 
      italic = TRUE
    )
  ) +
  annotate(
    "text", x = 5 + 0.5, y = 10 + 3 / sqrt(5), 
    label = latex2exp::TeX(
      "$LCS = \\mu + \\frac{3}{\\sqrt{5}}\\sigma$", 
      italic = TRUE
    )
  ) +
  annotate(
    "text",
    x = 5 + 0.5, y = 10, 
    label = latex2exp::TeX(
      "$LC = \\mu$", italic = TRUE
    )
  ) +
  labs(
    x = latex2exp::TeX(
      "Observación", bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "Característica de la calidad", 
      bold = TRUE, italic = TRUE
    )
  ) +
  # xlim(1, 6) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 5, by = 1),
    labels = c(
      latex2exp::TeX("$x_1$", bold = TRUE, italic = TRUE),
      latex2exp::TeX("$x_2$", bold = TRUE, italic = TRUE),
      latex2exp::TeX("$x_3$", bold = TRUE, italic = TRUE),
      latex2exp::TeX("$x_4$", bold = TRUE, italic = TRUE),
      latex2exp::TeX("$x_5$", bold = TRUE, italic = TRUE)
    ),
    limits = c(1, 6)
  ) +
  scale_y_continuous(
    labels = c(
      latex2exp::TeX(
        "$\\mu - 4\\sigma$", bold = TRUE, italic = TRUE
      ),
      latex2exp::TeX(
        "$\\mu - 2\\sigma$", bold = TRUE, italic = TRUE
      ),
      latex2exp::TeX("$\\mu$", bold = TRUE, italic = TRUE),
      latex2exp::TeX(
        "$\\mu + 2\\sigma$", bold = TRUE, italic = TRUE
      ),
      latex2exp::TeX(
        "$\\mu + 4\\sigma$", bold = TRUE, italic = TRUE
      )
    )
  ) +
  theme_bw() +
  theme(
    legend.title = element_blank(),
    legend.position = "bottom",
    legend.text = element_text(face = "bold")
  )
```

Figura 4.1: Gráfico de los puntos muestrales

Como se nota en la Figura 4.1, a pesar que la media muestral está dentro de los límites de control, existen cuatro puntos que están fuera de dichos límites, esto se debe a una alta variabilidad entre las observaciones que forman la muestra, por consiguiente debemos controlar también la variabilidad de los datos.

En los casos en los cuales el proceso es monitoreado a través de la selección secuencial de muestras de tamaño \(n\) el nivel de calidad medio, suele controlarse con el diagrama de control para medias, o diagrama \(\bar{x}\); mientras que la variabilidad del proceso puede monitorearse con un diagrama de control para el rango, llamado diagrama \(R\), o bien con un diagrama de control para la desviación estándar, llamado diagrama \(S\). Por otro lado, si el proceso es monitoreado a través de la selección de observaciones individuales, entonces el nivel medio se vigila a través del diagrama para observaciones individuales o diagrama \(X\), mientras que la variabilidad se inspecciona con un diagrama de control para el rango móvil, llamado diagrama \(\textit{MR}\) (por sus siglas en inglés, Movile Range).

4.1 Diagramas de Control \(\bar{x}\) y \(R\)

En los pares de diagramas \(\bar{x}\) y \(R\) los estadísticos que se grafican son la media muestral y el rango muestral, respectivamente. Supóngase que se cuenta con una muestra de tamaño \(n\) de una característica de la calidad, es decir; \(x_1\), \(x_2\), \(\dots\),\(x_n\). Entonces la media de la muestra es

\[ \bar{x}=\frac{\sum_{i=1}^{n}x_i}{n}. \]

Mientras que el rango de la muestra viene dado por

\[ R = \mathrm{máx}\{x_1, x_2, \dots, x_n\} - \mathrm{mín}\{x_1, x_2, \dots, x_n\} = x_{\mathrm{máx}} - x_{\mathrm{mín}}. \]

La forma como se construyen los límites de control y la línea central de estos diagramas va a depender si se cuentan o no con los parámetros de la característica de la calidad que se está monitoreando, en este caso la media y la desviación estándar. Cuando se tiene información acerca de estos parámetros los diagramas se conocen como diagramas de control estándar, mientras que cuando son desconocidos estos se conocen como diagramas de control inicial.

4.1.1 Diagramas de Control \(\bar{x}\) y \(R\) Estándar

Supóngase que se tiene un proceso de producción en el cual se inspecciona una característica de la calidad la cual se distribuye normalmente con media \(\mu\) y desviación estándar \(\sigma\) conocidas y que se toman \(m\) muestras de tamaño \(n\) del proceso para controlar la producción. Sea \(X_{ij}\) la observación \(j\) en la muestra \(i\), con \(i = 1, 2, \dots, m\) y \(j = 1, 2, \dots, n\). Bajo las suposiciones anteriores se procede a construir los límites de control y la línea central del par de diagramas \(\bar{x}\) y \(R\). El enfoque usado para construir estos diagramas es el de Shewhart.

4.1.1.1 Diagramas de Control \(\bar{x}\) Estándar

En este diagrama el estadístico que se grafica es la media de cada muestra \(\bar{X}_i\), la cual viene dada por:

Media muestral \(\bar{X}_i\)

\[ \bar{X}_i=\frac{\sum_{j=1}^{n}X_{ij}}{n}, \; i = 1, 2, \dots, m. \tag{4.1}\]

De lo anterior, la media de la media muestral \(\mu_{\bar{X}_i}\), viene dada por:

\[ \mu_{\bar{X}_i} = E\left( \bar{X}_i \right) = E\left(\frac{\sum_{j=1}^{n}X_{ij}}{n} \right) = \frac{1}{n}\sum_{i = 1}^{n}E\left( X_{ij} \right) = \frac{1}{n}n\mu = \mu. \]

Mientras que, la desviación estándar de la media muestral, se obtiene como sigue:

\[ \begin{align*} \sigma_{\bar{X}_i} & = \sqrt{V\left( \bar{X}_i \right)} = \sqrt{V\left(\frac{\sum_{j=1}^{n}X_{ij}}{n} \right)}=\sqrt{\frac{1}{n^2}\sum_{i = 1}^{n}V \left( X_{ij} \right) }=\sqrt{\frac{1}{n^2}n\sigma^2} \\ & = \frac{\sigma}{\sqrt{n}} \:. \end{align*} \]

En resumen, la media y la desviación estándar de \(\bar{X}_i\), vienen dadas por:

Media y desviación estándar de \(\bar{X}_i\)

\[ \begin{align*} \mu_{\bar{X}_i} & = \mu\\ \sigma_{\bar{X}_i} & = \frac{\sigma}{\sqrt{n}} \end{align*}. \tag{4.2}\]

Dado que \(X_{ij}\) es una variable aleatoria con distribución normal, por la propiedad reproductiva de la distribución normal, se deduce que

\[ \bar{X}_i \sim N \left(\mu_{\bar{X}_i} = \mu, \sigma_{\bar{X}_i} = \frac{\sigma}{\sqrt{n}} \right). \tag{4.3}\]

Por lo tanto, los límites de control y la línea central, según el modelo general de Shewhart, del diagrama estándar viene dada por

\[ \begin{align*} LCS & = \mu_{\bar{X}_i} + 3\sigma_{\bar{X}_i}= \mu + 3\frac{\sigma}{\sqrt{n}}\\ LC & = \mu_{\bar{X}_i} = \mu \\ LCI & = \mu_{\bar{X}_i} - 3\sigma_{\bar{X}_i}= \mu - 3\frac{\sigma}{\sqrt{n}} \end{align*}. \tag{4.4}\]

Haciendo \(A=3/\sqrt{n}\), estos límites de control y la línea central puede reescribirse como

Limites de control estándar del diagrama \(\bar{x}\)

\[ \begin{align*} LCS & = \mu + A\sigma\\ LC & = \mu \\ LCI & = \mu - A\sigma\\ \end{align*}. \tag{4.5}\]

En la Tabla A.1 del Apéndice A se encuentran tabulados los valores de \(A\) para diferentes valores de \(n\).

4.1.1.2 Diagramas de Control \(R\) Estándar

El estadístico que se grafica en este diagrama es el rango de cada muestra \(R_i\), el cual, no es más que el valor más grande de la muestra \(i\) menos el valor más pequeño en esa muestra, es decir,

Rango muestral

\[ R_i=\text{máx}\{X_{ij}\}-\text{mín}\{X_{ij}\}, \; i = 1, 2, \dots, m. \tag{4.6}\]

La media y la desviación estándar de los \(R_i\) se consigue a partir de la distribución del rango relativo \(W=R⁄σ\), el cual, bajo el supuesto de que \(X_{ij}\) tiene distribución normal, \(W\) tiene media y desviación estándar \(d_2\) y \(d_3\), respectivamente, para detalles de la distribución de \(W\) y sus características ver Tippett (1925). Donde \(d_2\) y \(d_3\) son funciones conocidas de \(n\) y se encuentran tabuladas para diferentes valores de \(n\). El paquete SixSigma de proporciona funciones que permiten hallar valores aproximados de esas constantes, la función ss.getd2 da la aproximación de \(d_2\), mientras que la función ss.getd3 aproxima los valores de \(d_3\). En la Tabla A.1 del Apéndice A se muestran los valores de estas constantes.

En base a lo anterior, haciendo \(R=\sigma W\), la media de \(R_i\) es

\[ \mu_{R_i} = E\left( R_{i} \right) = E\left( \sigma W \right)=\sigma E\left( W \right)=\sigma d_{2}= d_{2}\sigma. \]

Mientras que la desviación estándar de \(R_i\), se obtiene como sigue:

\[ \sigma_{R_i} = \sqrt{V\left( R_i \right)} = \sqrt{V\left( \sigma W \right)}=\sqrt{\sigma^2 V\left( W \right)} =\sqrt{\sigma^{2} d_{3}^{2}} = d_{3}\sigma. \]

En resumen, la media y la desviación estándar del rango muestral \(R_i\), vienen dadas por:

Media y desviación estándar de \(\bar{X}_i\)

\[ \begin{align*} \mu_{R_i} = d_{2}\sigma\\ \sigma_{R_i} = d_{3}\sigma \end{align*}. \tag{4.7}\]

En base a lo anterior, según el modelo general de Shewhart, los límites de control y la línea central del diagrama \(R\) estándar viene dado por

\[ \begin{align*} LCS & = \mu_{R_i} + 3\sigma_{R_i}=d_2 \sigma + 3d_3 \sigma = \left(d_2 + 3d_3 \right) \sigma \\ LC & = \mu_{R_i} = d_2 \sigma \\ LCI & = \mu_{R_i} - 3\sigma_{R_i}=d_2 \sigma - 3d_3 \sigma = \left(d_2 - 3d_3 \right) \sigma \end{align*}. \tag{4.8}\]

Sustituyendo en la ecuación anterior, \(\left(d_2 + 3d_3 \right)\) y \(\left(d_2 - 3d_3 \right)\) por \(D_2\) y \(D_1\), respectivamente, los límites de control y la línea central de este diagrama se pueden reescribir como

Limites de control estándar del diagrama \(R\)

\[ \begin{align*} LCS & = D_2 \sigma \\ LC & = d_2 \sigma \\ LCI & = D_1 \sigma \end{align*}. \tag{4.9}\]

Los valores de los factores \(D_2\) y \(D_1\) se encuentran tabulados para diferentes valores de \(n\) en la Tabla A.1 del Apéndice A.

4.1.2 Diagramas de Control \(\bar{x}\) y \(R\) Inicial

En la práctica generalmente se desconoce la media y la desviación estándar del proceso, por lo que hay que estimarla con los datos observados (subgrupos racionales). El procedimiento para estimar \(\mu\) y \(\sigma\) se conoce como fase I o fase inicial y los diagramas obtenidos en esta fase se llaman diagramas de control inicial. El procedimiento consiste en tomar \(m\) muestras o subgrupos preliminares cuando se considera que el proceso está bajo control. En general, estas estimaciones deberían basarse en al menos 20 o 25 muestras (\(m\geq20\)). Cada una de las cuales debe contener \(n\) observaciones de la característica de la calidad. De manera típica, \(n\) será pequeña, con frecuencia 4, 5 o 6. Estos tamaños pequeños de muestras suelen resultar de la construcción de subgrupos racionales y del hecho de que los costos de muestreo e inspección asociados con la medición de la variable por lo general son relativamente altos. Sea \(\bar{x}_i\) la media de la muestra \(i\), con \(i=1, 2, \dots, m\). Entonces, la mejor estimación de \(\mu\) es el promedio de las medias muestrales, también conocida como la gran media muestral, y viene dada por

Gran media muestral \(\bar{\bar{x}}\)

\[ \hat{\mu}=\bar{\bar{x}}=\frac{\sum_{i=1}^{m}\bar{x}_i}{m}=\frac{\sum_{i=1}^{m}\sum_{j=1}^{n}x_{ij}}{nm},\:i= 1, 2, \dots, m \;y\; j = 1, 2, \dots, n. \tag{4.10}\]

Mientras que la estimación de \(\sigma\) es una función de los rangos muestrales \(R_i\), con \(i=1, 2, \dots, m\). Y viene dada por

Estimación de \(\sigma\)

\[ \hat{\sigma}=\frac{\bar{R}}{d_{2}}=\frac{\sum_{i=1}^{m}R_{i}}{m d_{2}},\:i= 1, 2, \dots, m. \tag{4.11}\]

Se puede demostrar fácilmente que estos estimadores de la media y la desviación estándar del proceso son insesgados.

4.1.2.1 Diagramas de Control \(\bar{x}\) Inicial

En base a los supuestos descritos anteriormente, los límites control del diagrama \(\bar{x}\) inicial se consiguen sustituyendo en la ecuación 4.4 \(\mu\) y \(\sigma\) por sus respectivos estimadores, dados en la ecuación 4.10 y ecuación 4.11. Es decir,

\[ \begin{align*} LCS & = \bar{\bar{x}} + \frac{3}{\sqrt{n}} \frac{\bar{R}}{d_2} \\ LC & = \bar{\bar{x}} \\ LCI & = \bar{\bar{x}} - \frac{3}{\sqrt{n}} \frac{\bar{R}}{d_2} \end{align*}. \tag{4.12}\]

Sustituyendo \(3/ \sqrt{n}d_2\) por \(A_2\) en la expresión anterior, los limites anteriores se pueden expresar de la siguiente manera

Limites de control inicial del diagrama \(\bar{x}\)

\[ \begin{align*} LCS & = \bar{\bar{x}} + A_2 \bar{R} \\ LC & = \bar{\bar{x}} \\ LCI & = \bar{\bar{x}} - A_2 \bar{R} \end{align*}. \tag{4.13}\]

Los valores de \(A_2\) se encuentran tabulados en la Tabla A.1 del Apéndice A para diferentes valores de \(n\).

4.1.2.2 Diagramas de Control \(R\) Inicial

Los límites de control tipo Shewhart para este diagrama se obtienen sustituyendo en la ecuación 4.8 \(\sigma\) por su estimador, dado en la ecuación 4.11. Es decir,

\[ \begin{align*} LCS & = d_2 \frac{\bar{R}}{d_2} + 3d_3 \frac{\bar{R}}{d_2} = \left(1 +\frac{3d_3}{d_2} \right)\bar{R} \\ LC & = d_2 \frac{\bar{R}}{d_2} = \bar{R}\\ LCI & = d_2 \frac{\bar{R}}{d_2} - 3d_3 \frac{\bar{R}}{d_2} = \left(1 - \frac{3d_3}{d_2} \right)\bar{R} \end{align*}. \tag{4.14}\]

Sustituyendo en la ecuación 4.14 \((1+3d_3⁄d_2 )\) y \((1-3d_3⁄d_2 )\) por \(D_4\) y \(D_3\), respectivamente, se obtiene la siguiente expresión para los límites de control y la línea central de este diagrama

Limites de control inicial del diagrama \(R\)

\[ \begin{align*} LCS & = D_4\bar{R} \\ LC & = \bar{R}\\ LCI & = D_3\bar{R} \end{align*}. \tag{4.15}\]

Los valores de \(D_3\) y \(D_4\) se encuentran tabulados en la Tabla A.1 del Apéndice A.

4.1.3 Pasos para la Aplicación de los Diagramas de Control \(\bar{x}\) y \(R\) en la Fase I

La aplicación de los diagramas de control \(\bar{x}\) y \(R\) en el monitoreo del nivel medio y la desviación estándar de una característica de la calidad en un proceso de producción en la fase I se puede esquematizar en los siguientes pasos:

Tomar \(m\) muestras de tamaño \(n\) de la característica de la calidad que se está monitoreando. Se recomienda que \(m \geq 20\) y valores típicos de \(n\) (\(3 \leq n \geq 6\)).
Determinar las medias y rangos de cada muestra a través de la ecuación 4.1 y ecuación 4.6. Los pasos 1 y 2 se pueden resumir en la siguiente tabla.

Tabla 4.1: Resumen de las \(m\) muestras preliminares en el diagrama \(\bar{x}\) y \(R\)

Muestra	\(X_1\)	\(X_2\)	\(\cdots\)	\(X_j\)	\(\cdots\)	\(X_{n-1}\)	\(X_n\)	\(\bar{X}_i\)	\(R_i\)
1	\(x_{11}\)	\(x_{12}\)	\(\cdots\)	\(x_{1j}\)	\(\cdots\)	\(x_{1(n-1)}\)	\(x_{1n}\)	\(\bar{x}_1\)	\(r_1\)
2	\(x_{21}\)	\(x_{22}\)	\(\cdots\)	\(x_{2j}\)	\(\cdots\)	\(x_{2(n-1)}\)	\(x_{2n}\)	\(\bar{x}_2\)	\(r_2\)
\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)
\(i\)	\(x_{i1}\)	\(x_{i2}\)	\(\cdots\)	\(x_{ij}\)	\(\cdots\)	\(x_{i(n-1)}\)	\(x_{in}\)	\(\bar{x}_i\)	\(r_i\)
\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)
\(m-1\)	\(x_{(m-1)1}\)	\(x_{(m-1)2}\)	\(\cdots\)	\(x_{(m-1)j}\)	\(\cdots\)	\(x_{(m-1)(n-1)}\)	\(x_{(m-1)n}\)	\(\bar{x}_{m-1}\)	\(r_{m-1}\)
\(m\)	\(x_{m1}\)	\(x_{m2}\)	\(\cdots\)	\(x_{mj}\)	\(\cdots\)	\(x_{m(n-1)}\)	\(x_{mn}\)	\(\bar{x}_{m}\)	\(r_{m}\)

Estimar la media y la desviación estándar del proceso por medio de la ecuación 4.10 y la ecuación 4.11.
Con las estimaciones de \(\mu\) y \(\sigma\) del paso anterior determinar los límites de control inicial de los diagramas \(\bar{x}\) y \(R\) usando la ecuación 4.13 y la ecuación 4.15. Estos límites son considerados de prueba o preliminares.
Realizar las representaciones gráficas de los diagramas \(\bar{x}\) y \(R\).
Analizar el diagrama \(R\), debido a que la variabilidad de la característica de la calidad debe controlarse primero, y muchas veces controlando la variabilidad se consigue controlar el nivel medio. Si todos los puntos se ubican dentro de los límites de control en este diagrama y no se observa un patrón sistemático se pasa al paso 7. Si uno o más puntos se localizan fuera de los límites control en este diagrama, y suponiendo que estos tienen su causa atribuible, se eliminan del análisis y se reinicia el procedimiento a partir del paso 3. Este siclo se repite hasta que todos los puntos se ubique dentro de los límites de control en el diagrama \(R\). La justificación para eliminar un punto del análisis es que este punto tenga una causa atribuible, de lo contrario no existe un argumento racional para eliminarlo del análisis y en tal caso queda a criterio del investigador incluirlo o excluirlo del análisis.
Analizar el diagrama \(\bar{x}\), si todos los puntos se localizan dentro de los límites de control y no se observa un patrón en los datos se concluye que el proceso está bajo control estadístico tanto en media como en varianza y estos límites de control pueden ser usados para controlar la producción futura, además estas estimaciones de \(\mu\) y \(\sigma\) pude ser usada para estimar la capacidad del proceso. De lo contrario, si uno o más puntos se localizan fuera de los límites de control en este diagrama estos se eliminan del análisis y se reinicia el procedimiento a partir del paso 3.

Ejemplo 4.1 (Aplicación de los Diagramas de Control \(\bar{x}\) y \(R\))
Los anillos para pistones de un motor de automóvil se producen mediante un proceso de fundición. Quiere establecerse el control estadístico del diámetro interior (mm) de los anillos fabricados con este proceso utilizando diagramas de control \(\bar{x}\) y \(R\).

La data pistonrings del paquete qcc de contiene datos del diámetro interior de 200 anillos para pistones de este proceso.

La data tiene las siguientes variables:

diameter: el diámetro interno del anillo en milímetro
sample: un número entero que identifica a la muestra
trial: un indicador lógico que indica si la muestra se tomó en la fase I (true) o en la fase II (false).

Código

```{r}
#| label: tbl-datos-pistones
#| tbl-cap:  "Mediciones del diámetro interior (mm) de anillos para pistones"

data("pistonrings")
pistones <- with(
  data = pistonrings, qcc.groups(data = diameter, sample = sample)
) |>
  data.table::as.data.table() |>
  dplyr::mutate(
    muestra = 1:40,
    trial = rep(c(TRUE, FALSE), times = c(25, 15)),
  ) |>
  dplyr::rowwise() |>
  dplyr::mutate(
    media = mean(c_across(V1:V5)),
    rango = max(c_across(V1:V5)) - min(c_across(V1:V5))
  ) |>
  dplyr::rename(
    X_1 = V1, X_2 = V2, X_3 = V3, X_4 = V4, X_5 = V5,
    fase_1 = trial
  ) |>
  dplyr::relocate(
    c(muestra, fase_1),
    .before = X_1
  ) |>
  data.table::as.data.table()

options(
  reactable.language = reactableLang(
    searchPlaceholder = "buscar...",
    pageNext = "Siguiente",
    pagePrevious = "Anterior",
    noData = "No entries found",
    pageInfo = "{rowStart} de {rowEnd} de {rows} filas"
  )
)

reactable::reactable(
  pistones,
  list(
    muestra = colDef(header = "Muestra", align = "right"),
    fase_1 = colDef(header = "Fase I", align = "right"),
    X_1 = colDef(
      header = "\\( x_{i1} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    X_2 = colDef(
      header = "\\( x_{i2} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    X_3 = colDef(
      header = "\\( x_{i3} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    X_4 = colDef(
      header = "\\( x_{i4} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    X_5 = colDef(
      header = "\\( x_{i5} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    media = colDef(
      header = "\\( \\bar{x}_i \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 4, locales = "es-ES"
      )
    ),
    rango = colDef(
      header = "\\( R_i \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 4, locales = "es-ES"
      )
    )
  ),
  defaultColDef = colDef(align = "center"),
  striped = TRUE,
  bordered = TRUE,
  highlight = TRUE
)

# knitr::kable(
#   pistones,
#   booktabs = TRUE,
#   format = "html",
#   digits = 4,
#   format.args = list(decimal.mark = ",", big.mark = "."),
#   col.names = c(
#     "Muestra", "Fase I", "X_1", "X_2", "X_3", "X_4", "X_5", "Media", "Rango"
#   ),
#   align = "ccccccc",
#   caption = "\\label{tbl-datos-dcp-tmv}Mediciones del diámetro interior (mm) de anillos para pistones",
#   escape = FALSE
#   ) |>
#   kableExtra::kable_styling(
#     bootstrap_options = c("striped", "hover"),
#     full_width = NULL,
#     fixed_thead = FALSE,
#     position = "left"
#   ) |>
#   kableExtra::kable_classic() |>
#   kableExtra::scroll_box(width = "100%", height = "600px")

```

Tabla 4.2: Mediciones del diámetro interior (mm) de anillos para pistones

Como se han tomado muestras de tamaño \(n = 5\), en la Tabla A.1 del Apéndice A se encuentra que \(D_3 = 0\) y \(D_4 = 2,1145\). Por lo que los límites de control inicial y la línea central del diagrama \(R\) calculados con se muestran con el siguiente bloque de código.

Código

```{r}
#| label: lci-Rbarra

n <- 5
D_3 <- ifelse(
  1 - 3 * (SixSigma::ss.cc.getd3(n) / SixSigma::ss.cc.getd2(n)) < 0, 0, 1 - 3 * (SixSigma::ss.cc.getd3(n) / SixSigma::ss.cc.getd3(n))
)
D_4 <- 1 + 3 * (SixSigma::ss.cc.getd3(n) / SixSigma::ss.cc.getd2(n))
m <- pistones |>
  nrow()
media_est <- mean(pistones$media[1:m])
R_barra <- mean(pistones$rango[1:m])

lci_R <- R_barra * D_3
lc_R <- R_barra
lcs_R <- R_barra * D_4
paste0("LCI = ", formato(lci_R), "    LC = ", formato(lc_R), "    LCS = ", formato(lcs_R))
```

#> [1] "LCI = 0    LC = 0,0234    LCS = 0,0495"

Ahora, se muestra el cálculo anterior de manera manual, usando la ecuación 4.15

\[ \begin{align*} LCI & = D_{3}\,\bar{R} = 0 \left(0,0234 \right) = 0 \\ LC & = \bar{R} = 0,0234 \\ LCS & = D_{4}\,\bar{R} = 2,1145 \left(0,0234 \right) = 0,0495 \end{align*}. \]

El cálculo con de los límites de control del diagrama \(\bar{x}\) se muestra en el siguiente trozo de código.

Código

```{r}
#| label: lci-xbarra

n <- 5
A_2 <- 3 / (sqrt(n) * SixSigma::ss.cc.getd2(n))
lci <- media_est - A_2 * R_barra
lc <- media_est
lcs <- media_est + A_2 * R_barra
paste0("LCI = ", formato(lci), "    LC = ", formato(lc), "    LCS = ", formato(lcs))
```

#> [1] "LCI = 73,9901    LC = 74,0036    LCS = 74,0171"

El cálculo de manera manual, usando la ecuación 4.13, se muestra a continuación. Tomando \(A_{2} = 0,5768\), de la Tabla A.1 del Apéndice A.

\[ \begin{align*} LCI & = \bar{\bar{x}} - A_{2}\,\bar{R} = 74,0036 - 0,5768 \left(0,0234 \right) = 73,9901 \\ LC & = \bar{\bar{x}} = 74,0036 \\ LCS & = \bar{\bar{x}} + A_{2}\,\bar{R} = 74,0036 + 0,5768 \left(0,0234 \right) = 74,0171 \end{align*}. \]

En la Figura 4.2 se muestran los diagramas de control \(\bar{x}\) y \(R\) en la fase inicial para el diámetro interior (mm) de los anillos para pistones.

Código

```{r}
#| label: fig-dcxbarraR-fase1
#| fig-cap: "Diagramas $\\bar{x}$ y $R$ para el diámetro interior (mm) de los anillos en la fase inicial"
#| fig-subcap: 
#|   - "Diagrama $R$"
#|   - "Diagrama $\\bar{x}$"
#| layout-ncol: 2

ggplot(
  data = pistones[1:25, ], 
  aes(x = muestra, y = rango)
) +
  geom_step(
    mapping = aes(x = muestra, y = lci_R),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lc_R),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lcs_R),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(x = muestra, y = rango), color = "black"
  ) +
  geom_line(
    mapping = aes(x = muestra, y = rango), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci_R, ymax = lc_R), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc_R, ymax = lcs_R), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  annotate(
    "text", x = 25 + 0.9, y = lci_R, 
    label = latex2exp::TeX("$LCI$"),
    colour = "red",
    parse = TRUE
  ) +
  annotate(
    "text", x = 25 + 0.75, y = lc_R, 
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text", x = 25 + 0.9, y = lcs_R, 
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Muestra", bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "$R_i$", bold = TRUE, italic = TRUE
    )
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 25, by = 2),
    limits = c(1, 26)
  ) +
  theme_bw()

ggplot(
  data = pistones[1:25, ], 
  aes(x = muestra, y = media)
) +
  geom_step(
    mapping = aes(x = muestra, y = lci),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lc),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lcs),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(x = muestra, y = media), color = "black"
  ) +
  geom_line(
    mapping = aes(x = muestra, y = media), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci, ymax = lc), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc, ymax = lcs), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  annotate(
    "text", x = 25 + 0.9, y = lci, 
    label = latex2exp::TeX("$LCI$"),
    colour = "red",
    parse = TRUE
  ) +
  annotate(
    "text", x = 25 + 0.75, y = lc, 
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text", x = 25 + 0.9, y = lcs, 
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Muestra", bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "$\\bar{x}_i$", bold = TRUE, italic = TRUE
    )
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 25, by = 2),
    limits = c(1, 26)
  ) +
  theme_bw()
```

Como se nota en la Figura 4.2 todos los puntos están bajo control y no se observa un comportamiento sistemático en los datos, tanto en el diagrama \(R\) como en el diagrama \(\bar{x}\); por lo tanto se concluye que el proceso se encuentra bajo control tanto en su variabilidad como en su nivel medio. Y estos límites se usarán para controlar el nivel medio y la variabilidad del diámetro interior de los anillos para pistones en la fase II.

Las gráficas de los diagramas \(\bar{x}\) y \(R\) para los 15 muestras tomadas en la fase II se muestra con el siguiente bloque de código. Note que los límites de control en cada diagrama son los obtenidos en la fase I.

Código

```{r}
#| label: fig-dcxbarraR-fase2
#| fig-cap: "Diagramas $\\bar{x}$ y $R$ para el diámetro interior (mm) de los anillos en la fase II"
#| fig-subcap:
#|   - "Diagrama $R$"
#|   - "Diagrama $\\bar{x}$"
#| layout-ncol: 2

# diagrama R en la fase II
ggplot(
  data = pistones,
  aes(x = muestra, y = rango)
) +
  geom_step(
    mapping = aes(x = muestra, y = lci_R),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lc_R),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lcs_R),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(x = muestra, y = rango), 
    color = "black", size = 2
  ) +
  geom_line(
    mapping = aes(x = muestra, y = rango), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci_R, ymax = lc_R),
    fill = "green",
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc_R, ymax = lcs_R),
    fill = "green",
    alpha = 0.2, direction = "hv"
  ) +
  geom_vline(
    xintercept = (25 + 26) / 2, linetype = 2, color = "blue"
  ) +
  annotate(
    "text",
    x = 40 + 0.9, y = lci_R,
    label = latex2exp::TeX("$LCI$"),
    colour = "red",
    parse = TRUE
  ) +
  annotate(
    "text",
    x = 40 + 0.75, y = lc_R,
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text",
    x = 40 + 0.9, y = lcs_R,
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Muestra",
      bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "$R_i$",
      bold = TRUE, italic = TRUE
    )
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 40, by = 3),
    limits = c(1, 41)
  ) +
  theme_bw()

# diagrama xbarra en la fase II
violacion <- qcc(
  pistones[1:25, 3:7],
  type = "xbar", newdata = pistones[26:40, 3:7],
  plot = FALSE
)
violacion <- purrr::as_vector(violacion$violations)
pistones$violacion <- ifelse(
  pistones$muestra %in% violacion, "Si", "No"
)
ggplot(
  data = pistones,
  aes(x = muestra, y = media)
) +
  geom_step(
    mapping = aes(x = muestra, y = lci),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lc),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lcs),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(
      x = muestra, y = media, color = factor(violacion),
      shape = factor(violacion)
    ),
    size = 2
  ) +
  scale_color_manual(
    values = c("No" = "black", "Si" = "red", show.legend = FALSE)
  ) +
  scale_shape_manual(values = c(16, 8)) +
  geom_line(
    mapping = aes(x = muestra, y = media), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci, ymax = lc),
    fill = "green",
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc, ymax = lcs),
    fill = "green",
    alpha = 0.2, direction = "hv"
  ) +
  geom_vline(
    xintercept = (25 + 26) / 2, linetype = 2, color = "blue"
  ) +
  annotate(
    "text",
    x = 40 + 0.9, y = lci,
    label = latex2exp::TeX("$LCI$"),
    colour = "red",
    parse = TRUE
  ) +
  annotate(
    "text",
    x = 40 + 0.75, y = lc,
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text",
    x = 40 + 0.9, y = lcs,
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Muestra",
      bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "$\\bar{x}_i$",
      bold = TRUE, italic = TRUE
    ),
    shape = "Violación", color = "Violación"
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 40, by = 3),
    limits = c(1, 41)
  ) +
  theme_bw() +
  theme(
    legend.position = "bottom",
    legend.text = element_text(face = "bold"),
    legend.title = element_text(face = "bold"),
    legend.title.position = "top"
  ) 
```

Como se puede notar en la Figura 4.3, el diagrama \(R\) muestra que la variabilidad del proceso se mantiene bajo control en la fase II, mientras que el diagrama \(\bar{x}\) indica que ha ocurrido un cambio hacia arriba en la media del proceso.

A continuación se muestran los diagramas \(\bar{x}\) y \(R\) en las fases 1 y 2 con el paquete qcc.

Código

```{r}
#| label: fig-dcxbarraR-fase1y2-qcc
#| fig-cap: "Diagramas $\\bar{x}$ y $R$ para el diámetro interior (mm) de los anillos en las fases 1 y 2 con el paquete `qcc`"
#| fig-subcap:
#|   - "Diagrama $R$ inicial"
#|   - "Diagrama $\\bar{x}$ inicial"
#|   - "Diagrama $R$ estándar"
#|   - "Diagrama $\\bar{x}$ estándar"
#| layout-ncol: 2

diameter <- with(pistonrings, qcc.groups(diameter, sample))
# Diagrama R en la fase I
R <- qcc(
  diameter[1:25, ],
  type = "R", plot = FALSE
)
plot(
  R,
  add.stats = FALSE, label.limits = c("LCI", "LCS"), title = "",
  xlab = "Muestra", ylab = "Rango", chart.all = TRUE
)

# Diagrama xbarra en la fase I
xbarra <- qcc(
  diameter[1:25, ],
  type = "xbar", plot = FALSE
)
plot(
  xbarra,
  add.stats = FALSE, label.limits = c("LCI", "LCS"), title = "",
  xlab = "Muestra", ylab = "Medias", chart.all = TRUE
)

# Diagrama R en la fase II
R <- qcc(
  diameter[1:25, ],
  type = "R", newdata = diameter[26:40, ], plot = FALSE
)
plot(
  R,
  add.stats = FALSE, label.limits = c("LCI", "LCS"), title = "",
  xlab = "Muestra", ylab = "Rango", chart.all = TRUE
)

# Diagrama xbarra en la fase II
xbarra <- qcc(
  diameter[1:25, ],
  type = "xbar", newdata = diameter[26:40, ], plot = FALSE
)
plot(
  xbarra,
  add.stats = FALSE, label.limits = c("LCI", "LCS"), title = "",
  xlab = "Muestra", ylab = "Medias", chart.all = TRUE
)
```

Con el siguiente bloque de código se muestran los diagramas \(\bar{x}\) y \(R\) en las fases 1 y 2 con el paquete highcharter.

Código

```{r}
#| label: fig-Rinicial-highcharter
#| fig-cap: "Diagramas $R$ para el diámetro interior (mm) de los anillos en la fase I"

highchart() |>
  hc_add_series(
    data = pistones[1:25, ], 
    hcaes(x = muestra, low = lc_R, high = lcs_R),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones[1:25, ], 
    hcaes(x = muestra, low = lci_R, high = lc_R),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    pistones[1:25, ], 
    type = "line", hcaes(x = muestra, y = lcs_R), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones[1:25, ],
    type = "line", hcaes(x = muestra, y = lc_R), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones[1:25, ], 
    type = "line", hcaes(x = muestra, y = lci_R), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones[1:25, ],
    type = "line", color = "black",
    hcaes(x = muestra, y = rango),
    marker = list(radius = 3, fillColor = "blue"),useHTML = TRUE, 
    name = "<b><i>R<sub>i</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Rango (R<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```
```{r}
#| label: fig-xbarra-inicial-highcharter
#| fig-cap: "Diagramas $\\bar{x}$ para el diámetro interior (mm) de los anillos en la fase I"

highchart() |>
  hc_add_series(
    data = pistones[1:25, ], 
    hcaes(x = muestra, low = lc, high = lcs),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones[1:25, ], 
    hcaes(x = muestra, low = lci, high = lc),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    pistones[1:25, ], 
    type = "line", hcaes(x = muestra, y = lcs), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones[1:25, ],
    type = "line", hcaes(x = muestra, y = lc), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones[1:25, ], 
    type = "line", hcaes(x = muestra, y = lci), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones[1:25, ],
    type = "line", color = "black", hcaes(x = muestra, y = media),
    marker = list(radius = 3, fillColor = "blue"),  
    useHTML = TRUE, 
    name = "<b><i>Media</i></b>", dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Media</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```
```{r}
#| label: fig-Restandar-highcharter
#| fig-cap: "Diagramas $R$ para el diámetro interior (mm) de los anillos en la fase II"

highchart() |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lc_R, high = lcs_R),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lci_R, high = lc_R),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    type = "line", hcaes(x = muestra, y = lcs_R), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = pistones,
    type = "line", hcaes(x = muestra, y = lc_R), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = pistones, 
    type = "line", hcaes(x = muestra, y = lci_R), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = pistones,
    type = "line", color = "black",
    hcaes(x = muestra, y = rango),
    marker = list(
      radius = 3, fillColor = "blue", symbol = "circle"
    ),
    useHTML = TRUE, 
    name = "<b><i>R<sub>i</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    ),
    plotLines = list(
      list(
        color = "grey", value = 25.5, width = 2, 
        dashStyle = "Dash"
      )
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Rango (R<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```
```{r}
#| label: fig-xbarra-estandar-highcharter
#| fig-cap: "Diagramas $\\bar{x}$ para el diámetro interior (mm) de los anillos en la fase II"

color <- ifelse(pistones$violacion == "Si", "#FF0000", "#0000FF")
symbol <- ifelse(
  pistones$violacion == "Si", "triangle-down", "triangle"
)

highchart() |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lc, high = lcs),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lci, high = lc),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    type = "line", hcaes(x = muestra, y = lcs), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = pistones,
    type = "line", hcaes(x = muestra, y = lc), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = pistones, 
    type = "line", hcaes(x = muestra, y = lci), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = pistones,
    type = "line", color = "black", 
    hcaes(x = muestra, y = media, color = color),
    marker = list(
      enabled = TRUE, radius = 3 
    ),  
    useHTML = TRUE, 
    name = "<b><i>Media</i></b>", dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    ),
    plotLines = list(
      list(
        color = "grey", value = 25.5, width = 2, 
        dashStyle = "Dash"
      )
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Media</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```

Figura 4.5: Diagramas \(R\) para el diámetro interior (mm) de los anillos en la fase I

Figura 4.6: Diagramas \(\bar{x}\) para el diámetro interior (mm) de los anillos en la fase I

Figura 4.7: Diagramas \(R\) para el diámetro interior (mm) de los anillos en la fase II

Figura 4.8: Diagramas \(\bar{x}\) para el diámetro interior (mm) de los anillos en la fase II

Con el siguiente bloque de código se muestran los diagramas \(\bar{x}\) y \(R\) en las fases 1 y 2 con el paquete plotly.

Código

```{r}
#| label: fig-Rinicial-plotly
#| fig-cap: "Diagramas $R$ para el diámetro interior (mm) de los anillos en la fase I"

pistones[1:25, ] %>%
  plot_ly(x = ~muestra) %>%
  add_lines(
    y = lcs_R, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) %>%
  add_lines(
    y = lc_R, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) %>%
  add_lines(
    y = lci_R, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) %>%
  add_trace(
    y = ~rango,
    name = "<b><i>R<sub>i</sub><b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = "black"),
    hovertemplate = paste(
      "<b><i>n<sub>i</sub> = %{x}</i></b>",
      "<br><b><i>R<sub>i</sub><b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) %>%
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Rango (R<sub>i</sub>)</i></b><br>",
      zeroline = FALSE
    )
  ) %>%
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```
```{r}
#| label: fig-xbarra-inicial-plotly
#| fig-cap: "Diagramas $\\bar{x}$ para el diámetro interior (mm) de los anillos en la fase I"

pistones[1:25, ] %>%
  plot_ly(x = ~muestra) %>%
  add_lines(
    y = lcs, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) %>%
  add_lines(
    y = lc, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) %>%
  add_lines(
    y = lci, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) %>%
  add_trace(
    y = ~media,
    name = "<b><i>Media<b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = "black"),
    hovertemplate = paste(
      "<b><i>n<sub>i</sub> = %{x}</i></b>",
      "<br><b><i>Media<b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) %>%
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Media</i></b><br>",
      zeroline = FALSE
    )
  ) %>%
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```
```{r}
#| label: fig-Restandar-plotly
#| fig-cap: "Diagramas $R$ para el diámetro interior (mm) de los anillos en la fase II"

pistones %>%
  plot_ly(x = ~muestra) %>%
  add_lines(
    y = lcs_R, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) %>%
  add_lines(
    y = lc_R, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) %>%
  add_lines(
    y = lci_R, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) %>%
  add_trace(
    y = ~rango,
    name = "<b><i>R<sub>i</sub><b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = "black"),
    hovertemplate = paste(
      "<b><i>n<sub>i</sub> = %{x}</i></b>",
      "<br><b><i>R<sub>i</sub><b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) %>%
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Rango (R<sub>i</sub>)</i></b><br>",
      zeroline = FALSE
    )
  ) %>%
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```
```{r}
#| label: fig-xbarra-estandar-plotly
#| fig-cap: "Diagramas $\\bar{x}$ para el diámetro interior (mm) de los anillos en la fase II"


pistones %>%
  plot_ly(x = ~muestra) %>%
  add_lines(
    y = lcs, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) %>%
  add_lines(
    y = lc, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) %>%
  add_lines(
    y = lci, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) %>%
  add_trace(
    y = ~media,
    name = "<b><i>Media<b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = color, symbol = symbol),
    hovertemplate = paste(
      "<b><i>n<sub>i</sub> = %{x}</i></b>",
      "<br><b><i>Media<b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) %>%
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Media</i></b><br>",
      zeroline = FALSE
    )
  ) %>%
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```

Figura 4.9: Diagramas \(R\) para el diámetro interior (mm) de los anillos en la fase I

Figura 4.10: Diagramas \(\bar{x}\) para el diámetro interior (mm) de los anillos en la fase I

Figura 4.11: Diagramas \(R\) para el diámetro interior (mm) de los anillos en la fase II

Figura 4.12: Diagramas \(\bar{x}\) para el diámetro interior (mm) de los anillos en la fase II

4.2 Diagramas de Control \(\bar{x}\) y \(S\)

Al igual que los diagramas \(\bar{x}\) y \(R\), los diagramas \(\bar{x}\) y \(S\) se usan para monitorear el nivel medio y la variabilidad de una característica de la calidad, respectivamente. Solo que en este caso la variabilidad es monitoreada a través de la desviación estándar muestral, lo cual tiene consecuencias en la forma como se estima la desviación estándar del proceso. Supóngase que se cuenta con una muestra de tamaño \(n\) de una característica de la calidad, es decir; \(x_1\), \(x_2\), \(\dots\), \(x_n\). Entonces la desviación estándar de la muestra viene dado por

\[ s = \sqrt{\frac{\sum_{i=1}^{n} \left(x_i - \bar{x} \right)^2}{n - 1}}, \;i=1, 2, \dots, n. \]

La forma como se construyen los límites de control y la línea central del par de diagramas \(\bar{x}\) y \(S\) va a depender si se cuentan o no con los parámetros de la característica de la calidad que se está monitoreando, en este caso la media y la desviación estándar. Cuando se tiene información acerca de estos parámetros los diagramas se conocen como diagramas de control estándar, mientras que cuando son desconocidos estos se conocen como diagramas de control inicial.

4.2.1 Diagramas de Control \(\bar{x}\) y \(S\) Estándar

Supóngase que se tiene un proceso de producción en el cual se inspecciona una característica de la calidad la cual se distribuye normalmente con media \(\mu\) y desviación estándar \(\sigma\) conocidas y que se toman \(m\) muestras de tamaño \(n\) del proceso para controlar la producción. Sea \(x_{ij}\) la observación \(j\) en la muestra \(i\), con \(i = 1, 2, \dots, m\) y \(j = 1, 2, \dots, n\). Suponiendo que la característica de la calidad se distribuye normalmente, se procede a construir los límites de control y la línea central del par de diagramas \(\bar{x}\) y \(S\), usando el enfoque de Shewhart.

4.2.1.1 Diagramas de Control \(\bar{x}\) Estándar

Las ecuaciones para construir los límites de control y la línea central de este diagrama son las mismas que se establecen en la ecuación 4.5.

4.2.1.2 Diagramas de Control \(S\) Estándar

El estadístico que se grafica en este diagrama es la desviación estándar de cada muestra \(S_i\), la cual viene dada por

Desviación estándar muestral \(S_i\)

\[ S_{i} = \sqrt{\frac{\sum_{j = 1}^{n} \left(X_{ij} - \bar{X_{i}} \right)^2}{n - 1}}, \; i = 1, 2, \dots, m. \tag{4.16}\]

Donde, \(X_{ij}\) es la observación \(j\) en la muestra \(i\) y \(\bar{X_{i}}\) es la media de la muestra \(i\).

Bajo el supuesto de que la característica de la calidad que se monitorea es normal, se sabe que el estadístico

\[ \frac{\left ( n - 1 \right )S_{i}^{2}}{\sigma^{2}}\sim \chi_{n -1}^{2} \,. \tag{4.17}\]

En consecuencia, se puede demostrar que

Media y desviación estándar de \(S_i\)

\[ \begin{align*} \mu_{S_{i}} & = c_4 \, \sigma\\ \sigma_{S_{i}} & = \sqrt{1 - c_{4}^{2}}\,\sigma \end{align*}. \tag{4.18}\]

Donde,

\[ c_{4} = \sqrt{\frac{2}{n - 1}}\, \frac {\Gamma \left ( \frac{n}{2} \right )}{\Gamma \left ( \frac{n - 1}{2} \right )}\,. \tag{4.19}\]

y se encuentra tabulado para diferentes valores de \(n\) en la Tabla A.1 del Apéndice A.

Los límites de control y la línea central, según el enfoque de Shewhart, para el diagrama \(S\) estándar viene dado por:

\[ \begin{align*} LCS & = \mu_{S_{i}} + 3\,\sigma_{S_{i}} = c_{4}\,\sigma + 3\,\sqrt{1 - c_{4}^{2}}\,\sigma = \left (c_{4} + 3\,\sqrt{1 - c_{4}^{2}} \right )\sigma \\ LC & = \mu_{S_{i}} = c_{4}\,\sigma\\ LCI & = \mu_{S_{i}} - 3\,\sigma_{S_{i}} = c_{4}\,\sigma - 3\,\sqrt{1 - c_{4}^{2}}\,\sigma = \left (c_{4} - 3\,\sqrt{1 - c_{4}^{2}} \right )\sigma \end{align*}. \tag{4.20}\]

Haciendo \(\left (c_{4} + 3\,\sqrt{1 - c_{4}^{2}} \right )\) y \(\left (c_{4} - 3\,\sqrt{1 - c_{4}^{2}} \right )\) iguales a \(B_6\) y \(B_5\), respectivamente, la ecuación anterior se puede reescribir de la siguiente manera

Limites de control estándar del diagrama \(S\)

\[ \begin{align*} LCS & = B_{6}\,\sigma \\ LC & = c_{4}\,\sigma\\ LCI & = B_{5}\,\sigma \end{align*}. \tag{4.21}\]

Los factores \(B_6\) y \(B_5\) se encuentran tabuladas en la Tabla A.1 del Apéndice A.

4.2.2 Diagramas de Control \(\bar{x}\) y \(S\) Inicial

En la práctica generalmente se desconoce la media y la desviación estándar del proceso, por lo que hay que estimarla con los datos observados (muestras). El procedimiento para estimar \(\mu\) y \(\sigma\) se conoce como fase I o fase inicial y los diagramas obtenidos en esta fase se llaman diagramas de control inicial. El procedimiento consiste en tomar \(n\) muestras o subgrupos preliminares cuando se considera que el proceso está bajo control. En general, estas estimaciones deberían basarse en al menos 20 o 25 metras (\(m \geq 20\)). Cada una de las cuales debe contener \(n\) observaciones de la característica de la calidad. De manera típica, \(n\) será pequeña, con frecuencia 4, 5 o 6. Estos tamaños pequeños de muestras suelen resultar de la construcción de subgrupos racionales y del hecho de que los costos de muestreo e inspección asociados con la medición de la variable por lo general son relativamente altos. Sea \(\bar{x}_i\) la media de la muestra \(i\), con \(i=1, 2, \dots, m\).

Entonces, se toma como estimador de \(\mu\), el valor medio del proceso, el promedio de las medias muestrales \(\bar{x}_i\), la cual viene dada por ecuación 4.10.

Mientras que, como estimador de \(\sigma\), se usa el siguiente estimador insesgado,

Estimador de \(\sigma\) basado en \(\bar{S}\)

\[ \hat{\sigma}=\frac{\bar{S}}{c_{4}}. \tag{4.22}\]

Donde, \(\bar{S}\) es la media de los \(S_i\), es decir,

Media de los \(S_i\)

\[ \bar{S} = \frac{\sum_{i=1}^{m}S_i}{m} . \tag{4.23}\]

Sustituyendo la ecuación 4.22 en la ecuación 4.23, se obtiene la siguiente expresión equivalente para \(\hat{\sigma}\),

Estimación de \(\sigma\) basado en \(S_i\)

\[ \hat{\sigma}=\frac{\sum_{i=1}^{m}S_i}{m\,c_{4}},\, i=1, 2, \dots, m. \tag{4.24}\]

4.2.2.1 Diagrama de Control \(\bar{x}\) Inicial

En base a los supuestos descritos anteriormente los límites de control del diagrama \(\bar{x}\) inicial se consiguen sustituyendo en la ecuación 4.4 \(\mu\) y \(\sigma\) por sus respectivos estimadores, dados en las ecuaciones 4.10 y 4.22. Es decir,

\[ \begin{align*} LCS & = \bar{\bar{x}} + \frac{3}{\sqrt{n}}\frac{\bar{S}}{c_{4}}\\ LC & = \bar{\bar{x}} \\ LCI & = \bar{\bar{x}} - \frac{3}{\sqrt{n}}\frac{\bar{S}}{c_{4}} \end{align*}. \tag{4.25}\]

Sustituyendo \(3/\sqrt{n}\,c_{4}\) por \(A_{3}\) en la expresión anterior, los limites anteriores se pueden expresar de la siguiente manera

Limites de control inicial del diagrama \(\bar{x}\)

\[ \begin{align*} LCS & = \bar{\bar{x}} + A_{3}\bar{S}\\ LC & = \bar{\bar{x}} \\ LCI & = \bar{\bar{x}} - A_{3}\bar{S} \end{align*}. \tag{4.26}\]

La constante \(A_3\) se encuentra tabulada para diferentes valores de \(n\) en la Tabla A.1 del Apéndice A.

4.2.2.2 Diagrama de Control \(S\) Inicial

Los límites de control tipo Shewhart para este diagrama se obtienen sustituyendo en la ecuación 4.20 \(\sigma\) por su estimador, basado en las desviaciones estándares muestrales, dado en la ecuación 4.22. Es decir,

\[ \begin{align*} LCS & = c_{4} \frac{\bar{S}}{c_{4}} + 3\,\sqrt{1 - c_{4}^{2}}\,\frac{\bar{S}}{c_{4}} = \left ( 1 + \frac{3\sqrt{1 - c_{4}^{2}}}{c_{4}} \right )\bar{S}\\ LC & = c_{4} \frac{\bar{S}}{c_{4}} = \bar{S}\\ LCI & = c_{4} \frac{\bar{S}}{c_{4}} - 3\,\sqrt{1 - c_{4}^{2}}\,\frac{\bar{S}}{c_{4}} = \left ( 1 - \frac{3\sqrt{1 - c_{4}^{2}}}{c_{4}} \right )\bar{S} \end{align*}. \tag{4.27}\]

Sustituyendo en la ecuación anterior \(\left ( 1 + 3\sqrt{1 - c_{4}^{2}}\,/\,c_{4} \right )\) y \(\left ( 1 - 3\sqrt{1 - c_{4}^{2}}\,/\,c_{4} \right )\) por \(B_4\) y \(B_3\), respectivamente, los límites anteriores se pueden expresar de la siguiente manera

Limites de control inicial del diagrama \(S\)

\[ \begin{align*} LCS & = B_{4}\,\bar{S} \\ LC & = \bar{S}\\ LCI & = B_{3}\,\bar{S} \end{align*}. \tag{4.28}\]

Los factores \(B_4\) y \(B_3\) se encuentra tabulada para diferentes valores de \(n\) en la Tabla A.1 del Apéndice A.

Como se puede notar de la ecuación 4.19, \(c_4\) depende de la función gamma \(\Gamma \left (\cdot \right)\), mientras que los factores \(A_3\), \(B_3\), \(B_4\), \(B_5\) y \(B_6\), como se observa en las ecuaciones 4.26, 4.28 y 4.21 son funciones de \(c_4\). En el siguiente bloque de código se muestra como calcular estos factores con .

Código

```{r}
#| label: tbl-factores-xbarraS
#| tbl-cap:  "Factores para construir diagramas de control $\\bar{x} - \\bar{S}$"
#| class: output

factores_xbrraS <- data.table::data.table(
  check.names = FALSE,
  n = c(
    2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L,
    12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L,
    24L, 25L
  )
) |> 
  dplyr::mutate(
    A = 3 / sqrt(n),
    c4 = sqrt(2 / (n - 1)) * (gamma(n / 2) / gamma((n - 1) / 2)),
    A3 = 3 / (sqrt(n) * c4),
    `1/c4` = 1 / c4,
    B3 = if_else(
      1 - 3 * (sqrt(1 - c4^2) / c4) < 0, 
      0,
      1 - 3 * (sqrt(1 - c4^2) / c4)
    ),
    B4 = 1 + 3 * (sqrt(1 - c4^2) / c4),
    B5 = if_else(
      c4 - 3 * sqrt(1 - c4^2) < 0,
      0,
      c4 - 3 * sqrt(1 - c4^2)
    ),
    B6 = c4 + 3 * sqrt(1 - c4^2)
  ) |> 
  dplyr::relocate(c4, .after = A3) |> 
  data.table::as.data.table()

knitr::kable(
  factores_xbrraS,
  format = "markdown",
  col.names = c(
  "$n$", "$A$", "$A_3$", "$c_4$", "$1/c_4$", "$B_3$", "$B_4$",
  "$B_5$", "$B_6$"
  ), 
  digits = 4,
  format.args = list(decimal.mark = ",", big.mark = "."), 
  escape = FALSE
)
```

Tabla 4.3: Factores para construir diagramas de control \(\bar{x} - \bar{S}\)

\(n\)	\(A\)	\(A_3\)	\(c_4\)	\(1/c_4\)	\(B_3\)	\(B_4\)	\(B_5\)	\(B_6\)
2	2,1213	2,6587	0,7979	1,2533	0,0000	3,2665	0,0000	2,6063
3	1,7321	1,9544	0,8862	1,1284	0,0000	2,5682	0,0000	2,2760
4	1,5000	1,6281	0,9213	1,0854	0,0000	2,2660	0,0000	2,0877
5	1,3416	1,4273	0,9400	1,0638	0,0000	2,0890	0,0000	1,9636
6	1,2247	1,2871	0,9515	1,0509	0,0304	1,9696	0,0289	1,8742
7	1,1339	1,1819	0,9594	1,0424	0,1177	1,8823	0,1129	1,8058
8	1,0607	1,0991	0,9650	1,0362	0,1851	1,8149	0,1786	1,7514
9	1,0000	1,0317	0,9693	1,0317	0,2391	1,7609	0,2318	1,7068
10	0,9487	0,9754	0,9727	1,0281	0,2837	1,7163	0,2759	1,6694
11	0,9045	0,9274	0,9754	1,0253	0,3213	1,6787	0,3134	1,6373
12	0,8660	0,8859	0,9776	1,0230	0,3535	1,6465	0,3456	1,6095
13	0,8321	0,8495	0,9794	1,0210	0,3816	1,6184	0,3737	1,5851
14	0,8018	0,8173	0,9810	1,0194	0,4062	1,5938	0,3985	1,5634
15	0,7746	0,7885	0,9823	1,0180	0,4282	1,5718	0,4206	1,5440
16	0,7500	0,7626	0,9835	1,0168	0,4479	1,5521	0,4405	1,5265
17	0,7276	0,7391	0,9845	1,0157	0,4657	1,5343	0,4585	1,5106
18	0,7071	0,7176	0,9854	1,0148	0,4818	1,5182	0,4748	1,4960
19	0,6882	0,6979	0,9862	1,0140	0,4966	1,5034	0,4898	1,4826
20	0,6708	0,6797	0,9869	1,0132	0,5102	1,4898	0,5036	1,4703
21	0,6547	0,6629	0,9876	1,0126	0,5228	1,4772	0,5163	1,4589
22	0,6396	0,6473	0,9882	1,0120	0,5344	1,4656	0,5281	1,4483
23	0,6255	0,6327	0,9887	1,0114	0,5452	1,4548	0,5391	1,4383
24	0,6124	0,6191	0,9892	1,0109	0,5553	1,4447	0,5493	1,4291
25	0,6000	0,6063	0,9896	1,0105	0,5648	1,4352	0,5589	1,4203

4.2.3 Pasos para la Aplicación de los Diagramas de Control \(\bar{x}\) y \(S\) en la Fase I

La aplicación de los diagramas de control \(\bar{x}\) y \(S\) en el monitoreo del nivel medio y la desviación estándar de una característica de la calidad en un proceso de producción en la fase I se puede esquematizar en los siguientes pasos:

Tomar \(m\) muestras de tamaño \(n\) de la característica de la calidad que se está monitoreando. Se recomienda que \(m \geq 20\) y valores típicos de \(n\) (\(3 \leq n \geq 6\)).
Determinar las medias y desviaciones estándares para cada muestra a través de las ecuaciones 4.1 y 4.16, respectivamente. Los pasos 1 y 2 se pueden resumir en la siguiente tabla.

Tabla 4.4: Resumen de las \(m\) muestras preliminares en el diagrama \(\bar{x}\) y \(S\)

Muestra	\(X_1\)	\(X_2\)	\(\cdots\)	\(X_j\)	\(\cdots\)	\(X_{n-1}\)	\(X_n\)	\(\bar{X}_i\)	\(S_i\)
1	\(x_{11}\)	\(x_{12}\)	\(\cdots\)	\(x_{1j}\)	\(\cdots\)	\(x_{1(n-1)}\)	\(x_{1n}\)	\(\bar{x}_1\)	\(s_1\)
2	\(x_{21}\)	\(x_{22}\)	\(\cdots\)	\(x_{2j}\)	\(\cdots\)	\(x_{2(n-1)}\)	\(x_{2n}\)	\(\bar{x}_2\)	\(s_2\)
\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)
\(i\)	\(x_{i1}\)	\(x_{i2}\)	\(\cdots\)	\(x_{ij}\)	\(\cdots\)	\(x_{i(n-1)}\)	\(x_{in}\)	\(\bar{x}_i\)	\(s_i\)
\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)	\(\vdots\)
\(m-1\)	\(x_{(m-1)1}\)	\(x_{(m-1)2}\)	\(\cdots\)	\(x_{(m-1)j}\)	\(\cdots\)	\(x_{(m-1)(n-1)}\)	\(x_{(m-1)n}\)	\(\bar{x}_{m-1}\)	\(s_{m-1}\)
\(m\)	\(x_{m1}\)	\(x_{m2}\)	\(\cdots\)	\(x_{mj}\)	\(\cdots\)	\(x_{m(n-1)}\)	\(x_{mn}\)	\(\bar{x}_{m}\)	\(s_{m}\)

Estimar la media y la desviación estándar del proceso por medio de la ecuación 4.10 y la ecuación 4.22, respectivamente.
Con las estimaciones de \(\mu\) y \(\sigma\) del paso anterior determinar los límites de control inicial de los diagramas \(\bar{x}\) y \(S\) usando la ecuación 4.26 y la ecuación 4.28. Estos límites son considerados de prueba o preliminares.
Realizar las representaciones gráficas de los diagramas \(\bar{x}\) y \(S\).
Analizar el diagrama \(S\), debido a que la variabilidad de la característica de la calidad debe controlarse primero, y muchas veces controlando la variabilidad se consigue controlar el nivel medio. Si todos los puntos se ubican dentro de los límites de control en este diagrama y no se observa un patrón sistemático se pasa al paso 7. Si uno o más puntos se localizan fuera de los límites control en este diagrama, y suponiendo que estos tienen su causa atribuible, se eliminan del análisis y se reinicia el procedimiento a partir del paso 3. Este siclo se repite hasta que todos los puntos se ubique dentro de los límites de control en el diagrama \(S\). La justificación para eliminar un punto del análisis es que este punto tenga una causa atribuible, de lo contrario no existe un argumento racional para eliminarlo del análisis y en tal caso queda a criterio del investigador incluirlo o excluirlo del análisis.
Analizar el diagrama \(\bar{x}\), si todos los puntos se localizan dentro de los límites de control y no se observa un patrón en los datos se concluye que el proceso está bajo control estadístico tanto en media como en varianza y estos límites de control pueden ser usados para controlar la producción futura, además estas estimaciones de \(\mu\) y \(\sigma\) pude ser usada para estimar la capacidad del proceso. De lo contrario, si uno o más puntos se localizan fuera de los límites de control en este diagrama estos se eliminan del análisis y se reinicia el procedimiento a partir del paso 3.

Ejemplo 4.2 (Aplicación de los Diagramas de Control \(\bar{x}\) y \(S\))
En este ejemplo se usarán los diagramas de control \(\bar{x}\) y \(S\) para controlar el diámetro interior (mm) de los anillos fabricados con el proceso de fundición descritos en el ejemplo 4.1.

Código

```{r}
#| label: tbl-datos-pistones-xbararS
#| tbl-cap:  "Mediciones del diámetro interior (mm) de anillos para pistones"

data(package = "qcc", "pistonrings")
pistones <- with(
  data = pistonrings, qcc::qcc.groups(data = diameter, sample = sample)
) |>
  data.table::as.data.table() |>
  dplyr::mutate(
    muestra = 1:40,
    trial = rep(c(TRUE, FALSE), times = c(25, 15)),
  ) |>
  dplyr::rowwise() |>
  dplyr::mutate(
    media = mean(c_across(V1:V5)),
    desviacion = sqrt(var(c_across(V1:V5)))
  ) |>
  dplyr::rename(
    X_1 = V1, X_2 = V2, X_3 = V3, X_4 = V4, X_5 = V5,
    fase_1 = trial
  ) |>
  dplyr::relocate(
    c(muestra, fase_1),
    .before = X_1
  ) |>
  data.table::as.data.table()

options(
  reactable.language = reactableLang(
    searchPlaceholder = "Search...",
    pageNext = "Siguiente",
    pagePrevious = "Anterior",
    noData = "No entries found",
    pageInfo = "{rowStart} de {rowEnd} de {rows} filas"
  )
)

reactable::reactable(
  pistones,
  # defaultColDef = colDef(
  #   headerStyle = list(background = "#f7f7f8")
  # ),
  columns = list(
    muestra = colDef(header = "Muestra", align = "right"),
    fase_1 = colDef(header = "Fase I", align = "right"),
    X_1 = colDef(
      header = "\\( x_{i1} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    X_2 = colDef(
      header = "\\( x_{i2} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    X_3 = colDef(
      header = "\\( x_{i3} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    X_4 = colDef(
      header = "\\( x_{i4} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    X_5 = colDef(
      header = "\\( x_{i5} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    media = colDef(
      header = "\\( \\bar{x}_{i} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 4, locales = "es-ES"
      )
    ),
    desviacion = colDef(
      header = "\\( S_{i} \\)r", align = "right",
      format = colFormat(
        separators = TRUE, digits = 4, locales = "es-ES"
      )
    )
  ),
  striped = TRUE,
  bordered = TRUE,
  highlight = TRUE,
  filterable = TRUE
) 
```

Tabla 4.5: Mediciones del diámetro interior (mm) de anillos para pistones

Dado que el tamaño de la muestra es \(n = 5\), la Tabla A.1 del Apéndice A muestra que el valor de los factores \(B_3 = 0\) y \(B_4 = 2,089\). Por lo que los límites de control inicial y la línea central del diagrama \(S\) calculados con se muestran con el siguiente bloque de código.

Código

```{r}
#| label: lci-Sbarra

n <- 5
B_3 <- ifelse(
  1 - 3 * sqrt(1 - SixSigma::ss.cc.getc4(n)^2) / SixSigma::ss.cc.getc4(n) < 0, 0,
  1 - 3 * sqrt(1 - SixSigma::ss.cc.getc4(n)^2) / SixSigma::ss.cc.getc4(n)
)
B_4 <- 1 + 3 * sqrt(1 - SixSigma::ss.cc.getc4(n)^2) / SixSigma::ss.cc.getc4(n)
m <- pistones |>
  nrow()
media_est <- pistones |>
  pull(media) |>
  mean()
S_barra <- pistones |>
  pull(desviacion) |>
  mean()

lci_S <- B_3 * S_barra
lc_S <- S_barra
lcs_S <- B_4 * S_barra
paste0("LCI = ", formato(lci_S), "    LC = ", formato(lc_S), "    LCS = ", formato(lcs_S))
```

#> [1] "LCI = 0    LC = 0,0094    LCS = 0,0197"

El cálculo manual de los límites de control del diagrama \(S\), usando la ecuación 4.28, se muestra a continuación.

\[ \begin{align*} LCI & = B_{3}\,\bar{S} = 0 \left(0,0094 \right) = 0 \\ LC & = \bar{S} = 0,0094 \\ LCS & = B_{4}\,\bar{S} = 2,089 \left(0,0094 \right) = 0,0197 \end{align*}. \]

El cálculo con de los límites de control del diagrama \(\bar{x}\) se muestra en el siguiente trozo de código.

Código

```{r}
#| label: lci-xbarra2

A_3 <- 3 / (sqrt(n) * SixSigma::ss.cc.getc4(n))
lci <- media_est - A_3 * S_barra
lc <-  media_est
lcs <- media_est + A_3 * S_barra
paste0("LCI = ", formato(lci), "    LC = ", formato(lc), "    LCS = ", formato(lcs))
```

#> [1] "LCI = 73,9901    LC = 74,0036    LCS = 74,0171"

El cálculo de manera manual, usando la ecuación 4.26, se muestra a continuación. Tomando \(A_{3} = 1,4273\), de la Tabla A.1 del Apéndice A.

\[ \begin{align*} LCI & = \bar{\bar{x}} - A_{3}\,\bar{S} = 74,0036 - 1,4273 \left(0,0094 \right) = 73,9901 \\ LC & = \bar{\bar{x}} = 74,0036 \\ LCS & = \bar{\bar{x}} + A_{3}\,\bar{S} = 74,0036 + 1,4273 \left(0,0094 \right) = 74,0171 \end{align*}. \]

En la Figura 4.13 se muestran los diagramas de control \(\bar{x}\) y \(S\) en la fase inicial para el diámetro interior (mm) de los anillos para pistones.

Código

```{r}
#| label: fig-dcxbarraS-fase1
#| fig-cap: "Diagramas $\\bar{x}$ y $S$ para el diámetro interior (mm) de los anillos en la fase inicial"
#| fig-subcap: 
#|   - "Diagrama $S$"
#|   - "Diagrama $\\bar{x}$"
#| layout-ncol: 2

ggplot(
  data = pistones[1:25, ], 
  aes(x = muestra, y = desviacion)
) +
  geom_step(
    mapping = aes(x = muestra, y = lci_S),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lc_S),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lcs_S),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(x = muestra, y = desviacion), color = "black"
  ) +
  geom_line(
    mapping = aes(x = muestra, y = desviacion), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci_S, ymax = lc_S), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc_S, ymax = lcs_S), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  annotate(
    "text", x = 25 + 0.9, y = lci_S, 
    label = latex2exp::TeX("$LCI$"),
    colour = "red",
    parse = TRUE
  ) +
  annotate(
    "text", x = 25 + 0.75, y = lc_S, 
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text", x = 25 + 0.9, y = lcs_S, 
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Muestra", bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "$S_i$", bold = TRUE, italic = TRUE
    )
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 25, by = 2),
    limits = c(1, 26)
  ) +
  theme_bw()

ggplot(
  data = pistones[1:25, ], 
  aes(x = muestra, y = media)
) +
  geom_step(
    mapping = aes(x = muestra, y = lci),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lc),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lcs),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(x = muestra, y = media), color = "black"
  ) +
  geom_line(
    mapping = aes(x = muestra, y = media), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci, ymax = lc), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc, ymax = lcs), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  annotate(
    "text", x = 25 + 0.9, y = lci, 
    label = latex2exp::TeX("$LCI$"),
    colour = "red",
    parse = TRUE
  ) +
  annotate(
    "text", x = 25 + 0.75, y = lc, 
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text", x = 25 + 0.9, y = lcs, 
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Muestra", bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "$\\bar{x}_i$", bold = TRUE, italic = TRUE
    )
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 25, by = 2),
    limits = c(1, 26)
  ) +
  theme_bw()
```

Como se nota en la Figura 4.13 todos los puntos están bajo control y no se observa un comportamiento sistemático en los datos, tanto en el diagrama \(S\) como en el diagrama \(\bar{x}\); por lo tanto se concluye que el proceso se encuentra bajo control tanto en su variabilidad como en su nivel medio. Y estos límites se usarán para controlar el nivel medio y la variabilidad del diámetro interior de los anillos para pistones en la fase II.

Las gráficas de los diagramas \(\bar{x}\) y \(S\) para los 15 muestras tomadas en la fase II se muestran con el siguiente bloque de código. Note que los límites de control en cada diagrama son los obtenidos en la fase I.

Código

```{r}
#| label: fig-dcxbarraS-fase2
#| fig-cap: "Diagramas $\\bar{x}$ y $S$ para el diámetro interior (mm) de los anillos en la fase II"
#| fig-subcap:
#|   - "Diagrama $S$"
#|   - "Diagrama $\\bar{x}$"
#| layout-ncol: 2

# diagrama S en la fase II
ggplot(
  data = pistones, 
  aes(x = muestra, y = desviacion)
) +
  geom_step(
    mapping = aes(x = muestra, y = lci_S),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lc_S),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lcs_S),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(x = muestra, y = desviacion), 
    color = "black", size = 2
  ) +
  geom_line(
    mapping = aes(x = muestra, y = desviacion), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci_S, ymax = lc_S), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc_S, ymax = lcs_S), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  geom_vline(
    xintercept = (25 + 26) / 2, linetype = 2, color = "blue"
  ) +
  annotate(
    "text", x = 40 + 0.9, y = lci_S, 
    label = latex2exp::TeX("$LCI$"),
    colour = "red", parse = TRUE
  ) +
  annotate(
    "text", x = 40 + 0.75, y = lc_S, 
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text", x = 40 + 0.9, y = lcs_S, 
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Muestra", bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "$S_i$", bold = TRUE, italic = TRUE
    )
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 40, by = 3),
    limits = c(1, 41)
  ) +
  theme_bw()

# diagrama xbarra en la fase II
violacion <-  qcc(
  pistones[1:25, 3:7], type = "xbar", 
  newdata = pistones[26:40, 3:7], 
  std.dev   = "UWAVE-SD", plot = FALSE
)
violacion <- purrr::as_vector(violacion$violations)
pistones$violacion <- ifelse(
  pistones$muestra %in% violacion, "Si", "No" 
)
ggplot(
  data = pistones, 
  aes(x = muestra, y = media)
) +
  geom_step(
    mapping = aes(x = muestra, y = lci),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lc),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lcs),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(
      x = muestra, y = media, color = factor(violacion), 
      shape = factor(violacion)
    ), 
    size = 2
  ) +
  scale_color_manual(
    values = c(
      "No" = "black", "Si" = "red", show.legend = FALSE
    )
  ) +
  scale_shape_manual(values = c(16, 8)) + 
  geom_line(
    mapping = aes(x = muestra, y = media), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci, ymax = lc), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc, ymax = lcs), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  geom_vline(
    xintercept = (25 + 26) / 2, linetype = 2, 
    color = "blue"
  ) + 
  annotate(
    "text", x = 40 + 0.9, y = lci, 
    label = latex2exp::TeX("$LCI$"),
    colour = "red",
    parse = TRUE
  ) +
  annotate(
    "text", x = 40 + 0.75, y = lc, 
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text", x = 40 + 0.9, y = lcs, 
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Muestra", bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "$\\bar{x}_i$", bold = TRUE, italic = TRUE
    ),
    shape = "Violación", color = "Violación"
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 40, by = 3),
    limits = c(1, 41)
  ) +
  theme_bw() +
  theme(
    legend.position = "bottom",
    legend.text = element_text(face = "bold"),
    legend.title = element_text(face = "bold"),
    legend.title.position = "top"
  ) 
```

Como se puede notar en la Figura 4.14, el diagrama \(S\) muestra que la variabilidad del proceso se mantiene bajo control en la fase II, mientras que el diagrama \(\bar{x}\) muestra que ha ocurrido un cambio hacia arriba en la media del proceso.

A continuación se muestran los diagramas \(\bar{x}\) y \(S\) en las fases 1 y 2 con el paquete qcc.

Código

```{r}
#| label: fig-dcxbarraS-fase1y2-qcc
#| fig-cap: "Diagramas $\\bar{x}$ y $S$ para el diámetro interior (mm) de los anillos en las fases 1 y 2 con el paquete `qcc`"
#| fig-subcap:
#|   - "Diagrama $S$ inicial"
#|   - "Diagrama $\\bar{x}$ inicial"
#|   - "Diagrama $S$ estándar"
#|   - "Diagrama $\\bar{x}$ estándar"
#| layout-ncol: 2

diameter <- with(pistonrings, qcc.groups(diameter, sample))
# Diagrama S en la fase I
S <- qcc(
  diameter[1:25, ],
  type = "S", plot = FALSE
)
plot(
  S,
  add.stats = FALSE, label.limits = c("LCI", "LCS"),
  title = "", xlab = "Muestra", ylab = "Desviación estándar",
  chart.all = TRUE
)

# Diagrama xbarra en la fase I
xbarra <- qcc(
  diameter[1:25, ],
  type = "xbar",
  plot = FALSE, std.dev = "UWAVE-SD"
)
plot(
  xbarra,
  add.stats = FALSE, label.limits = c("LCI", "LCS"),
  title = "", xlab = "Muestra", ylab = "Medias",
  chart.all = TRUE
)

# Diagrama S en la fase II
S <- qcc(
  diameter[1:25, ],
  type = "S",
  newdata = diameter[26:40, ], plot = FALSE
)
plot(
  S,
  add.stats = FALSE, label.limits = c("LCI", "LCS"), title = "",
  xlab = "Muestra", ylab = "Desviación estándar", chart.all = TRUE
)

# Diagrama xbarra en la fase II
xbarra <- qcc(
  diameter[1:25, ],
  type = "xbar", newdata = diameter[26:40, ],
  std.dev = "UWAVE-SD", plot = FALSE
)
plot(
  xbarra,
  add.stats = FALSE, label.limits = c("LCI", "LCS"), title = "",
  xlab = "Muestra", ylab = "Medias", chart.all = TRUE
)
```

Con el siguiente bloque de código se muestran los diagramas \(\bar{x}\) y \(S\) en las fases 1 y 2 con el paquete highcharter.

Código

```{r}
#| label: fig-Sinicial-highcharter
#| fig-cap: "Diagrama $S$ para el diámetro interior (mm) de los anillos en la fase I"

highchart() |>
  hc_add_series(
    data = pistones[1:25, ], 
    hcaes(x = muestra, low = lc_S, high = lcs_S),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones[1:25, ], 
    hcaes(x = muestra, low = lci_S, high = lc_S),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, 
    name = "", color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    pistones[1:25, ], 
    type = "line", hcaes(x = muestra, y = lcs_S), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones[1:25, ],
    type = "line", hcaes(x = muestra, y = lc_S), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones[1:25, ], 
    type = "line", hcaes(x = muestra, y = lci_S), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones[1:25, ],
    type = "line", color = "black",
    hcaes(x = muestra, y = desviacion),
    marker = list(radius = 3),
    useHTML = TRUE, name = "<b><i>S<sub>i</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Desviación estándar (S<sub>i</sub>)</i></b><br>")
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```
```{r}
#| label: fig-xbarra2-inicial-highcharter
#| fig-cap: "Diagrama $\\bar{x}$ para el diámetro interior (mm) de los anillos en la fase I"

highchart() |>
  hc_add_series(
    data = pistones[1:25, ], 
    hcaes(x = muestra, low = lc, high = lcs),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones[1:25, ], 
    hcaes(x = muestra, low = lci, high = lc),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    pistones[1:25, ], 
    type = "line", hcaes(x = muestra, y = lcs), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones[1:25, ],
    type = "line", hcaes(x = muestra, y = lc), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones[1:25, ], 
    type = "line", hcaes(x = muestra, y = lci), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones[1:25, ],
    type = "line", color = "black", hcaes(x = muestra, y = media),
    marker = list(radius = 3),  useHTML = TRUE, 
    name = "<b><i>Media</i></b>", dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Media</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```
```{r}
#| label: fig-Sestandar-highcharter
#| fig-cap: "Diagrama $S$ para el diámetro interior (mm) de los anillos en la fase II"

highchart() |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lc_S, high = lcs_S),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lci_S, high = lc_S),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    type = "line", hcaes(x = muestra, y = lcs_S), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = pistones,
    type = "line", hcaes(x = muestra, y = lc_S), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = pistones, 
    type = "line", hcaes(x = muestra, y = lci_S), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = pistones,
    type = "line", color = "black",
    hcaes(x = muestra, y = desviacion),
    marker = list(radius = 3),
    name = "<b><i>S<sub>i</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    ),
    plotLines = list(
      list(
        color = "grey", value = 25.5, width = 2, 
        dashStyle = "Dash"
      )
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Desviacón estándar (S<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```
```{r}
#| label: fig-xbarra2-estandar-highcharter
#| fig-cap: "Diagrama $\\bar{x}$ para el diámetro interior (mm) de los anillos en la fase II"

highchart() |>
  hc_add_series(
    data = tibble::as_tibble(pistones), 
    hcaes(x = muestra, low = lc, high = lcs),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "green", showInLegend = FALSE, 
    tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lci, high = lc), step = "hv", 
    marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    type = "line", hcaes(x = muestra, y = lcs), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = pistones,
    type = "line", hcaes(x = muestra, y = lc), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = pistones, 
    type = "line", hcaes(x = muestra, y = lci), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = pistones,
    type = "line", color = "black", 
    hcaes(
      x = muestra, y = media,
      color = ifelse(violacion == "Si", "#FF0000", "#0000FF")
    ),
    marker = list(
      enabled = TRUE, radius = 3 
    ),  
    useHTML = TRUE, name = "<b><i>Media</i></b>", 
    dashStyle = "Dash", tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    ),
    plotLines = list(
      list(
        color = "grey", value = 25.5, width = 2, 
        dashStyle = "Dash"
      )
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Media</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```

Figura 4.16: Diagrama \(S\) para el diámetro interior (mm) de los anillos en la fase I

Figura 4.17: Diagrama \(\bar{x}\) para el diámetro interior (mm) de los anillos en la fase I

Figura 4.18: Diagrama \(S\) para el diámetro interior (mm) de los anillos en la fase II

Figura 4.19: Diagrama \(\bar{x}\) para el diámetro interior (mm) de los anillos en la fase II

Con el siguiente bloque de código se muestran los diagramas \(\bar{x}\) y \(S\) en las fases 1 y 2 con el paquete plotly.

Código

```{r}
#| label: fig-Sinicial-plotly
#| fig-cap: "Diagrama $S$ para el diámetro interior (mm) de los anillos en la fase I"

pistones[1:25, ] %>%
  plot_ly(x = ~muestra) %>%
  add_lines(
    y = lcs_S, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) %>%
  add_lines(
    y = lc_S, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) %>%
  add_lines(
    y = lci_S, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) %>%
  add_trace(
    y = ~desviacion,
    name = "<b><i>S<sub>i</sub><b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = "black"),
    hovertemplate = paste(
      "<b><i>n<sub>i</sub> = %{x}</i></b>",
      "<br><b><i>S<sub>i</sub><b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) %>%
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Desviación estándar (S<sub>i</sub>)</i></b><br>",
      zeroline = FALSE
    )
  ) %>%
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```
```{r}
#| label: fig-xbarra2-inicial-plotly
#| fig-cap: "Diagrama $\\bar{x}$ para el diámetro interior (mm) de los anillos en la fase I"

pistones[1:25, ] %>%
  plot_ly(x = ~muestra) %>%
  add_lines(
    y = lcs, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) %>%
  add_lines(
    y = lc, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) %>%
  add_lines(
    y = lci, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) %>%
  add_trace(
    y = ~media,
    name = "<b><i>Media<b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = "black"),
    hovertemplate = paste(
      "<b><i>n<sub>i</sub> = %{x}</i></b>",
      "<br><b><i>Media<b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) %>%
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Media</i></b><br>",
      zeroline = FALSE
    )
  ) %>%
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```
```{r}
#| label: fig-Sestandar-plotly
#| fig-cap: "Diagrama $S$ para el diámetro interior (mm) de los anillos en la fase II"

pistones %>%
  plot_ly(x = ~muestra) %>%
  add_lines(
    y = lcs_S, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) %>%
  add_lines(
    y = lc_S, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) %>%
  add_lines(
    y = lci_S, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) %>%
  add_trace(
    y = ~desviacion,
    name = "<b><i>S<sub>i</sub><b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = "black"),
    hovertemplate = paste(
      "<b><i>n<sub>i</sub> = %{x}</i></b>",
      "<br><b><i>S<sub>i</sub><b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) %>%
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Desviacón estándar (S<sub>i</sub>)</i></b><br>",
      zeroline = FALSE
    )
  ) %>%
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```
```{r}
#| label: fig-xbarra2-estandar-plotly
#| fig-cap: "Diagrama $\\bar{x}$ para el diámetro interior (mm) de los anillos en la fase II"

color <- ifelse(pistones$violacion == "Si", "red", "black")
symbol <- ifelse(
  pistones$violacion == "Si", "asterisk-open", "circle"
)
pistones %>%
  plot_ly(x = ~muestra) %>%
  add_lines(
    y = lcs, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) %>%
  add_lines(
    y = lc, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) %>%
  add_lines(
    y = lci, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) %>%
  add_trace(
    y = ~media,
    name = "<b><i>Media<b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = color, symbol = symbol),
    hovertemplate = paste(
      "<b><i>n<sub>i</sub> = %{x}</i></b>",
      "<br><b><i>Media<b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) %>%
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Media</i></b><br>",
      zeroline = FALSE
    )
  ) %>%
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```

Figura 4.20: Diagrama \(S\) para el diámetro interior (mm) de los anillos en la fase I

Figura 4.21: Diagrama \(\bar{x}\) para el diámetro interior (mm) de los anillos en la fase I

Figura 4.22: Diagrama \(S\) para el diámetro interior (mm) de los anillos en la fase II

Figura 4.23: Diagrama \(\bar{x}\) para el diámetro interior (mm) de los anillos en la fase II

4.2.4 Diagramas de Control \(\bar{x}\) y \(S\) con Tamaños de Muestras Variables

Supóngase que se tiene un proceso de producción donde se está monitoreando una característica de la calidad \(X\) que tiene distribución normal con media \(\mu\) y desviación estándar \(\sigma\). Si se toman \(m\) muestras del proceso, cada una de tamaño \(n_i\), tal que, \(X_{i1}\), \(X_{i2}\), \(X_{ij}\), \(X_{in_i}\) representa una muestra cualquiera de \(X\), para \(i = 1, 2, \dots, m\) y \(j = 1, 2, \dots, n_i\). Donde \(X_{ij}\) es la observación \(j\) en la muestra \(i\). En consecuencia, \(X_{ij} \sim N \left(\mu, \sigma \right)\).

4.2.4.1 Diagrama de Control \(\bar{x}\) Estándar con Tamaños de Muestra Variables

En este diagrama el estadístico que se grafica es la media de cada muestra \(\bar{X}\), es decir,

Media muestral \(\bar{X}_i\) con tamaño de muestra variables

\[ \bar{X}_i=\frac{\sum_{j=1}^{n_i}X_{ij}}{n_i}, \; i = 1, 2, \dots, m. \tag{4.29}\]

De lo anterior, la media de la media muestral \(\mu_{\bar{X}_i}\), viene dada por:

\[ \mu_{\bar{X}_i} = E\left( \bar{X}_i \right) = E\left(\frac{\sum_{j=1}^{n_i}X_{ij}}{n_i} \right) = \frac{1}{n_i}\sum_{i = 1}^{n_i}E\left( X_{ij} \right) = \frac{1}{n_i}\,n_i\,\mu = \mu. \]

Mientras que, la desviación estándar de la media muestral, se obtiene como sigue:

\[ \begin{align*} \sigma_{\bar{X}_i} & = \sqrt{V\left( \bar{X}_i \right)} = \sqrt{V\left(\frac{\sum_{j=1}^{n_i}X_{ij}}{n_i} \right)}=\sqrt{\frac{1}{n_i^2}\sum_{i = 1}^{n_i}V \left( X_{ij} \right) }\\ & =\sqrt{\frac{1}{n_i^2}\,n_i\sigma^2}= \frac{\sigma}{\sqrt{n_i}}\\ \:. \end{align*} \]

En resumen, la media y la desviación estándar de \(\bar{X}_i\), vienen dadas por:

Media y desviación estándar de \(\bar{X}_i\) con tamaño de muestra variables

\[ \begin{align*} \mu_{\bar{X}_i} & = \mu\\ \sigma_{\bar{X}_i} & = \frac{\sigma}{\sqrt{n_i}} \end{align*}. \tag{4.30}\]

Dado que \(X_{ij}\) es una variable aleatoria con distribución normal, por el teorema de la reproductividad de la distribución normal, se deduce que

\[ \bar{X}_i \sim N \left(\mu_{\bar{X}_i} = \mu, \,\sigma_{\bar{X}_i} = \frac{\sigma}{\sqrt{n_i}} \right). \]

Por lo tanto, los límites de control y la línea central, según el modelo general de Shewhart, del diagrama \(\bar{x}\)estándar viene dada por

\[ \begin{align*} LCS & = \mu_{\bar{X}_i} + 3\,\sigma_{\bar{X}_i}= \mu + 3\frac{\sigma}{\sqrt{n_i}}\\ LC & = \mu_{\bar{X}_i} = \mu \\ LCI & = \mu_{\bar{X}_i} - 3\,\sigma_{\bar{X}_i}= \mu - 3\frac{\sigma}{\sqrt{n_i}} \end{align*}. \tag{4.31}\]

Haciendo \(A \left(n_i \right)=3/\sqrt{n_i}\), estos límites de control y la línea central puede reescribirse como

Limites de control estándar del diagrama \(\bar{x}\) con tamaño de muestra variables

\[ \begin{align*} LCS & = \mu + A \left(n_i \right)\sigma\\ LC & = \mu \\ LCI & = \mu - A \left(n_i \right)\sigma\\ \end{align*}. \tag{4.32}\]

Los valores de \(A \left(n_i \right)\) se ubican en Tabla A.1 del Apéndice A, dependiendo de \(n_i\).

Note en la ecuación 4.32, que los límites de control son variables.

4.2.4.2 Diagrama de Control \(S\) Estándar con Tamaño de Muestra Variables

El estadístico que se grafica en este diagrama es la desviación estándar muestral \(S_i\) con tamaño de muestra variable, definida como,

Desviación estándar muestral \(S_i\) con tamaño de muestra variables

\[ \begin{equation} S_{i} = \sqrt{\frac{\sum_{j=1}^{n_i}\left( X_{ij} - \bar{X}_i \right)^2}{n_{i} -1}}\,,\, i = 1, 2, \dots, m \end{equation}. \tag{4.33}\]

Donde, \(\bar{X}\) es la definida en la ecuación 4.29

Bajo el supuesto de que la característica de la calidad que se monitorea es normal, dado que los tamaños de muestras son variables, se sabe que el estadístico

\[ \frac{\left ( n_i - 1 \right )S_{i}^{2}}{\sigma^{2}}\sim \chi_{n_i -1}^{2} \,. \tag{4.34}\]

En consecuencia, se puede demostrar que

Media y desviación estándar de \(S_i\) con tamaño de muestra variables

\[ \begin{align*} \mu_{S_{i}} & = c_{4} \left(n_i \right) \, \sigma\\ \sigma_{S_{i}} & = \sqrt{1 - c_{4}^{2} \left(n_i \right)} \:\sigma \end{align*}. \tag{4.35}\]

Donde,

\[ c_4 \left(n_i \right) = \sqrt{\frac{2}{n_i - 1}}\, \frac {\Gamma \left ( \frac{n_i}{2} \right )}{\Gamma \left ( \frac{n_i - 1}{2} \right )}\,. \tag{4.36}\]

Estos valores de \(c_4 \left(n_i \right)\) se encuentran tabulados para diferentes valores de \(n_i\) en la Tabla A.1 del Apéndice A.

En base a lo anterior, los límites de control y la línea central el diagrama \(S\) estándar, según el modelo general de Shewhart, vienen dados por,

\[ \begin{align*} LCS & = \mu_{S_{i}} + 3\,\sigma_{S_{i}} = c_4 \left(n_i \right)\sigma + 3\,\sqrt{1 - c_{4}^{2} \left(n_i \right)}\,\sigma\\ & = \left (c_{4} \left(n_i \right) + 3\,\sqrt{1 - c_{4}^{2} \left(n_i \right)} \right )\sigma \\ LC & = \mu_{S_{i}} = c_{4} \left(n_i \right)\sigma\\ LCI & = \mu_{S_{i}} - 3\,\sigma_{S_{i}} = c_{4} \left(n_i \right)\sigma - 3\,\sqrt{1 - c_{4}^{2} \left(n_i \right)}\,\sigma\\ & = \left (c_{4} \left(n_i \right) - 3\,\sqrt{1 - c_{4}^{2} \left(n_i \right)} \right )\sigma \end{align*}. \tag{4.37}\]

Haciendo \(\left (c_{4} \left(n_i \right) + 3\,\sqrt{1 - c_{4}^{2} \left(n_i \right)} \right )\) y \(\left (c_{4} \left(n_i \right) - 3\,\sqrt{1 - c_{4}^{2} \left(n_i \right)} \right )\) iguales a \(B_6\left(n_i \right)\) y \(B_5\left(n_i \right)\), respectivamente, la ecuación anterior se puede reescribir de la siguiente manera,

Limites de control estándar del diagrama \(S\) con tamaño de muestra variables

\[ \begin{align*} LCS & = B_{6}\left(n_i \right)\,\sigma \\ LC & = c_{4}\left(n_i \right)\,\sigma\\ LCI & = B_{5}\left(n_i \right)\,\sigma \end{align*}. \tag{4.38}\]

Las constantes \(B_6\left(n_i \right)\) y \(B_5\left(n_i \right)\) se encuentran tabuladas en la Tabla A.1 del Apéndice A.

Note en la ecuación anterior, que tantos los límites de control como la línea central de este diagrama son variables, dado que dependen de los \(n_i\).

4.2.5 Diagramas de Control \(\bar{x}\) y \(S\) Inicial con Tamaño de Muestra variable

En la práctica generalmente se desconoce la media y la desviación estándar del proceso, por lo que hay que estimarla con los datos observados (muestras). El procedimiento para estimar \(\mu\) y \(\sigma\) se conoce como fase I o fase inicial y los diagramas obtenidos en esta fase se llaman diagramas de control inicial. El procedimiento consiste en tomar \(n\) muestras o subgrupos preliminares cuando se considera que el proceso está bajo control. En general, estas estimaciones deberían basarse en al menos 20 o 25 metras (\(m \geq 20\)). Cada una de las cuales debe contener \(n_i\) observaciones de la característica de la calidad. De manera típica, \(n\) será pequeña, con frecuencia 4, 5 o 6. Estos tamaños pequeños de muestras suelen resultar de la construcción de subgrupos racionales y del hecho de que los costos de muestreo e inspección asociados con la medición de la variable por lo general son relativamente altos. Sea \(\bar{X}_i\) la media de la muestra \(i\), con \(i=1, 2, \dots, m\).

Dado que los \(n_i\) son variables, las muestras más grandes contienen mayor información de la característica de la calidad \(X\), por tal razón se usa un enfoque ponderado para la estimación de \(\mu\) y \(\sigma\), para darle más peso a las muestras de mayor tamaño.

En tal sentido, se usa como estimador de \(\mu\), la media ponderada de las medias muestrales, es decir,

Estimador de \(\sigma\) con tamaño de muestra variables

\[ \hat{\mu} = \bar{\bar{x}} = \frac{ \sum_{i=1}^{m}n_i\, \bar{X}_i}{\sum_{i=1}^{m}n_i}. \tag{4.39}\]

Se puede demostrar que este estimador de \(\mu\) es insesgado.

Por otro lado, el estimador de \(\sigma\) es una función de las desviaciones estándar muestrales \(S_i\), con \(i = 1 , 2, \dots, m\). Y viene dada por

Estimador de \(\sigma\) basada en la desviación estándar muestral con tamaño de muestra variables

\[ \hat{\sigma}=\frac{\bar{S}}{c_{4}\left(n_i\right)}. \tag{4.40}\]

Donde, \(\bar{S}\), a diferencia de la definida en la ecuación 4.23, es la raíz cuadrada del promedio ponderado de las varianzas muestrales, donde se ha ponderado cada \(\bar{S}_{i}^{2}\) con \(\left(n_i - 1 \right)\). Es decir,

\(\bar{S}\) con tamaño de muestra variables

\[ \bar{S} = \sqrt{\frac{\sum_{i=1}^{m}\left(n_i -1 \right)S_{i}^{2}}{\sum_{i=1}^{m}n_i - m}} \,,\:i= 1, 2, \dots, m. \tag{4.41}\]

4.2.5.1 Diagrama de Control \(\bar{x}\) Inicial con Tamaño de Muestra Variable

En base a los supuestos descritos anteriormente los límites de control del diagrama \(\bar{x}\) inicial con tamaño de muestra variable, se consiguen sustituyendo en la ecuación 4.31, los estimadores de \(\mu\) y \(\sigma\), dados en las ecuaciones 4.39 y 4.40. Es decir,

\[ \begin{align*} LCS & = \bar{\bar{x}} + \frac{3}{\sqrt{n_i}}\frac{\bar{S}}{c_{4}\left(n_i\right)}\\ LC & = \bar{\bar{x}} \\ LCI & = \bar{\bar{x}} - \frac{3}{\sqrt{n_i}}\frac{\bar{S}}{c_{4}\left(n_i\right)} \end{align*}. \]

Sustituyendo \(3/\sqrt{n\,c_{4}\left(n_i\right)}\) por \(A_{3}\left(n_i\right)\) en la expresión anterior, los limites anteriores se pueden expresar de la siguiente manera

Limites de control inicial del diagrama \(\bar{x}\) con tamaño de muestra variables

\[ \begin{align*} LCS & = \bar{\bar{x}} + A_{3}\left(n_i\right)\bar{S}\\ LC & = \bar{\bar{x}} \\ LCI & = \bar{\bar{x}} - A_{3}\left(n_i\right)\bar{S} \end{align*}. \tag{4.42}\]

La constante \(A_3\left(n_i\right)\) se encuentra tabulada para diferentes valores de \(n\) en la Tabla A.1 del Apéndice A.

Note que en la ecuación anterior se ha escrito \(A_3\left(n_i\right)\) en lugar de \(A_3\) para hacer notar que \(A_3\) es una función de \(n_i\).

4.2.5.2 Diagrama de Control \(S\) Inicial con tamaño de Muestra variable

Los límites de control tipo Shewhart para este diagrama se obtienen sustituyendo en la ecuación 4.37 \(\sigma\) por su estimador, dado en la ecuación 4.40. Es decir,

\[ \begin{align*} LCS & = c_{4}\left(n_i\right) \frac{\bar{S}}{c_{4}\left(n_i\right)} + 3\,\sqrt{1 - c_{4}^{2}}\,\frac{\bar{S}}{c_{4}} = \left ( 1 + \frac{3\sqrt{1 - c_{4}^{2}\left(n_i\right)}}{c_{4}\left(n_i\right)} \right )\bar{S}\\ LC & = c_{4}\left(n_i\right) \frac{\bar{S}}{c_{4}\left(n_i\right)} = \bar{S}\\ LCI & = c_{4}\left(n_i\right) \frac{\bar{S}}{c_{4}\left(n_i\right)} - 3\,\sqrt{1 - c_{4}^{2}\left(n_i\right)}\,\frac{\bar{S}}{c_{4}\left(n_i\right)} = \left ( 1 - \frac{3\sqrt{1 - c_{4}^{2}\left(n_i\right)}}{c_{4}\left(n_i\right)} \right )\bar{S} \end{align*}. \tag{4.43}\]

Sustituyendo en la ecuación anterior \(\left ( 1 + 3\sqrt{1 - c_{4}^{2}\left(n_i\right)}\,/\,c_{4}\left(n_i\right) \right )\) y \(\left ( 1 - 3\sqrt{1 - c_{4}^{2}\left(n_i\right)}\,/\,c_{4}\left(n_i\right) \right )\) por \(B_4\left(n_i\right)\) y \(B_3\left(n_i\right)\), respectivamente, los límites anteriores se pueden expresar de la siguiente manera

Limites de control inicial del diagrama \(S\) con tamaño de muestra variables

\[ \begin{align*} LCS & = B_{4}\left(n_i\right)\,\bar{S} \\ LC & = \bar{S}\\ LCI & = B_{3}\left(n_i\right)\,\bar{S} \end{align*}. \tag{4.44}\]

Las constantes \(B_4\left(n_i\right)\) y \(B_3\left(n_i\right)\) se encuentra tabulada para diferentes valores de \(n_i\) en la Tabla A.1 del Apéndice A.

Como podrá notar de la ecuación anterior, los límites de control de este diagrama son variables.

Como se ha hecho evidente, los límites de control de los diagramas de control \(\bar{x}\) y \(S\) son variables, lo que hace imposible aplicar los criterio de corridas para analizar estos diagramas. Por lo que algunos autores recomiendan utilizar, como una medida remedial, construir los límites de control sustituyendo los \(n_i\) por el promedio de los subgrupos racionales \(\bar{n}\), como se definió en la ecuación 3.18.

De tal manera que, en este caso, los limites de control del diagrama \(\bar{x}\), dados por las ecuaciones 4.32 y 4.42, quedarían redefinidos de la siguiente manera,

Limites de control estándar del diagrama \(\bar{x}\) con tamaño de muestra promedio

\[ \begin{align*} LCS & = \mu + A \left( \bar{n} \right)\sigma\\ LC & = \mu \\ LCI & = \mu - A \left( \bar{n} \right)\sigma\\ \end{align*}. \tag{4.45}\]

Limites de control inicial del diagrama \(\bar{x}\) con tamaño de muestra promedio

\[ \begin{align*} LCS & = \bar{\bar{x}} + A_{3}\left( \bar{n} \right)\bar{S}\\ LC & = \bar{\bar{x}} \\ LCI & = \bar{\bar{x}} - A_{3}\left( \bar{n} \right)\bar{S} \end{align*}. \tag{4.46}\]

Mientras que los límites de control del diagrama \(S\), dados en las ecuaciones 4.38 y 4.44, usando el enfoque del tamaño de muestra promedio, quedarían redefinidos de la siguiente manera,

Limites de control estándar del diagrama \(S\) con tamaño de muestra promedio

\[ \begin{align*} LCS & = B_{6}\left( \bar{n} \right)\sigma\\ LC & = c_{4}\left( \bar{n} \right)\sigma \\ LCI & = B_{5}\left( \bar{n} \right)\sigma \end{align*}. \tag{4.47}\]

Limites de control inicial del diagrama \(S\) con tamaño de muestra promedio

\[ \begin{align*} LCS & = B_{4}\left( \bar{n} \right)\bar{S}\\ LC & = \bar{S} \\ LCI & = B_{3}\left( \bar{n} \right)\bar{S} \end{align*}. \tag{4.48}\]

Otra opción, particularmente útil, cuando un tamaño de subgrupo racional que se repita mucho, es tomar como \(n_i\) la moda de estos subgrupos.

Advertencia

Hay que tener cuidado cuando se trabaja con los diagramas de control \(\bar{x}\) y \(S\) con el enfoque del tamaño de muestra promedio, es posible que puntos muestrales se ubiquen fuera de los límites de control, cuando en realidad están bajo control o viceversa.

Un tercer enfoque cuando se aplican los diagramas de control \(\bar{x}\) y \(S\) con tamaño de muestra variable es trabajar con límites de control estandarizados.

En el caso del diagrama de control \(\bar{x}\) el estadístico que se grafíca es la estandarización de la media muestral con tamaño de muestra variable \(\bar{X}_i\), definida en la ecuación 4.29. Con media y desviación dadas en la ecuación 4.30. En consecuencia, el estadístico graficado en este caso es,

\(Z_{X_i}\) con \(\mu\) y \(\sigma\) conocidas

\[ \begin{equation} Z_{\bar{X}_i} = \frac{\bar{X}_i - \mu_{\bar{X}_i}}{\sigma_{\bar{X}_i}} = \frac{\bar{X}_i - \mu}{\frac{\sigma}{\sqrt{n_i}}} = \frac{\sqrt{n_i}\left(\bar{X}_i - \mu \right)}{\sigma}, \,\, i = 1, 2, \dots, m \end{equation}. \tag{4.49}\]

De lo anterior, se deduce que la media de \(Z_{\bar{X}_i}\), viene dada por:

\[ \begin{align*} \mu_{Z_{\bar{X}_i}} & = E\left( Z_{\bar{X}_i} \right) = E\left(\frac{\sqrt{n_i}\left(\bar{X}_i - \mu \right)}{\sigma} \right)\\ & = \frac{\sqrt{n_i}}{\sigma}\,\left(E\left(\bar{X}_i \right) - \mu \right)= \frac{\sqrt{n_i}}{\sigma}\,\left(\mu - \mu \right) = 0. \end{align*} \]

Mientras que, la desviación estándar de \(Z_{\bar{X}_i}\), se obtiene como sigue:

\[ \begin{align*} \sigma_{ Z_{\bar{X}_i}} & = \sqrt{V\left( Z_{\bar{X}_i} \right)} = \sqrt{V\left(\frac{\sqrt{n_i}\left(\bar{X}_i - \mu \right)}{\sigma} \right)}\\ &= \sqrt{\frac{n_i}{\sigma^2}V \left(\bar{X}_i - \mu \right)} = \sqrt{\frac{n_i}{\sigma^2}\,\frac{\sigma^2}{n_i}} = 1. \end{align*} \]

En resumen, la media y la desviación estándar de \(Z_{\bar{X}_i}\), vienen dadas por:

Media y desviación estándar de \(Z_{X_i}\) con \(\mu\) y \(\sigma\) conocidas

\[ \begin{align*} \mu_{ Z_{\bar{X}_i}} & = 0\\ \sigma_{ Z_{\bar{X}_i}} & = 1 \end{align*}. \tag{4.50}\]

Bajo el supuesto de que \(X_{ij}\) es una variable aleatoria con distribución normal, por el teorema de la reproductividad de la distribución normal, se deduce que

\[ Z_{\bar{X}_i} \sim N \left(\mu_{Z_{\bar{X}_i}} = 0, \, \sigma_{Z_{\bar{X}_i}} = 1 \right). \tag{4.51}\]

Por lo tanto, los límites de control estándar y la línea central, según el modelo general de Shewhart, para \(Z_{\bar{X}_i}\) vienen dados por

Limites de control estándar para \(Z_{\bar{X}_i}\)

\[ \begin{align*} LCS & = \mu_{Z_{\bar{X}_i}} + 3\,\sigma_{Z_{\bar{X}_i}}= 3\\ LC & = \mu_{Z_{\bar{X}_i}} = 0 \\ LCI & = \mu_{Z_{\bar{X}_i}} - 3\,\sigma_{Z_{\bar{X}_i}}= - 3 \end{align*}. \tag{4.52}\]

Cuando \(\mu\) y \(\sigma\) son desconocidos, el estadístico definido en la ecuación 4.49 se redefine sustituyendo estos parámetros por sus respectivos estimadores dados en las ecuaciones 4.39 y 4.40. Como se muestra a continuación,

\(Z_{X_i}\) con \(\mu\) y \(\sigma\) descocidas

\[ \begin{equation} Z_{\bar{X}_i} = \frac{\sqrt{n_i}\,c_{4}\left( n_i \right)\left(\bar{X}_i - \bar{\bar{X}} \right)}{\bar{S}}, \,\, i = 1, 2, \dots, m \end{equation}. \]

Los límites de control y la línea central para el estadístico dado en la ecuación anterior, son los indicados en la ecuación 4.52.

En el diagrama \(S\) con tamaño de muestra variables, cuando se aplica el enfoque de los límites de control estandarizados, el estadístico que se grafíca es la desviación estándar muestral (ecuación 4.33) estandarizada. Como la media y la desviación estándar de \(S_i\) están indicadas en la ecuación 4.35, los \(S_i\) estandarizados se definen como,

\(Z_{X_i}\) con \(\mu\) y \(\sigma\) conocidas

\[ \begin{equation} Z_{S_i} = \frac{S_i - \mu_{S_i}}{\sigma_{S_i}} = \frac{S_{i} - c_{4}\left(n_{i} \right)\sigma}{\sqrt{1 - c_{4}^2\left(n_{i} \right)}} , \,\, i = 1, 2, \dots, m \end{equation}. \tag{4.53}\]

De lo anterior, se deduce que la media de \(Z_{S_i}\), viene dada por:

\[ \begin{align*} \mu_{Z_{S_i}} & = E\left( Z_{S_i} \right) = E\left(\frac{S_{i} - c_{4}\left(n_{i} \right)\sigma}{\sqrt{1 - c_{4}^2\left(n_{i} \right)}} \right) = \frac{1}{\sqrt{1 - c_{4}^2\left(n_{i} \right)}}\,\left(E\left(S_i \right) - c_{4}\left(n_{i} \right)\sigma \right) \\ & = \frac{1}{\sqrt{1 - c_{4}^2\left(n_{i} \right)}}\,\left(c_{4}\left(n_{i} \right)\sigma - c_{4}\left(n_{i} \right)\sigma \right) = 0 \end{align*}. \]

Mientras que, la desviación estándar de \(Z_{S_i}\), se obtiene como sigue:

\[ \begin{align*} \sigma_{ Z_{S_i}} & = \sqrt{V\left( \frac{S_{i} - c_{4}\left(n_{i} \right)\,\sigma}{\sqrt{1 - c_{4}^2\left(n_{i} \right)}\,\sigma} \right)} = \sqrt{\frac{1}{\left(1- c_{4}^2\left(n_{i} \right) \right) \,\sigma^2} V\left(S_i \right) }\\ & = \sqrt{\frac{1}{\left(1- c_{4}^2\left(n_{i} \right)\right)\,\sigma^2} \left(1- c_{4}^2\left(n_{i} \right) \right)\sigma^2} = 1 \end{align*}. \]

En resumen, la media y la desviación estándar de \(Z_{S_i}\), vienen dadas por:

Media y desviación estándar de \(Z_{S_i}\) con \(\mu\) y \(\sigma\) conocidas

\[ \begin{align*} \mu_{Z_{\bar{S}_i}} & = 0\\ \sigma_{ Z_{S_i}} & = 1 \end{align*}. \tag{4.54}\]

Por lo tanto, los límites de control estándar y la línea central, según el modelo general de Shewhart, para \(Z_{\bar{X}_i}\) vienen dados por

Limites de control estándar para \(Z_{\bar{X}_i}\)

\[ \begin{align*} LCS & = \mu_{Z_{S_i}} + 3\,\sigma_{Z_{\bar{X}_i}}= 3\\ LC & = \mu_{Z_{S_i}} = 0 \\ LCI & = \mu_{Z_{S_i}} - 3\,\sigma_{Z_{\bar{X}_i}}= - 3 \end{align*}. \tag{4.55}\]

Cuando \(\sigma\) es desconocido, el estadístico definido en la ecuación 4.53 se redefine, sustituyendo este parámetro por su estimador dado en la 4.40. Como se muestra a continuación,

\(Z_{X_i}\) con \(\mu\) y \(\sigma\) descocidas

\[ \begin{equation} Z_{S_i} = \frac{S_i - \hat{\mu}_{S_i}}{\hat{\sigma}_{S_i}} = \frac{S_{i} - \bar{S}}{\sqrt{\frac{1}{c_{4}^2\left( n_{i} \right)} - 1}\:\bar{S}} , \,\, i = 1, 2, \dots, m \end{equation}. \tag{4.56}\]

Los límites de control y la línea central para el estadístico dado en la ecuación anterior, son los indicados en la ecuación 4.55.

Ejemplo 4.3 (Aplicación de los Diagramas de Control \(\bar{x}\) y \(S\) con Tamaño de Muestra Variables)
Considere los datos que se muestran en la Tabla 4.6 que es una modificación de los datos del diámetro interior (mm) de los anillos para pistones mostrados en la Tabla 4.2 del ejemplo 4.1. Para la aplicación de los diagramas \(\bar{x}\) y \(S\) con tamaño de muestra variables se han tomado solo los datos de la fase I (25 subgrupos racionales) y se han eliminado 25 observaciones de manera aleatoria (pseudoaleatoria). Observe, en la Tabla 4.6, que los tamaños de muestras varían de \(n = 2\) a \(n = 5\).

Código

```{r}
#| label: tbl-datos-pistones-xbararS-tmv
#| tbl-cap:  "Mediciones del diámetro interior (mm) de anillos para pistones"

set.seed(1014)
data(package = "qcc", "pistonrings")
pistones <- pistonrings |>
  dplyr::filter(trial == TRUE) |>
  dplyr::transmute(
    muestra = sample,
    diametro = if_else(
      1:125 %in% sample(
        x = 1:125, size = 25, replace = FALSE
      ), NA, diameter
    )
  )

pistones <- with(
  data = pistones, qcc.groups(data = diametro, sample = muestra)
) |>
  data.table::data.table() |>
  dplyr::mutate(
    muestra = 1:25
  ) |>
  dplyr::rowwise() |>
  dplyr::mutate(
    media = mean(c_across(V1:V5), na.rm = TRUE),
    desviacion = sd(c_across(V1:V5), na.rm = TRUE),
    ni = sum(!is.na(c_across(V1:V5)))
  ) |>
  dplyr::rename(
    X_1 = V1, X_2 = V2, X_3 = V3, X_4 = V4, X_5 = V5,
  ) |>
  dplyr::relocate(
    c(muestra, ni),
    .before = X_1
  ) |>
  data.table::as.data.table()

reactable::reactable(
  pistones,
  # defaultColDef = colDef(
  #   headerStyle = list(background = "#f7f7f8")
  # ),
  columns = list(
    muestra = colDef(header = "Muestra", align = "right"),
    ni = colDef(header = "Tamaño de muestra", align = "right"),
    X_1 = colDef(
      header = "\\( x_{i1} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    X_2 = colDef(
      header = "\\( x_{i2} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    X_3 = colDef(
      header = "\\( x_{i3} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    X_4 = colDef(
      header = "\\( x_{i4} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    X_5 = colDef(
      header = "\\( x_{i5} \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 3, locales = "es-ES"
      )
    ),
    media = colDef(
      header = "\\( \\bar{x}_i \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 4, locales = "es-ES"
      )
    ),
    desviacion = colDef(
      header = "\\( S_i \\)", align = "right",
      format = colFormat(
        separators = TRUE, digits = 4, locales = "es-ES"
      )
    )
  ),
  striped = TRUE,
  bordered = TRUE,
  highlight = TRUE,
  filterable = TRUE,
  minRows = 10
)
```

Tabla 4.6: Mediciones del diámetro interior (mm) de anillos para pistones

Los límites de control de los diagramas \(\bar{x}\) y \(S\) se muestran en la siguiente tabla.

Código

```{r}
#| label: tbl-lc-xbararS-tmv
#| tbl-cap:  "Límites de control de los diagramas $\\bar{x}$ y $S$ para las mediciones del diámetro interior (mm) de anillos para pistones con tamaño de muestra variables"
#| class: output

m <- nrow(pistones)
lc <- sum(pistones$ni * pistones$media) / sum(pistones$ni)
lc_S <- sqrt(
  sum((pistones$ni - 1) * pistones$desviacion^2) / 
    (sum(pistones$ni) - m)
)

pistones <- pistones |> 
  dplyr::mutate(
    c4 = sqrt(2 / (ni - 1)) * (gamma(ni / 2) / gamma((ni - 1) / 2)),
    A3 = 3 / (sqrt(ni) * c4),
    lci = lc - A3 * lc_S,
    lcs = lc + A3 * lc_S,
    B3 = if_else(
      1 - 3 * (sqrt(1 - c4^2) / c4) < 0, 
      0,
      1 - 3 * (sqrt(1 - c4^2) / c4)
    ),
    B4 = 1 + 3 * (sqrt(1 - c4^2) / c4),
    lci_S = B3 * lc_S,
    lcs_S = B4 * lc_S,
    xbarra_est = sqrt(ni) * c4 * (media - lc) / lc_S,
    S_est = (desviacion - lc_S) / (sqrt(1 / c4 - 1) * lc_S)
  ) |> 
  data.table::data.table()

knitr::kable(
  pistones |> 
    dplyr::select(
      muestra, ni, media,  A3, lci, lcs, desviacion, B3, B4, lci_S,
      lcs_S, xbarra_est, S_est
    ) |> 
    data.table::data.table(),
  format = "markdown",
  digits = 4,
  format.args = list(decimal.mark = ",", big.mark = "."),
  col.names = c(
    "Muestra", "$n_i$", "$\\bar{X}_i$", "$A_3$", "$LCI$",
    "$LCS$", "$S_i$", "$B_3$", "$B_4$", "$LCI$", "$LCS$",
    "$Z_{\\bar{X}_i}$", "$Z_{S_i}$"
  ),
  align = "ccccccccccc",
  escape = FALSE
  )
```

Tabla 4.7: Límites de control de los diagramas \(\bar{x}\) y \(S\) para las mediciones del diámetro interior (mm) de anillos para pistones con tamaño de muestra variables

Muestra	\(n_i\)	\(\bar{X}_i\)	\(A_3\)	\(LCI\)	\(LCS\)	\(S_i\)	\(B_4\)	\(LCS\)	\(Z_{\bar{X}_i}\)	\(Z_{S_i}\)
1	3	74,0137	1,9544	73,9813	74,0219	0,0196	2,5682	0,0267	1,7784	2,4530
2	5	74,0006	1,4273	73,9868	74,0165	0,0075	2,0890	0,0217	-0,2040	-1,1041
3	5	74,0080	1,4273	73,9868	74,0165	0,0147	2,0890	0,0217	1,2906	1,6509
4	5	74,0030	1,4273	73,9868	74,0165	0,0091	2,0890	0,0217	0,2807	-0,5034
5	3	74,0043	1,9544	73,9813	74,0219	0,0112	2,5682	0,0267	0,4017	0,2234
6	5	73,9956	1,4273	73,9868	74,0165	0,0087	2,0890	0,0217	-1,2139	-0,6467
7	4	74,0012	1,6281	73,9847	74,0186	0,0055	2,2660	0,0236	-0,0637	-1,6134
8	5	73,9968	1,4273	73,9868	74,0165	0,0123	2,0890	0,0217	-0,9715	0,7031
9	3	74,0027	1,9544	73,9813	74,0219	0,0068	2,5682	0,0267	0,1559	-0,9654
10	4	73,9975	1,6281	73,9847	74,0186	0,0071	2,2660	0,0236	-0,7277	-1,0737
11	4	73,9952	1,6281	73,9847	74,0186	0,0019	2,2660	0,0236	-1,1261	-2,7995
12	5	74,0014	1,4273	73,9868	74,0165	0,0042	2,0890	0,0217	-0,0424	-2,3531
13	3	73,9973	1,9544	73,9813	74,0219	0,0145	2,5682	0,0267	-0,6308	1,0985
14	3	73,9857	1,9544	73,9813	74,0219	0,0196	2,5682	0,0267	-2,3516	2,4530
15	4	74,0080	1,6281	73,9847	74,0186	0,0067	2,2660	0,0236	1,1314	-1,2243
16	2	74,0005	2,6587	73,9739	74,0293	0,0064	3,2665	0,0340	-0,1204	-0,7719
17	4	73,9992	1,6281	73,9847	74,0186	0,0115	2,2660	0,0236	-0,4179	0,3690
18	5	74,0074	1,4273	73,9868	74,0165	0,0070	2,0890	0,0217	1,1694	-1,3010
19	5	73,9982	1,4273	73,9868	74,0165	0,0085	2,0890	0,0217	-0,6887	-0,7374
20	5	74,0092	1,4273	73,9868	74,0165	0,0080	2,0890	0,0217	1,5330	-0,9224
21	2	74,0070	2,6587	73,9739	74,0293	0,0028	3,2665	0,0340	0,5844	-1,4469
22	4	74,0022	1,6281	73,9847	74,0186	0,0084	2,2660	0,0236	0,1133	-0,6529
23	3	74,0043	1,9544	73,9813	74,0219	0,0127	2,5682	0,0267	0,4017	0,6049
24	4	74,0040	1,6281	73,9847	74,0186	0,0096	2,2660	0,0236	0,4232	-0,2795
25	5	73,9982	1,4273	73,9868	74,0165	0,0162	2,0890	0,0217	-0,6887	2,1945

A continuación, se muestra el cálculo manual de los límites de control del diagrama \(S\), usando la ecuación 4.44, para la primera muestra (\(n = 3\)). Para ello, de la Tabla A.1 del Apéndice A se observa que para \(n = 4\) el valor de \(B_3 = 0\) y \(B_4 =2,5682\).

\[ \begin{align*} LCI & = B_{3}\left(n_i \right)\,\bar{S} = 0 \left(0,0104 \right) = 0 \\ LC & = \bar{S} = 0,0104 \\ LCS & = B_{4}\left(n_i \right)\,\bar{S} = 2,568 \left(0,0104 \right) = 0,0267 \end{align*}. \]

El cálculo de manera manual de los límites de control del diagrama \(\bar{x}\), usando la ecuación 4.42, se muestra a continuación. Tomando \(A_3 = 1,9544\), de la Tabla A.1 del Apéndice A, entonces

\[ \begin{align*} LCI & = \bar{\bar{x}} - A_{3}\left(n_i \right)\,\bar{S} = 74,0016 - 1,954 \left(0,0104 \right) = 73,9813 \\ LC & = \bar{\bar{x}} = 74,0016 \\ LCS & = \bar{\bar{x}} + A_{3}\left(n_i \right)\,\bar{S} = 74,0016 + 1,954 \left(0,0104 \right) = 74,0219 \end{align*}. \]

En la Figura 4.24 se muestran los diagramas de control \(\bar{x}\) y \(S\) en la fase inicial para el diámetro interior (mm) de los anillos para pistones.

Código

```{r}
#| label: fig-dcxbarraS-fase1-tmv
#| fig-cap: "Diagramas $\\bar{x}$ y $S$ para el diámetro interior (mm) de los anillos en la fase inicial"
#| fig-subcap: 
#|   - "Diagrama $\\bar{S}$"
#|   - "Diagrama $\\bar{x}$"
#| layout-ncol: 2

ggplot(
  data = pistones, 
  aes(x = muestra, y = desviacion)
) +
  geom_step(
    mapping = aes(x = muestra, y = lci_S),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lc_S),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lcs_S),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(x = muestra, y = desviacion), color = "black"
  ) +
  geom_line(
    mapping = aes(x = muestra, y = desviacion), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci_S, ymax = lc_S), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc_S, ymax = lcs_S), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  annotate(
    "text", x = 25 + 0.9, y = lci_S, 
    label = latex2exp::TeX("$LCI$"),
    colour = "red",
    parse = TRUE
  ) +
  annotate(
    "text", x = 25 + 0.75, y = lc_S, 
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text", x = 25 + 0.9, y = lcs_S, 
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Muestra", bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "$S_i$", bold = TRUE, italic = TRUE
    )
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 25, by = 2),
    limits = c(1, 26)
  ) +
  theme_bw()

ggplot(
  data = pistones, 
  aes(x = muestra, y = media)
) +
  geom_step(
    mapping = aes(x = muestra, y = lci),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lc),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = muestra, y = lcs),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(x = muestra, y = media), color = "black"
  ) +
  geom_line(
    mapping = aes(x = muestra, y = media), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci, ymax = lc), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc, ymax = lcs), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  annotate(
    "text", x = 25 + 0.9, y = lci, 
    label = latex2exp::TeX("$LCI$"),
    colour = "red",
    parse = TRUE
  ) +
  annotate(
    "text", x = 25 + 0.75, y = lc, 
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text", x = 25 + 0.9, y = lcs, 
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Muestra", bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "$\\bar{x}_i$", bold = TRUE, italic = TRUE
    )
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 25, by = 2),
    limits = c(1, 26)
  ) +
  theme_bw()
```

Como se nota en la Figura 4.13 todos los puntos están bajo control y no se observa un comportamiento sistemático en los datos, tanto en el diagrama \(S\) como en el diagrama \(\bar{x}\); por lo tanto se concluye que el proceso se encuentra bajo control tanto en su variabilidad como en su nivel medio. Y estos límites de control pueden ser usados para controlar el nivel medio y la variabilidad del diámetro interior de los anillos para pistones en la fase II.

A continuación se muestran los diagramas \(\bar{x}\) y \(S\) en las fase I con el paquete qcc.

Código

```{r}
#| label: fig-dcxbarraS-fase1y2-qcc-tmv
#| fig-cap: "Diagramas $\\bar{x}$ y $S$ para el diámetro interior (mm) de los anillos en la fase I con el paquete `qcc`"
#| fig-subcap:
#|   - "Diagrama $S$ inicial"
#|   - "Diagrama $\\bar{x}$ inicial"
#|   - "Diagrama $S$ estándar"
#|   - "Diagrama $\\bar{x}$ estándar"
#| layout-ncol: 2

# Diagrama S en la fase I
S <- qcc(
  pistones[, 3:7], type = "S", plot = FALSE
)
plot(
  S, add.stats = FALSE, label.limits = c("LCI", "LCS"), 
  title = "",   xlab = "Muestra", ylab = "Desviación estándar",
  chart.all = TRUE
)

# Diagrama xbarra en la fase I
xbarra <- qcc(
  pistones[, 3:7], type = "xbar", 
  plot = FALSE, std.dev = "UWAVE-SD"
)
plot(
  xbarra, add.stats = FALSE, label.limits = c("LCI", "LCS"), 
  title = "", xlab = "Muestra", ylab = "Medias", 
  chart.all = TRUE
)
```

Con el siguiente bloque de código se muestran los diagramas \(\bar{x}\) y \(S\) en la fase I con el paquete highcharter.

Código

```{r}
#| label: fig-Sinicial-highcharter-tmv
#| fig-cap: "Diagrama $S$ para el diámetro interior (mm) de los anillos en la fase I"

highchart() |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lcs_S, high = lc_S),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lci_S, high = lc_S),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    pistones, 
    type = "line", hcaes(x = muestra, y = lcs_S), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones,
    type = "line", hcaes(x = muestra, y = lc_S), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones, 
    type = "line", hcaes(x = muestra, y = lci_S), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones,
    type = "line", color = "black",
    hcaes(x = muestra, y = desviacion),
    marker = list(radius = 3),
    useHTML = TRUE, name = "<b><i>S<sub>i</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Desviación estándar (S<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```
```{r}
#| label: fig-xbarra2-inicial-highcharter-tmv
#| fig-cap: "Diagrama $\\bar{x}$ para el diámetro interior (mm) de los anillos en la fase I"

highchart() |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lcs, high = lc),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lci, high = lc),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    pistones, 
    type = "line", hcaes(x = muestra, y = lcs), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones,
    type = "line", hcaes(x = muestra, y = lc), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones, 
    type = "line", hcaes(x = muestra, y = lci), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones,
    type = "line", color = "black", hcaes(x = muestra, y = media),
    marker = list(radius = 3),  useHTML = TRUE, 
    name = "<b><i>Media</i></b>", dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Media</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```

Figura 4.26: Diagrama \(S\) para el diámetro interior (mm) de los anillos en la fase I

Figura 4.27: Diagrama \(\bar{x}\) para el diámetro interior (mm) de los anillos en la fase I

Con el siguiente bloque de código se muestran los diagramas \(\bar{x}\) y \(S\) en la fase I con el paquete plotly.

Código

```{r}
#| label: fig-Sinicial-plotly-tmv
#| fig-cap: "Diagrama $S$ para el diámetro interior (mm) de los anillos en la fase I"

pistones |> 
  plot_ly(x = ~muestra) %>%
  add_lines(
    y = ~lcs_S, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) |> 
  add_lines(
    y = lc_S, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) |> 
  add_lines(
    y = ~lci_S, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) |> 
  add_trace(
    y = ~desviacion,
    name = "<b><i>S<sub>i</sub><b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = "black"),
    hovertemplate = paste(
      "<b><i>n<sub>i</sub> = %{x}</i></b>",
      "<br><b><i>S<sub>i</sub><b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) |> 
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Desviación estándar (S<sub>i</sub>)</i></b><br>",
      zeroline = FALSE
    )
  ) |> 
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```
```{r}
#| label: fig-xbarra2-inicial-plotly-tmv
#| fig-cap: "Diagrama $\\bar{x}$ para el diámetro interior (mm) de los anillos en la fase I"

pistones |> 
  plot_ly(x = ~muestra) |> 
  add_lines(
    y = ~lcs, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) %>%
  add_lines(
    y = lc, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) %>%
  add_lines(
    y = ~lci, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) %>%
  add_trace(
    y = ~media,
    name = "<b><i>Media<b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = "black"),
    hovertemplate = paste(
      "<b><i>n<sub>i</sub> = %{x}</i></b>",
      "<br><b><i>Media<b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) %>%
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Media</i></b><br>",
      zeroline = FALSE
    )
  ) %>%
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```

Figura 4.28: Diagrama \(S\) para el diámetro interior (mm) de los anillos en la fase I

Figura 4.29: Diagrama \(\bar{x}\) para el diámetro interior (mm) de los anillos en la fase I

Los límites de control de los diagramas \(\bar{x}\) y \(S\) usando el enfoque del tamaño de muestra promedio se muestra a continuación, para ello debe calcularse previamente, con la ecuación 3.18, el promedio de los tamaños muestrales. Es decir,

\[ \begin{equation} \bar{n}= \frac{\sum_{i=1}^{m}n_i}{m} = \frac{100}{25} = 4 \end{equation}. \]

Limites de control del diagrama \(\bar{x}\) con tamaño de muestra promedio (ver ecuación 4.48)
\[ \begin{align*} LCI & = B_{3}\left(\bar{n} \right)\,\bar{S} = 0 \left(0,0104 \right) = 0 \\ LC & = \bar{S} = 0,0104 \\ LCS & = B_{4}\left(\bar{n} \right)\,\bar{S} = 2,266 \left(0,0104 \right) = 0,0236 \end{align*}. \]
Limites de control del diagrama \(\bar{x}\) con tamaño de muestra promedio (ver ecuación 4.46) \[ \begin{align*} LCI & = \bar{\bar{x}} - A_{3}\left(\bar{n} \right)\,\bar{S} = 74,0016 - 1,6281 \left(0,0104 \right) = 73,9847 \\ LC & = \bar{\bar{x}} = 74,0016 \\ LCS & = \bar{\bar{x}} + A_{3}\left(\bar{n} \right)\,\bar{S} = 74,0016 + 1,6281 \left(0,0104 \right) = 74,0186 \end{align*}. \]

Con el siguiente bloque de código se muestran los diagramas \(\bar{x}\) y \(S\) en la fase I con el paquete highcharter, usando el enfoque del tamaño de muestra promedio.

Código

```{r}
#| label: fig-Sinicial-highcharter-tmp
#| fig-cap: "Diagrama $S$ con tamaño de muestra promedio para el diámetro interior (mm) de los anillos en las fases 1"

highchart() |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lcs_S[[7]], high = lc_S),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lci_S[[7]], high = lc_S),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    pistones, 
    type = "line", hcaes(x = muestra, y = lcs_S[[7]]), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones,
    type = "line", hcaes(x = muestra, y = lc_S), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones, 
    type = "line", hcaes(x = muestra, y = lci_S[[7]]), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones,
    type = "line", color = "black",
    hcaes(x = muestra, y = desviacion),
    marker = list(radius = 3),
    useHTML = TRUE, name = "<b><i>S<sub>i</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Desviación estándar (S<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```
```{r}
#| label: fig-xbarra2-inicial-highcharter-tmp
#| fig-cap: "Diagrama $\\bar{x}$ con tamaño de muestra promedio para el diámetro interior (mm) de los anillos en las fases 1"

highchart() |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lcs[[7]], high = lc),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = lci[[7]], high = lc),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    pistones, 
    type = "line", hcaes(x = muestra, y = lcs[[7]]), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones,
    type = "line", hcaes(x = muestra, y = lc), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones, 
    type = "line", hcaes(x = muestra, y = lci[[7]]), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    pistones,
    type = "line", color = "black", hcaes(x = muestra, y = media),
    marker = list(radius = 3),  useHTML = TRUE, 
    name = "<b><i>Media</i></b>", dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Media</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```

Figura 4.30: Diagrama \(S\) con tamaño de muestra promedio para el diámetro interior (mm) de los anillos en las fases 1

Figura 4.31: Diagrama \(\bar{x}\) con tamaño de muestra promedio para el diámetro interior (mm) de los anillos en las fases 1

Con el siguiente bloque de código se muestran los diagramas \(\bar{x}\) y \(S\) estandarizados en la fase I con el paquete highcharter.

Código

```{r}
#| label: fig-Sinicial-highcharter-est
#| fig-cap: "Diagrama $S$ estanadrizado para el diámetro interior (mm) de los anillos en las fases 1"

highchart() |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = 3, high = 0),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = -3, high = 0),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    pistones, 
    type = "line", hcaes(x = muestra, y = 3), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 0)
  ) |>
  hc_add_series(
    pistones,
    type = "line", hcaes(x = muestra, y = 0), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 0)
  ) |>
  hc_add_series(
    pistones, 
    type = "line", hcaes(x = muestra, y = -3), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 0)
  ) |>
  hc_add_series(
    pistones,
    type = "line", color = "black",
    hcaes(x = muestra, y = S_est),
    marker = list(radius = 3),
    useHTML = TRUE, name = "<b><i>Z<sub>i</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Z<sub>i</sub></i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```
```{r}
#| label: fig-xbarra2-inicial-highcharter-est
#| fig-cap: "Diagrama $\\bar{x}$ estanadrizado para el diámetro interior (mm) de los anillos en las fases 1"

highchart() |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = 3, high = 0),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = pistones, 
    hcaes(x = muestra, low = -3, high = 0),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", 
    color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    pistones, 
    type = "line", hcaes(x = muestra, y = 3), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 0)
  ) |>
  hc_add_series(
    pistones,
    type = "line", hcaes(x = muestra, y = 0), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 0)
  ) |>
  hc_add_series(
    pistones, 
    type = "line", hcaes(x = muestra, y = -3), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 0)
  ) |>
  hc_add_series(
    pistones,
    type = "line", color = "black", hcaes(x = muestra, y = xbarra_est),
    marker = list(radius = 3),  useHTML = TRUE, 
    name = "<b><i>Z<sub>i</sub></i></b>", dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Z<sub>i</sub></i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```

Figura 4.32: Diagrama \(S\) estanadrizado para el diámetro interior (mm) de los anillos en las fases 1

Figura 4.33: Diagrama \(\bar{x}\) estanadrizado para el diámetro interior (mm) de los anillos en las fases 1

4.3 Consideraciones con Respecto al Uso de los Pares de Diagramas \(\bar{x}\) - \(R\) y \(\bar{x}\) - \(S\)

Los diagramas de control \(\bar{x}\) - \(S\), al igual que su contraparte, los diagramas \(\bar{x}\) - \(R\) tiene el mismo fin, monitorear el nivel medio y la variabilidad de una característica de la calidad. Por lo que surge la siguiente pregunta ¿cuál de estos dos pares de diagrama se debe usar? Y la respuesta se consigue comparando las características de los estimadores que usan ambos pares de diagramas para estimar los parámetros del proceso. Dado que ambos pares de diagramas estiman la media a través de la gran media (\(\bar{\bar{X}}\)), el problema se reduce a comparar los estimadores que usan ambos diagramas para estimar la desviación estándar, en el caso del diagrama \(R\) el estimador se basa en los rangos muestrales (\(\hat{\sigma}_R = \bar{R}⁄d_2\) ), mientras que en el diagrama \(S\) el estimador se basa en las desviaciones estándar muestrales (\(\hat{\sigma}_S = \bar{S}⁄c_4\)). Se sabe que ambos estimadores son insesgados y consistentes, además el timador basado en la desviación estándar muestral es suficiente mientras que el otro no lo es ya que no usa toda la información de la muestra (solo usa los extremos, el máximo y el mínimo). Ahora comparando la eficiencia relativa de ambos estimadores se puede dar una respuesta contundente a la interrogante planteada.

La eficiencia relativa del estimador de la desviación estándar poblacional \(\sigma\) basada en la desviación estándar muestral con respecto al estimador basado en rango muestral viene dada por

\[ \begin{equation} eff\!\left(\hat{\sigma}_S, \hat{\sigma}_R\right) = \frac{V \left(\hat{\sigma}_S \right)}{V \left(\hat{\sigma}_R \right)} \end{equation}. \tag{4.57}\]

Si \(eff\!\left(\hat{\sigma}_S, \hat{\sigma}_R\right) < 1\) significa que \(\hat{\sigma}_S\) es más eficiente en la estimación de la desviación estándar que \(\hat{\sigma}_S\). Suponiendo que la variable es normal y que los \(X_{ij}\) son independientes, entonces

\[ \begin{align*} V \left(\hat{\sigma}_S \right) & = V \left(\frac{\bar{S}}{c_4} \right)= V \left(\frac{\sum_{i=1}^{m}S_i}{m\,c_4} \right) = \frac{1}{m^2\,c_{4}^2}\sum_{i=1}^m\,V\left(S_i \right)\\ & = \frac{m\left(1 - c_{4}^2 \right)\, \sigma^2}{m^2\,c_{4}^2}= \frac{\left(1 - c_{4}^2 \right)\, \sigma^2}{m\,c_{4}^2} \end{align*}. \]

Mientras que,

\[ \begin{align*} V \left(\hat{\sigma}_R \right) & = V \left(\frac{\bar{R}}{d_2} \right)= V \left(\frac{\sum_{i=1}^{m}R_i}{m\,d_2} \right) = \frac{1}{m^2\,d_{2}^2}\sum_{i=1}^m\,V\left(R_i \right)\\ & = \frac{m\,d_{3}^2\, \sigma^2}{m^2\,d_{2}^2} = \frac{d_{3}^2\, \sigma^2}{m\,d_{2}^2} \end{align*}. \]

Sustituyendo los resultados anteriores en la ecuación 4.57 y simplificando, se obtiene que

Eficiancia relativa de \(\hat{\sigma}_S\) con respecto a \(\hat{\sigma}_R\)

\[ \begin{equation} eff\!\left(\hat{\sigma}_S, \hat{\sigma}_R\right) = \left(\frac{d_2}{d_3} \right)^2\left(\frac{1}{c_4^2} - 1 \right) \end{equation}. \tag{4.58}\]

Dado que estas constantes se muestran en la Tabla A.1 del Apéndice A para diferentes valores de \(n\) se calcula la eficiencia relativa de \(\hat{\sigma}_S\) con respecto a \(\hat{\sigma}_R\) para diferentes valores de \(n\), los resultados se muestran en la Tabla 4.8.

Código

```{r}
#| label: tbl-efr
#| tbl-cap:  "Comparación de la eficiencia relativa de $\\hat{\\sigma}_S$ con respecto a $\\hat{\\sigma}_R$"
#| tbl-colwidths: [10,10,10,10,15]
#| class: output

efr <- data.table::data.table(
  check.names = FALSE,
  n = c(
    2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 
    19L, 20L, 21L, 22L, 23L, 24L, 25L
  ),
  c4 = sapply(2:25, SixSigma::ss.cc.getc4),
  d2 = sapply(2:25, SixSigma::ss.cc.getd2),
  d3 = sapply(2:25, SixSigma::ss.cc.getd3)
)

efr$efr  <-  (efr$d2 / efr$d3)^2 * (1 / (efr$c4)^2 - 1)

knitr::kable(
  efr,
  format = "markdown",
  col.names = c(
  "$n$", "$c_4$", "$d_2$", "$d_3$", 
  "$eff\\!\\left(\\hat{\\sigma}_S, \\hat{\\sigma}_R\\right)$"
  ), 
  digits = 4,
  format.args = list(decimal.mark = ",", big.mark = "."), 
  escape = FALSE
)
```

Tabla 4.8: Comparación de la eficiencia relativa de \(\hat{\sigma}_S\) con respecto a \(\hat{\sigma}_R\)

\(n\)	\(c_4\)	\(d_2\)	\(d_3\)	\(eff\!\left(\hat{\sigma}_S, \hat{\sigma}_R\right)\)
2	0,7979	1,1284	0,8525	1,0000
3	0,8862	1,6926	0,8884	0,9919
4	0,9213	2,0588	0,8798	0,9752
5	0,9400	2,3259	0,8641	0,9548
6	0,9515	2,5344	0,8480	0,9330
7	0,9594	2,7044	0,8332	0,9112
8	0,9650	2,8472	0,8198	0,8899
9	0,9693	2,9700	0,8078	0,8695
10	0,9727	3,0775	0,7971	0,8499
11	0,9754	3,1729	0,7873	0,8313
12	0,9776	3,2585	0,7785	0,8136
13	0,9794	3,3360	0,7704	0,7968
14	0,9810	3,4068	0,7630	0,7809
15	0,9823	3,4718	0,7562	0,7657
16	0,9835	3,5320	0,7499	0,7513
17	0,9845	3,5879	0,7441	0,7376
18	0,9854	3,6401	0,7386	0,7246
19	0,9862	3,6890	0,7335	0,7121
20	0,9869	3,7349	0,7287	0,7002
21	0,9876	3,7783	0,7242	0,6888
22	0,9882	3,8194	0,7199	0,6779
23	0,9887	3,8583	0,7159	0,6675
24	0,9892	3,8953	0,7121	0,6575
25	0,9896	3,9306	0,7084	0,6479

Como se observa en la Figura 4.34, las eficiencias relativas son todas menores que 1, excepto para \(n = 2\), y estas disminuyen con el incremento de \(n\), lo que implica que el estimador de sigma basado en la desviación estándar muestral es más eficiente que el basado en el rango muestral y esta eficiencia se incremente con el aumento de \(n\), en otras palabras, el estimador de sigma basado en el rango pierde eficiencia con respecto al otro estimador, en la medida que el tamaño de la muestra se incrementa. El resultado anterior, se hace evidente en la siguiente gráfica.

Código

```{r}
#| label: fig-efr
#| fig-cap: "Comparación de la eficiencia relativa de $\\hat{\\sigma}_S$ con respecto a $\\hat{\\sigma}_R$"

highchart() |>
  hc_add_series(
    efr,
    type = "line", color = "black",
    hcaes(x = n, y = efr),
    marker = list(radius = 3),
    useHTML = TRUE, name = "<b><i>efr</i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 4)
  ) |>
  hc_add_series(
    efr,
    type = "line", color = "red",
    hcaes(x = n, y = 1),
    marker = list(enabled = FALSE),
    name = "<b><i>efr</i></b>",
    showInLegend = FALSE,
    useHTML = TRUE, 
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 0)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Muestra (n<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Eficiencia relativa</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```

Figura 4.34: Comparación de la eficiencia relativa de \(\hat{\sigma}_S\) con respecto a \(\hat{\sigma}_R\)

4.4 Diagramas de Control Para Observaciones Individuales

En muchas situaciones, el tamaño de la muestra usado para monitorear el proceso es \(n = 1\); es decir, consta de una unidad individual. Montgomery (2005, 249) menciona 5 ejemplos de estas situaciones:

Se usa la tecnología de inspección y medición automatizada, y se analiza cada unidad manufacturada, por lo que no hay ninguna base racional para hacer subgrupos.
La velocidad de producción es muy lenta, y no es conveniente dejar que se acumulen tamaños de \(n > 1\) antes del análisis. El largo intervalo entre las observaciones ocasionará problemas con la formación de los subgrupos racionales.
Las mediciones repetidas del proceso difieren únicamente por el error de laboratorio o de análisis, como en muchos procesos químicos.
Se hacen mediciones múltiples en la misma unidad del producto, como la medición del espesor de óxido en varios sitios diferentes de una oblea en la manufactura de semiconductores.
En las plantas de procesamiento, como en una fábrica de papel , las mediciones de algún parámetro, tal como el espesor del recubrimiento o lo ancho de un rollo, diferirán muy poco y producirán una desviación estándar que será muy pequeña si el objetivo es controlar el espesor del recubrimiento a lo largo del rollo.

En este tipo de situaciones el diagrama que se usa para monitorear la variabilidad es el diagrama \(x\) , mientras que la variabilidad es monitoreada a través del diagrama rango móvil \(\textit{MR}\) (por sus siglas en inglés). En el diagrama \(x\) el estadístico que se grafica son cada una de las observaciones individuales \(X_i\), mientras que en el diagrama rango móvil el estadístico graficado son los rangos móviles \(\textit{MR}_i\), lo cual representa la distancia entre dos observaciones consecutivas.

4.4.1 Diagramas de Control \(x\) y \(\textit{MR}\) Estándar

Supóngase que se tiene un proceso de producción en el cual se inspecciona una característica de la calidad \(X\) la cual se distribuye normalmente con media \(\mu\) y desviación estándar \(\sigma\) conocidas y que se toman \(m\) muestras de tamaño \(n = 1\) del proceso para controlar la producción. Sea \(X_i\)

valor observado de la variable en la muestra \(i\), con \(i=1,2, \dots,m\). Bajo las suposiciones anteriores se procede a construir los límites de control y la línea central del par de diagramas \(x – \textit{MR}\). El enfoque usado para construir estos diagramas es el de Shewhart.

4.4.1.1 Diagrama de Control \(x\) Estándar

En este diagrama el estadístico que se grafica es cada observación individual \(X_i\), y suponiendo que la variables de la calidad que se monitorea es normal con media \(\mu\) y desviación estándar \(\sigma\). Entonces, los límites de control \(3\sigma\) y la línea central, según el modelo general de Shewhart, del diagrama \(x\) estándar vienen dados por

Límites de control estándar del diagrama \(x\)

\[ \begin{align*} LCS & = \mu_{X_i} + 3\,\sigma_{X_i} = \mu + 3\,\sigma \\ LC & = \mu_{X_i} = \mu\\ LCI & = \mu_{X_i} - 3\,\sigma_{X_i} = \mu - 3\,\sigma \end{align*}. \tag{4.59}\]

El diagrama \(x\) puede considerarse un caso particular del diagrama \(\bar{x}\) cuando \(n = 1\), por lo que sustituyendo \(n = 1\) en la ecuación 4.4 se obtienen la ecuación anterior.

4.4.1.2 Diagrama de Control \(\textit{MR}\) Estándar

El estadístico que se grafica en este diagrama es el rango móvil, es decir,

Rango móvil

\[ \begin{equation} RM_i = \left| X_i - X_{i-1} \right| = \mathrm{máx}\{X_i, \, X_{i-1} \} - \mathrm{mín}\{X_i, \, X_{i-1} \}, \,\, i = 2, 3, \dots, m \end{equation}. \tag{4.60}\]

Fíjese que el \(\textit{MR}_i\) no es más que un rango que involucra dos valores muestrales (consecutivos), por lo que los límites de control estándar tipo Shewhart del diagrama \(\textit{MR}\) se consiguen sustituyendo en la ecuación 4.9 \(D_2\), \(d_2\) y \(D_1\) por 3,6859 , 1,1284 y 0, respectivamente (estos valores de \(D_2\), \(d_2\) y \(D_1\) se muestran en la Tabla A.1 del Apéndice A para \(n = 2\))

Limites de control estándar del diagrama \(\textit{MR}\)

\[ \begin{align*} LCS & = 3,6859 \, \sigma \\ LC & = 1,1284 \, \sigma \\ LCI & = 0 \end{align*} \:. \tag{4.61}\]

4.4.2 Diagramas de Control \(x\) y \(\textit{MR}\) Inicial

En la práctica generalmente se desconoce la media y la desviación estándar del proceso, por lo que hay que estimarla con datos observados del proceso (muestras). El procedimiento para estimar \(\mu\) y \(\sigma\) se conoce como fase I o fase inicial y los diagramas obtenidos en esta fase se llaman diagramas de control inicial. El procedimiento consiste en tomar \(m\) observaciones preliminares de la variable de la calidad cuando se considera que el proceso está bajo control. En general, estas estimaciones deberían basarse en al menos 20 o 25 metras (\(m \geq 20\)). Sea \(x_i\) la observación \(i\), con \(i=1,2, \dots,m\). Entonces la mejor estimación de \(\mu\), el valor medio del proceso, es el promedio de las observaciones, es decir

Media estimada

\[ \begin{equation} \hat{\mu} = \bar{x} = \frac{\sum_{i=1}^{m}x_i}{m} \end{equation}. \tag{4.62}\]

Mientras que acá, la estimación de \(\sigma\) es una función de los rangos móviles \(\textit{MR}_i\), con \(i= 2, 3, \dots, m\). Este estimador de \(\sigma\) es una adaptación del propuesto en la ecuación 4.11, el cual se obtiene sustituyendo en esa ecuación \(\bar{R}\) por \(\overline{\textit{MR}}\), \(m\) por \(m - 1\), ya que se obtienen \(m - 1\) rangos móviles de las \(m\) observaciones, y \(d_2\) por \(1,1284\), dado que de la Tabla A.1 del Apéndice A para \(n = 2\), \(d_2 = 1,1284\). Es decir,

\[ \begin{equation} \hat{\sigma}=\frac{\overline{\textit{MR}}}{1,1284} \end{equation}. \tag{4.63}\]

Donde \(\overline{\textit{MR}}\) es el promedio de los rangos móviles. Es decir,

\[ \begin{equation} \overline{\textit{MR}} = \frac{\sum_{i = 2}^{m} {\textit{MR}}_i}{m - 1}, \, i = 2, 3, \dots, m \end{equation}\:. \tag{4.64}\]

Luego, sustituyendo la ecuación 4.64 en la ecuación 4.63 se obtiene,

Estimador de \(\sigma\) basado en los rangos móviles

\[ \hat{\sigma} = \frac{\sum_{i=2}^{m}{\textit{MR}}_{i}}{1,128\left(m-1 \right)},\:i= 2, 3, \dots, m\:. \tag{4.65}\]

4.4.2.1 Diagrama de Control \(x\) Inicial

En base a los supuestos descritos anteriormente, los límites control tipo Shewart del diagrama \(x\) inicial se consiguen sustituyendo en la ecuación 4.59 \(\mu\) y \(\sigma\) por sus respectivos estimadores, dados en las ecuaciones 4.62 y 4.63. Es decir,

Límites de control inicial del diagrama \(x\)

\[ \begin{align*} LCS & = \bar{x} + 2,6596\, \overline{\textit{MR}} \\ LC & = \bar{x}\\ LCI & = \bar{x} - 2,6596\, \overline{\textit{MR}} \end{align*}\:. \tag{4.66}\]

4.4.2.2 Diagrama de Control \(\textit{MR}\) Inicial

Los límites de control tipo Shewhart para este diagrama se obtienen sustituyendo en la ecuación 4.61 \(\sigma\) por su estimador dado en la ecuación 4.63. Obteniendo el siguiente resultado,

Limites de control inicial del diagrama \(\textit{MR}\)

\[ \begin{align*} LCS & = 3,2677 \, \overline{\textit{MR}} \\ LC & = \overline{\textit{MR}} \\ LCI & = 0 \end{align*}. \tag{4.67}\]

4.4.3 Pasos para la Aplicación de los Diagramas de Control \(x\) y \(\textit{MR}\) en la Fase I

La aplicación de los diagramas de control \(x\) y \(\textit{MR}\) en el monitoreo del nivel medio y la desviación estándar de una característica de la calidad en un proceso de producción en la fase I se puede esquematizar en los siguientes pasos:

Tomar \(m\) observaciones de la característica de la calidad que se está monitoreando. Se recomienda que \(m \geq 20\).
Determinar el rango móvil de cada muestra a través de la ecuación 4.60. Los pasos 1 y 2 se pueden resumir en la siguiente tabla

Tabla 4.9: Resumen de datos en el diagrama \(x\) y \(MR\) en la fase I

Muestra	\(X_i\)	\(\textit{MR}_i\)
1	\(x_1\)	\(\textit{mr}_1\)
2	\(x_2\)	\(\textit{mr}_2\)
\(\vdots\)	\(\vdots\)	\(\vdots\)
\(i\)	\(x_i\)	\(\textit{mr}_i\)
\(\vdots\)	\(\vdots\)	\(\vdots\)
\(m-1\)	\(x_{m-1}\)	\(\textit{mr}_{m-1}\)
\(m\)	\(x_m\)	\(\textit{mr}_m\)

Estimar la media y la desviación estándar del proceso por medio de las ecuaciones 4.62 y 4.63.
Con las estimaciones de \(\mu\) y \(\sigma\) del paso anterior determinar los límites de control inicial de los diagramas \(x\) y \(MR\) usando las ecuaciones 4.66 y 4.67. Estos límites son considerados de prueba o preliminares.
Realizar las representaciones gráficas de los diagramas \(x\) y \(MR\).
Analizar el diagrama \(MR\). Si todos los puntos se ubican dentro de los límites de control es este diagrama y no se observa un patrón sistemático se pasa al paso 7. De lo contrario, si uno o más puntos se localizan fuera de los límites control en este diagrama, y suponiendo que estos tiene una causa atribuible, se eliminan del análisis y se reinicia el procedimiento a partir del paso 3. Estos límites control se les llama límites de control corregidos o revisados. Este siclo se repite hasta que todos los puntos se ubiquen dentro de los límites de control en el diagrama MR.
Analizar el diagrama \(x\), si todos los puntos se localizan dentro de los límites de control y no se observa un comportamiento sistemático en los datos se concluye que el proceso está bajo control estadístico tanto en media como en varianza y estos límites de control pueden ser usados para controlar la producción actual y futura. Si uno o más puntos se localizan fuera de los límites de control en este diagrama estos se eliminan del análisis y se reinicia el procedimiento a partir del paso 3.

Ejemplo 4.4 (Aplicación de los Diagramas de Control \(x\) y \(MR\))
La viscosidad de una pintura tapa poros para aviones es una característica de la calidad importante. El producto se produce por lotes, y debido a que la producción de cada lote se lleva varias horas, la velocidad de producción es demasiada lenta para permitir tamaños de la muestra mayores que uno. En la Tabla 4.10 se muestra la viscosidad de los quince lotes anteriores. Los datos fueron tomados de Montgomery (2005, 250).

Código

```{r}
#| label: tbl-datos-viscosidad
#| tbl-cap:  "Viscosidad de la pintura tapa poros para aviones para el ejercicio de aplicación del diagrama $x$ y $MR$ en la fase I"

viscosidad <- data.table::data.table(
  check.names = FALSE,
  tanda = c(
    1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 
    14L, 15L
  ),
  viscosidad = c(
    33.75, 33.05, 34, 33.81, 33.46, 34.02, 33.68, 33.27, 
    33.49, 33.2, 33.62, 33, 33.54, 33.12, 33.84
  )
) |>
  dplyr::mutate(
    MR = c(NA, abs(diff(viscosidad)))
  ) |>
  data.table::data.table()

options(
  reactable.language = reactableLang(
    searchPlaceholder = "Buscar",
    pageNext = "Siguiente",
    pagePrevious = "Anterior",
    noData = "Ninguna fila encontrada",
    pageInfo = "{rowStart} de {rowEnd} de {rows} filas"
  )
)

reactable::reactable(
  viscosidad,
  # defaultColDef = colDef(
  #   headerStyle = list(background = "#f7f7f8")
  # ),
  columns = list(
    tanda = colDef(header = "Número de tanda", align = "right"),
    viscosidad = colDef(
      header = "Viscocidad \\(\\left( x_{i} \\right) \\)", 
      align = "right",
      format = colFormat(
        separators = TRUE, digits = 2, locales = "es-ES"
      )
    ),
    MR = colDef(
      header = "Rango Móvil \\(\\left({MR}_{i}\\right)\\)", 
      align = "right",
      format = colFormat(
        separators = TRUE, digits = 2, locales = "es-ES"
      )
    )
  ),
  striped = TRUE,
  bordered = TRUE,
  highlight = TRUE,
  filterable = TRUE,
  minRows = 10
)
```

Tabla 4.10: Viscosidad de la pintura tapa poros para aviones para el ejercicio de aplicación del diagrama \(x\) y \(MR\) en la fase I

Para calcular los límites de control inicial de los diagramas \(x\) y \(MR\) se requiere previamente calcular la media de las 15 observaciones y la media de los rangos móviles, usando las ecuaciones 4.66 y 4.67. En este caso, \(\bar{x} = 33,5233\) y \(\overline{MR}=0,4807\).

Los limites de control del diagrama \(x\) inicial, según la ecuación 4.66, vienen dados por

\[ \begin{align*} LCS & = \bar{x} + 2,6596 \, \overline{MR} = 33,5233 + 2,6596\left( 0,4807 \right) = 34,8018\\ LC & = \bar{x} = 33,5233\\ LCI & = \bar{x} - 2,6596\, \overline{MR} = 33,5233 - 2,6596\left( 0,4807 \right) = 32,2448 \end{align*}. \]

El cálculo con de los límites de control del diagrama \(\bar{x}\) se muestra en el siguiente trozo de código.

Código

```{r}
#| label: lci-x

xbarra <- mean(viscosidad$viscosidad)
MRbarra <- mean(viscosidad$MR, na.rm = TRUE)
desviacion <- MRbarra / 1.128

lci <- xbarra - 2.6596 * MRbarra
lc <-  xbarra
lcs <- xbarra + 2.6596 * MRbarra
paste0("LCI = ", formato(lci), "    LC = ", formato(lc), "    LCS = ", formato(lcs))
```

#> [1] "LCI = 32,2448    LC = 33,5233    LCS = 34,8018"

Mientras que los limites de control del diagrama \(MR\) inicial, se obtienen como sigue, a partir de la ecuación 4.67,

\[ \begin{align*} LCS & = 3,2677 \, \overline{MR} = 3.2677 \left(0,4807 \right) = 1,5708\\ LC & = \overline{MR} = 0,4807\\ LCI & = 0 \end{align*}. \]

Los límites de control del diagrama \(MR\) con se muestra en el siguiente trozo de código.

Código

```{r}
#| label: lci-MR

lci_MR <- 0
lc_MR <- MRbarra
lcs_MR <- 3.2677 * MRbarra
paste0(
  "LCI = ", formato(lci_MR), "    LC = ", formato(lc_MR), "    LCS = ", formato(lcs_MR)
)
```

#> [1] "LCI = 0    LC = 0,4807    LCS = 1,5708"

En la Figura 4.35 se muestran los diagramas de control \(\bar{x}\) y \(MR\) en la fase inicial para la viscosidad de la pintura tapa poros para aviones.

Código

```{r}
#| label: fig-dcxMR-fase1
#| fig-cap: "Diagramas $\\bar{x}$ y $\\textit{MR}$ para el diámetro interior (mm) de los anillos en la fase inicial"
#| fig-subcap: 
#|   - "Diagrama $\\textit{MR}$"
#|   - "Diagrama $x$"
#| layout-ncol: 2

ggplot(
  data = viscosidad, 
  aes(x = tanda, y = MR)
) +
  geom_step(
    mapping = aes(x = tanda, y = lci_MR),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = tanda, y = lc_MR),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = tanda, y = lcs_MR),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(x = tanda, y = MR), color = "black"
  ) +
  geom_line(
    mapping = aes(x = tanda, y = MR), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci_MR, ymax = lc_MR), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc_MR, ymax = lcs_MR), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  annotate(
    "text", x = 15 + 0.9, y = lci_MR, 
    label = latex2exp::TeX("$LCI$"),
    colour = "red",
    parse = TRUE
  ) +
  annotate(
    "text", x = 15 + 0.75, y = lc_MR, 
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text", x = 15 + 0.9, y = lcs_MR, 
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Número de tanda", bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "${MR}_i$", bold = TRUE, italic = TRUE
    )
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 15, by = 2),
    limits = c(1, 16)
  ) +
  theme_bw()

ggplot(
  data = viscosidad, 
  aes(x = tanda, y = viscosidad)
) +
  geom_step(
    mapping = aes(x = tanda, y = lci),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = tanda, y = lc),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = tanda, y = lcs),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(x = tanda, y = viscosidad), color = "black"
  ) +
  geom_line(
    mapping = aes(x = tanda, y = viscosidad), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci, ymax = lc), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc, ymax = lcs), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  annotate(
    "text", x = 15 + 0.9, y = lci, 
    label = latex2exp::TeX("$LCI$"),
    colour = "red",
    parse = TRUE
  ) +
  annotate(
    "text", x = 15 + 0.75, y = lc, 
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text", x = 15 + 0.9, y = lcs, 
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Número de tanda", bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "$x_i$", bold = TRUE, italic = TRUE
    )
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 15, by = 2),
    limits = c(1, 16)
  ) +
  theme_bw()
```

Como se nota en la Figura 4.35 todos los puntos están bajo control y no se observa un comportamiento sistemático en los datos, tanto en el diagrama \(\textit{MR}\) como en el diagrama \(x\); por lo tanto se concluye que el proceso se encuentra bajo control tanto en su variabilidad como en su nivel medio. Y estos límites pueden se usados para controlar el nivel medio y la variabilidad de la viscosidad de la pintura tapa poros para aviones en la fase II.

Ahora se colectan 15 nuevos subgrupos, los cuales se muestran a la Tabla 4.11, y se procede a verificar si el proceso sigue manteniéndose bajo control estadístico, para ello se grafican estos nuevos subgrupos con los límites de control de la fase I (fase II)

Código

```{r}
#| label: tbl-datos-viscosidad-f2
#| tbl-cap:  "Viscosidad de la pintura tapa poros para aviones para el ejercicio de aplicación del diagrama $x$ y $\\textit{MR}$ en la fase II"

viscosidad_f2 <- data.table::data.table(
  check.names = FALSE,
  tanda = c(
    16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 
    27L, 28L, 29L, 30L
  ),
  viscosidad = c(
    33.50, 33.25, 33.40, 33.27, 34.65, 34.80, 34.55, 35.00,
    34.75, 34.50, 34.70, 34.29, 34.61, 34.49, 35.03
  )
) |>
  dplyr::mutate(
    MR = c(NA, abs(diff(viscosidad)))
  ) |>
  data.table::as.data.table()

options(
  reactable.language = reactableLang(
    searchPlaceholder = "Buscar",
    pageNext = "Siguiente",
    pagePrevious = "Anterior",
    noData = "Ninguna fila encontrada",
    pageInfo = "{rowStart} de {rowEnd} de {rows} filas"
  )
)

reactable::reactable(
  viscosidad_f2,
  # defaultColDef = colDef(
  #   headerStyle = list(background = "#f7f7f8")
  # ),
  columns = list(
    tanda = colDef(header = "Número de tanda", align = "right"),
    viscosidad = colDef(
      header = "Viscosidad \\(\\left( x_{i}\\right)\\)", 
      align = "right",
      format = colFormat(
        separators = TRUE, digits = 2, locales = "es-ES"
      )
    ),
    MR = colDef(
      header = "Rango Móvil \\( {M\\!R}_{i} \\)", 
      align = "right",
      format = colFormat(
        separators = TRUE, digits = 2, locales = "es-ES"
      )
    )
  ),
  striped = TRUE,
  bordered = TRUE,
  highlight = TRUE,
  filterable = TRUE,
  minRows = 10
)
```

Tabla 4.11: Viscosidad de la pintura tapa poros para aviones para el ejercicio de aplicación del diagrama \(x\) y \(\textit{MR}\) en la fase II

Código

```{r}
#| label: fig-dcxMR-fase2
#| fig-cap: "Diagramas $x$ y $\\textit{MR}$ para la viscosidad de la pintura tapa poros para aviones en la fase II"
#| fig-subcap:
#|   - "Diagrama $\\textit{MR}$"
#|   - "Diagrama $x$"
#| layout-ncol: 2

viscosidad_f2 <- dplyr::bind_rows(viscosidad, viscosidad_f2) 

# diagrama MR en la fase II
ggplot(
  data = dplyr::bind_rows(viscosidad, viscosidad_f2), 
  aes(x = tanda, y = MR)
) +
  geom_step(
    mapping = aes(x = tanda, y = lci_MR),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = tanda, y = lc_MR),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = tanda, y = lcs_MR),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(x = tanda, y = MR), color = "black", size = 2
  ) +
  geom_line(
    mapping = aes(x = tanda, y = MR), color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci_MR, ymax = lc_MR), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc_MR, ymax = lcs_MR), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  geom_vline(
    xintercept = (15 + 16) / 2, linetype = 2, color = "blue"
  ) +
  annotate(
    "text", x = 30 + 0.9, y = lci_MR, 
    label = latex2exp::TeX("$LCI$"),
    colour = "red",
    parse = TRUE
  ) +
  annotate(
    "text", x = 30 + 0.75, y = lc_MR, 
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text", x = 30 + 0.9, y = lcs_MR, 
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Número de tanda", bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "$MR_i$", bold = TRUE, italic = TRUE
    )
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 30, by = 2),
    limits = c(1, 31)
  ) +
  theme_bw()

# diagrama x en la fase II
obj_x <- qcc(
  viscosidad_f2$viscosidad, type = "c",  center = lc, 
  limits = c(lci, lcs), plot = FALSE
)
violacion <- purrr::as_vector(obj_x$violations)

viscosidad_f2 <- viscosidad_f2 |> 
  dplyr::mutate(
    violacion_x = dplyr::if_else(
      tanda %in% violacion, "Si", "No"
    )
  )

ggplot(
  data = viscosidad_f2, 
  aes(x = tanda, y = viscosidad)
) +
  geom_step(
    mapping = aes(x = tanda, y = lci),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_step(
    mapping = aes(x = tanda, y = lc),
    direction = "hv", color = "blue"
  ) +
  geom_step(
    mapping = aes(x = tanda, y = lcs),
    direction = "hv", color = "red", lty = "dashed"
  ) +
  geom_point(
    mapping = aes(
      x = tanda, y = viscosidad, 
      color = factor(violacion_x), 
      shape = factor(violacion_x)
    ), 
    size = 2
  ) +
  scale_color_manual(
    values = c(
      "No" = "black", "Si" = "red", show.legend = FALSE
    )
  ) +
  scale_shape_manual(values = c(16, 8)) + 
  geom_line(
    mapping = aes(x = tanda, y = viscosidad), 
    color = "black"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lci, ymax = lc), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  pammtools::geom_stepribbon(
    aes(ymin = lc, ymax = lcs), fill = "green", 
    alpha = 0.2, direction = "hv"
  ) +
  geom_vline(
    xintercept = (15 + 16) / 2, linetype = 2, 
    color = "blue"
  ) + 
  annotate(
    "text", x = 30 + 0.9, y = lci, 
    label = latex2exp::TeX("$LCI$"),
    colour = "red",
    parse = TRUE
  ) +
  annotate(
    "text", x = 30 + 0.75, y = lc, 
    label = latex2exp::TeX("$LC$"),
    colour = "blue"
  ) +
  annotate(
    "text", x = 30 + 0.9, y = lcs, 
    label = latex2exp::TeX("$LCS$"),
    colour = "red"
  ) +
  labs(
    x = latex2exp::TeX(
      "Numero de tanda", bold = TRUE, italic = TRUE
    ),
    y = latex2exp::TeX(
      "$x_i$", bold = TRUE, italic = TRUE
    ),
    shape = "Violación", color = "Violación"
  ) +
  scale_x_continuous(
    breaks = seq(from = 1, to = 30, by = 2),
    limits = c(1, 31)
  ) +
  theme_bw() +
  theme(
    legend.position = "bottom",
    legend.text = element_text(face = "bold"),
    legend.title = element_text(face = "bold"),
    legend.title.position = "top"
  ) 
```

Como se puede notar en la Figura 4.36, el diagrama \(\textit{MR}\) muestra que la variabilidad del proceso se mantiene bajo control en la fase II, mientras que el diagrama \(x\) muestra que ha ocurrido un cambio hacia arriba en la media del proceso.

A continuación se muestran los diagramas \(\bar{x}\) y \(R\) en las fases 1 y 2 con el paquete qcc.

Código

```{r}
#| label: fig-dcxMR-fase1y2-qcc
#| fig-cap: "Diagramas $\\bar{x}$ y $\\textit{MR}$ para la viscosidad de la pintura tapa poros en las fases 1 y 2 con el paquete `qcc`"
#| fig-subcap:
#|   - "Diagrama $\\textit{MR}$ inicial"
#|   - "Diagrama $x$ inicial"
#|   - "Diagrama $\\textit{MR}$ estándar"
#|   - "Diagrama $x$ estándar"
#| layout-ncol: 2

# Diagrama R en la fase I
MR <- qcc(
  viscosidad$MR[-1],
  type = "xbar.one", center = lc_MR,
  limits = c(lci_MR, lcs_MR), plot = FALSE
)
plot(
  MR,
  add.stats = FALSE, label.limits = c("LCI", "LCS"), 
  title = "", xlab = "Número de tanda", 
  ylab = latex2exp::TeX("$MR_i$"), chart.all = TRUE
)

# Diagrama xbarra en la fase I
x <- qcc(
  data = viscosidad$viscosidad, type = "xbar.one", 
  data.name = "Fase I", plot = FALSE
)
plot(
  x,
  add.stats = FALSE, label.limits = c("LCI", "LCS"), title = "",
  xlab = "Número de tanda", ylab = latex2exp::TeX("$x_i$"), chart.all = TRUE
)

# Diagrama R en la fase II
MR <- qcc(
  data = viscosidad_f2$MR[2:15], type = "xbar.one", plot = FALSE,
  data.name = "Fase I", newdata = viscosidad_f2$MR[17:30],
  newdata.name = "Fase II", center = lc_MR, limits = c(lci_MR, lcs_MR)
)
plot(
  MR,
  add.stats = FALSE, label.limits = c("LCI", "LCS"), title = "",
  xlab = "Número de tanda", ylab = latex2exp::TeX("$MR_i$"), chart.all = TRUE
)

# Diagrama xbarra en la fase II
x <- qcc(
  data = viscosidad_f2$viscosidad[1:15], type = "xbar.one", plot = FALSE,
  data.name = "Fase I", newdata = viscosidad_f2$viscosidad[16:30],
  newdata.name = "Fase II", center = lc, limits = c(lci, lcs)
)
plot(
  x,
  add.stats = FALSE, label.limits = c("LCI", "LCS"), title = "",
  xlab = "Número de tanda", ylab = latex2exp::TeX("$x_i$"), chart.all = TRUE
)
```

Con el siguiente bloque de código se muestran los diagramas \(\bar{x}\) y \(R\) en las fases 1 y 2 con el paquete highcharter.

Código

```{r}
#| label: fig-MRinicial-highcharter
#| fig-cap: "Diagrama $\\textit{MR}$ inicial para la viscosidad de la pintura tapa poros"

highchart() |>
  hc_add_series(
    data = viscosidad, 
    hcaes(x = tanda, low = lc_MR, high = lcs_MR),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, 
    name = "", color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = viscosidad, 
    hcaes(x = tanda, low = lci_MR, high = lc_MR),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, 
    name = "", color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = viscosidad, 
    type = "line", hcaes(x = tanda, y = lcs_MR), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = viscosidad,
    type = "line", hcaes(x = tanda, y = lc_MR), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = viscosidad, 
    type = "line", hcaes(x = tanda, y = lci_MR), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = viscosidad,
    type = "line", color = "black",
    hcaes(x = tanda, y = MR),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>MR<sub>i</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Número de tanda</b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Rango móvil (MR<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```
```{r}
#| label: fig-x-inicial-highcharter
#| fig-cap: "Diagramas$x$ incial para la viscosidad de la pintura tapa poros"

highchart() |>
  hc_add_series(
    data = viscosidad, 
    hcaes(x = tanda, low = lc, high = lcs),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = viscosidad, 
    hcaes(x = tanda, low = lci, high = lc),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, name = "", color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = viscosidad, 
    type = "line", hcaes(x = tanda, y = lcs), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = viscosidad,
    type = "line", hcaes(x = tanda, y = lc), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = viscosidad, 
    type = "line", hcaes(x = tanda, y = lci), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = viscosidad,
    type = "line", color = "black", 
    hcaes(x = tanda, y = viscosidad),
    marker = list(radius = 3),  useHTML = TRUE, 
    name = "<b><i>x<sub>i</sub></i></b>", dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Número de tanda</b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Viscosidad (x<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```
```{r}
#| label: fig-MRestandar-highcharter
#| fig-cap: "Diagrama $\\textit{MR}$ estándar para la viscosidad de la pintura tapa poros"

highchart() |>
  hc_add_series(
    data = viscosidad_f2,
    hcaes(x = tanda, low = lc_MR, high = lcs_MR),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, 
    name = "", color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = viscosidad_f2,
    hcaes(x = tanda, low = lci_MR, high = lc_MR),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, 
    name = "", color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = viscosidad_f2,
    type = "line", hcaes(x = tanda, y = lcs_MR), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = viscosidad_f2,
    type = "line", hcaes(x = tanda, y = lc_MR), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = viscosidad_f2,
    type = "line", hcaes(x = tanda, y = lci_MR), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = viscosidad_f2,
    type = "line", color = "black",
    hcaes(x = tanda, y = MR),
    marker = list(radius = 3), useHTML = TRUE,
    name = "<b><i>MR<sub>i</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Número de tanda</b><br>"
    ),
    plotLines = list(
      list(
        color = "grey", value = (15 + 16) / 2, 
        width = 2, dashStyle = "Dash"
      )
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Rango móvil (MR<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |>
  hc_plotOptions(series = list(animation = FALSE))
```
```{r}
#| label: fig-x-estandar-highcharter
#| fig-cap: "Diagrama $x$ estándar para la viscosidad de la pintura tapa poros"

color <- ifelse(
  viscosidad_f2$violacion_x == "Si", "#FF0000", "#0000FF"
)
symbol <- ifelse(
  viscosidad_f2$violacion_x == "Si", "triangle-down", "triangle"
)

highchart() |>
  hc_add_series(
    data = viscosidad_f2, 
    hcaes(x = tanda, low = lc, high = lcs),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, 
    name = "", color = "green",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = viscosidad_f2, 
    hcaes(x = tanda, low = lci, high = lc),
    step = "hv", marker = list(enabled = FALSE, visible = FALSE),
    type = "arearange", fillOpacity = 0.2, 
    name = "", color = "blue",
    showInLegend = FALSE, tooltip = list(pointFormat = "{NULL}")
  ) |>
  hc_add_series(
    data = viscosidad_f2, 
    type = "line", hcaes(x = tanda, y = lcs), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCS</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = viscosidad_f2,
    type = "line", hcaes(x = tanda, y = lc), useHTML = TRUE,
    color = "blue", name = "<b><i>LC</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = viscosidad_f2, 
    type = "line", hcaes(x = tanda, y = lci), useHTML = TRUE,
    color = "red", dashStyle = "Dash", name = "<b><i>LCI</b></i>",
    step = "hv", marker = list(enabled = FALSE),
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = viscosidad_f2,
    type = "line", color = "black", 
    hcaes(
      x = tanda, y = viscosidad,
      color = color
    ),
    marker = list(radius = 3),  useHTML = TRUE, 
    name = "<b><i>x<sub>i</sub></i></b>", dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Número de tanda</b><br>"
    ),
    plotLines = list(
      list(
        color = "grey", value = (15 + 16) / 2, 
        width = 2, dashStyle = "Dash"
      )
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>Viscosidad (x<sub>i</sub>)</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```

Figura 4.38: Diagrama \(\textit{MR}\) inicial para la viscosidad de la pintura tapa poros

Figura 4.39: Diagramas\(x\) incial para la viscosidad de la pintura tapa poros

Figura 4.40: Diagrama \(\textit{MR}\) estándar para la viscosidad de la pintura tapa poros

Figura 4.41: Diagrama \(x\) estándar para la viscosidad de la pintura tapa poros

Con el siguiente bloque de código se muestran los diagramas \(x\) y \(\textit{MR}\) en las fases 1 y 2 con el paquete plotly.

Código

```{r}
#| label: fig-MRinicial-plotly
#| fig-cap: "Diagrama $\\textit{MR}$ inicial para la viscosidad de la pintura tapa poros"

viscosidad %>%
  plot_ly(x = ~tanda) %>%
  add_lines(
    y = lcs_MR, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) %>%
  add_lines(
    y = lc_MR, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) %>%
  add_lines(
    y = lci_MR, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) %>%
  add_trace(
    y = ~MR,
    name = "<b><i>MR<sub>i</sub><b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = "black"),
    hovertemplate = paste(
      "<b><i>i = %{x}</i></b>",
      "<br><b><i>MR<sub>i</sub><b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) %>%
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Número de tanda</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Rango móvil (MR<sub>i</sub>)</i></b><br>",
      zeroline = FALSE
    )
  ) %>%
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```
```{r}
#| label: fig-x-inicial-plotly
#| fig-cap: "Diagrama $x$ inicial para la viscosidad de la pintura tapa poros"

viscosidad %>%
  plot_ly(x = ~tanda) %>%
  add_lines(
    y = lcs, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) %>%
  add_lines(
    y = lc, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) %>%
  add_lines(
    y = lci, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) %>%
  add_trace(
    y = ~viscosidad,
    name = "<b><i>Viscosidad<b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = "black"),
    hovertemplate = paste(
      "<b><i>n<sub>i</sub> = %{x}</i></b>",
      "<br><b><i>x<sub>i</sub><b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) %>%
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Número de tanda</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Viscosidad (x<sub>i</sub>)</i></b><br>",
      zeroline = FALSE
    )
  ) %>%
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```
```{r}
#| label: fig-MRestandar-plotly
#| fig-cap: "Diagrama $\\textit{MR}$ estándar para la viscosidad de la pintura tapa poros"

viscosidad_f2 %>%
  plot_ly(x = ~tanda) %>%
  add_lines(
    y = lcs_MR, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) %>%
  add_lines(
    y = lc_MR, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) %>%
  add_lines(
    y = lci_MR, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) %>%
  add_trace(
    y = ~MR,
    name = "<b><i>MR<sub>i</sub><b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = "black"),
    hovertemplate = paste(
      "<b><i>Número de tanda<sub>i</sub> = %{x}</i></b>",
      "<br><b><i>MR<sub>i</sub><b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) %>%
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Número de tanda</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Rango móvil (MR<sub>i</sub>)</i></b><br>",
      zeroline = FALSE
    )
  ) %>%
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```
```{r}
#| label: fig-x-estandar-plotly
#| fig-cap: "Diagrama $x$ estáandar para la viscosidad de la pintura tapa poros"

color <- ifelse(
  viscosidad_f2$violacion_x == "Si", "red", "black"
)
symbol <- ifelse(
  viscosidad_f2$violacion_x == "Si", "asterisk-open", "circle"
)

viscosidad_f2 %>%
  plot_ly(x = ~tanda) %>%
  add_lines(
    y = lcs, name = "<b><i>LCS</i></b>", line = list(
      shape = "hvh", color = "red", dash = "dash"
    ),
    hovertemplate = paste("<b><i>LCS = %{y:.2f}</i></b><br><extra></extra>"),
  ) %>%
  add_lines(
    y = lc, name = "<b><i>LC</i></b>", fill = "tonexty", 
    fillcolor = 'green', alpha = 0.2,
    hovertemplate = paste("<b><i>LC = %{y:.2f}</i></b><br><extra></extra>"),
    line = list(
      shape = "linear", color = "blue"
    )
  ) %>%
  add_lines(
    y = lci, name = "<b><i>LCI</i></b>", fill = "tonexty", 
    fillcolor = 'blue', alpha = 0.2,
    hovertemplate = paste(
      "<b><i>LCI = %{y:.2f}</i></b><br><extra></extra>"
    ),
    line = list(
      shape = "hvh", color = "red", dash = "dash"
    )
  ) %>%
  add_trace(
    y = ~viscosidad,
    name = "<b><i>Viscosidad<b><i>", type = "scatter",
    mode = "lines+markers",
    marker = list(color = color, symbol = symbol),
    hovertemplate = paste(
      "<b><i>n<sub>i</sub> = %{x}</i></b>",
      "<br><b><i>x<sub>i</sub><b><i> = %{y:.2f}<br><extra></extra>"
    ),
    line = list(color = "black", dash = "dash")
  ) %>%
  layout(
    legend = list(
      x = 0.5, y = -0.23, xref = 'paper', yref = 'paper',
      orientation = "h", xanchor = 'center', showarrow = F
    ),
    xaxis = list(
      title = "<b><i>Número de tanda</i></b><br>",
      zeroline = F
    ),
    yaxis = list(
      title = "<b><i>Viscosidad (x<sub>i</sub>)</i></b><br>",
      zeroline = FALSE
    )
  ) %>%
  plotly::config(locale = "es", mathjax = "cdn") |>
  fillOpacity(alpha = 0.3)
```

Figura 4.42: Diagrama \(\textit{MR}\) inicial para la viscosidad de la pintura tapa poros

Figura 4.43: Diagrama \(x\) inicial para la viscosidad de la pintura tapa poros

Figura 4.44: Diagrama \(\textit{MR}\) estándar para la viscosidad de la pintura tapa poros

Figura 4.45: Diagrama \(x\) estáandar para la viscosidad de la pintura tapa poros

4.5 La Función Característica de Operaciones del Diagrama \(\bar{x}\) (FCO)

La habilidad de un diagrama de control para detectar corrimientos en la calidad del proceso se describe por su curva característica de operación (CCO). Para construir la CCO se grafica el riesgo \(\beta\) (probabilidad del error tipo II) contra la magnitud del cambio que quiere detectarse.

Considérese la CCO de un diagrama \(\bar{x}\) con desviación estándar \(\sigma\) conocida y constante. Si la media se corre del valor bajo control \(\mu_0\) a otro valor fuera de control \(\mu_1 = \mu_0 + k\sigma\), la probabilidad de no detectar este cambio en la primera muestra subsecuente, o riesgo \(\beta\), es

\[ \begin{equation} \beta = P\left[LCI \leq \bar{X} \leq LCS \,\middle|\, \mu_1 = \mu_0 + k\sigma \right] \end{equation}. \tag{4.68}\]

Suponiendo que se monitorea una característica de la calidad la cual se distribuye normalmente, entonces \(\bar{X} \sim N(\mu,\,\sigma/\sqrt{n})\), y los límites de control inferior y superior del diagrama \(\bar{x}\) son \(LCI = \mu_0 - L \, \sigma⁄\sqrt{n}\) y \(LCS = \mu_0 + L \, \sigma⁄\sqrt{n}\), respectivamente, la ecuación 4.68 puede reescribirse como

\[ \beta = P\left[\mu_0 - L \, \frac{\sigma}{\sqrt{n}} \leq \bar{X} \leq \mu_0 + L \, \frac{\sigma}{\sqrt{n}}\,\middle|\, \mu_1 = \mu_0 + k\sigma \right] \]

Estandarizando \(\bar{X}\), se obtiene que,

\[ \beta = P\left[\frac{\mu_0 - L \, \frac{\sigma}{\sqrt{n}} - \left(\mu_0 + k\sigma \right)}{\frac{\sigma}{\sqrt{n}}} \leq Z \leq \frac{\mu_0 + L \, \frac{\sigma}{\sqrt{n}} - \left(\mu_0 + k\sigma \right)}{\frac{\sigma}{\sqrt{n}}} \right]. \] Simplificando la expresión anterior, resulta que,

\[ \beta = P\left[- L - k \sqrt{n} \leq Z \leq L - k \sqrt{n} \right]. \]

Por propiedad dela función de distribución de probabilidad acumulad,

\[ \beta = P\left[Z \leq L - k \sqrt{n} \right] - P\left[Z \leq - L - k \sqrt{n} \right]. \]

La ecuación anterior puede reescribirse de la siguiente manera,

\[ \begin{equation} \beta = \Phi\!\left( L - k \sqrt{n} \right) -\Phi\!\left(- L - k \sqrt{n} \right). \end{equation} \tag{4.69}\]

Donde \(\Phi\!(.)\) denota la función de distribución aculada normal estándar.

Para ilustrar la aplicación de la ecuación anterior ecuación 4.69, suponer que se está usando una carta \(\bar{x}\) con \(L = 3\) (los límites tres sigmas usuales), que el tamaño de la muestra es \(n = 5\) y que quiere determinarse la probabilidad de detectar un corrimiento a \(μ_1=μ_0+2σ\) en la primera muestra después del corrimiento. Entonces, puesto que \(L = 3\), \(k = 2\) y \(n = 5\), se tiene que

\[ β=\Phi\!\left[3 - 2 \sqrt{5} \right] - \Phi\!\left[ - 3 - 2\sqrt{5} \right] = \Phi\!\left[-1,4721\right] - \Phi\!\left[-7,4721\right] = 0,0705 \]

Es decir, la probabilidad de que el diagrama no detecte este corrimiento en la siguiente muestra después de haber ocurrido el cambio es 0,0705, por lo que la probabilidad de que el diagrama detecte este cambio es \(1 - β = 1 - 0,0705 = 0,9295\).

Para construir la Curva Característica de Operaciones CCO de la carta \(\bar{x}\) se grafica el riesgo \(\beta\) contra la magnitud del corrimiento que quiere detectarse expresado en unidades de desviaciones estándar dados los valores de \(L\), \(k\) y \(n\). En la Tabla 4.12 se muestran los valores de \(\beta\) para ciertos valores k y n, cuando se usan límites de control tres sigmas (\(L = 3\)); mientras que la Figura 4.46 muestran las CCO.

Código

```{r}
#| label: tbl-beta-dcxbarra
#| tbl-cap:  "Probabilidad de que el diagrama $\\bar{x}$ no detecte el estado fuera de Control $\\beta$, para diferentes valores de $k$ y $n$"

beta_dcxbarra <- tibble::tibble(
  k = seq(from = 0, to = 5, by = 0.5),
  beta_n1 = pnorm(3 - seq(from = 0, to = 5, by = 0.5) * sqrt(1)) -
    pnorm(-3 - seq(from = 0, to = 5, by = 0.5) * sqrt(1)),
  beta_n2 = pnorm(3 - seq(from = 0, to = 5, by = 0.5) * sqrt(2)) -
    pnorm(-3 - seq(from = 0, to = 5, by = 0.5) * sqrt(2)),
  beta_n3 = pnorm(3 - seq(from = 0, to = 5, by = 0.5) * sqrt(3)) -
    pnorm(-3 - seq(from = 0, to = 5, by = 0.5) * sqrt(3)),
  beta_n4 = pnorm(3 - seq(from = 0, to = 5, by = 0.5) * sqrt(4)) -
    pnorm(-3 - seq(from = 0, to = 5, by = 0.5) * sqrt(4)),
  beta_n5 = pnorm(3 - seq(from = 0, to = 5, by = 0.5) * sqrt(5)) -
    pnorm(-3 - seq(from = 0, to = 5, by = 0.5) * sqrt(5)),
  beta_n6 = pnorm(3 - seq(from = 0, to = 5, by = 0.5) * sqrt(6)) -
    pnorm(-3 - seq(from = 0, to = 5, by = 0.5) * sqrt(6)),
  beta_n10 = pnorm(3 - seq(from = 0, to = 5, by = 0.5) * sqrt(10)) -
    pnorm(-3 - seq(from = 0, to = 5, by = 0.5) * sqrt(10)),
  beta_n20 = pnorm(3 - seq(from = 0, to = 5, by = 0.5) * sqrt(20)) -
    pnorm(-3 - seq(from = 0, to = 5, by = 0.5) * sqrt(20)),
) |> data.table::setDT()

knitr::kable(
  beta_dcxbarra,
  format = "markdown",
  col.names = c(
    "$k$", "$\\beta_{n = 1}$", "$\\beta_{n = 2}$", "$\\beta_{n = 3}$",
    "$\\beta_{n = 4}$", "$\\beta_{n = 5}$", "$\\beta_{n = 6}$",
    "$\\beta_{n = 10}$", "$\\beta_{n = 20}$"
  ),
  digits = 4,
  format.args = list(decimal.mark = ",", big.mark = "."),
  escape = FALSE
)
```

Tabla 4.12: Probabilidad de que el diagrama \(\bar{x}\) no detecte el estado fuera de Control \(\beta\), para diferentes valores de \(k\) y \(n\)

\(k\)	\(\beta_{n = 1}\)	\(\beta_{n = 2}\)	\(\beta_{n = 3}\)	\(\beta_{n = 4}\)	\(\beta_{n = 5}\)	\(\beta_{n = 6}\)	\(\beta_{n = 10}\)	\(\beta_{n = 20}\)
0,0	0,9973	0,9973	0,9973	0,9973	0,9973	0,9973	0,9973	0,9973
0,5	0,9936	0,9890	0,9835	0,9772	0,9701	0,9621	0,9220	0,7775
1,0	0,9772	0,9436	0,8976	0,8413	0,7775	0,7090	0,4355	0,0705
1,5	0,9332	0,8102	0,6561	0,5000	0,3616	0,2501	0,0406	0,0001
2,0	0,8413	0,5681	0,3213	0,1587	0,0705	0,0288	0,0004	0,0000
2,5	0,6915	0,2961	0,0917	0,0228	0,0048	0,0009	0,0000	0,0000
3,0	0,5000	0,1070	0,0140	0,0013	0,0001	0,0000	0,0000	0,0000
3,5	0,3085	0,0256	0,0011	0,0000	0,0000	0,0000	0,0000	0,0000
4,0	0,1587	0,0039	0,0000	0,0000	0,0000	0,0000	0,0000	0,0000
4,5	0,0668	0,0004	0,0000	0,0000	0,0000	0,0000	0,0000	0,0000
5,0	0,0228	0,0000	0,0000	0,0000	0,0000	0,0000	0,0000	0,0000

La Figura 4.46 muestra que para tamaños de muestras típicos de cuatro y cinco y seis, la carta \(\bar{x}\) no es particularmente efectiva para detectar corrimientos pequeños (por ejemplo, aquellos por el orden \(1,5\sigma\) o menos) en la primera muestra después del corrimiento, lo que se evidencia en la parte resaltada de la Tabla 4.12. Por ejemplo, si el cambio es \(1\sigma\) y \(n = 5\), entonces de la tabla Tabla 4.12 se tiene \(\beta = 0,78\), aproximadamente. Por tanto, la probabilidad de que el corrimiento se detecte en la primera muestra siguiente después del cambio es tan sólo \(1 - \beta = 0,22\). Sin embargo, la probabilidad de que el corrimiento se detecte en la segunda muestra es \(\beta(1 - \beta)=0,78(0,22)=0,1716\), la probabilidad de que el diagrama detecte el corrimiento en la tercera muestra subsecuente es \(\beta^2 (1 - \beta)=(0,78)^2 (0,22)=0,1338\).

Código

```{r}
#| label: fig-beta-dcxbarra
#| fig-cap: "$CCO$ del diagrama $\\bar{x}$, para diferentes valores de k y n"

highchart() |>
  hc_add_series(
    data = beta_dcxbarra,
    type = "line", hcaes(x = k, y = beta_n1),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>&beta;<sub>n = 1</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = beta_dcxbarra,
    type = "line", hcaes(x = k, y = beta_n2),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>&beta;<sub>n = 2</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = beta_dcxbarra,
    type = "line", hcaes(x = k, y = beta_n3),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>&beta;<sub>n = 3</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = beta_dcxbarra,
    type = "line", hcaes(x = k, y = beta_n4),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>&beta;<sub>n = 4</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = beta_dcxbarra,
    type = "line", hcaes(x = k, y = beta_n5),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>&beta;<sub>n = 5</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = beta_dcxbarra,
    type = "line", hcaes(x = k, y = beta_n6),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>&beta;<sub>n = 6</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = beta_dcxbarra,
    type = "line", hcaes(x = k, y = beta_n10),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>&beta;<sub>n = 10</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = beta_dcxbarra,
    type = "line", hcaes(x = k, y = beta_n20),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>&beta;<sub>n = 20</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(useHTML = TRUE, text = "<b><i>k</b><br>"),
    min = 0, max = 5
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>&beta;</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE) )
```

Figura 4.46: \(CCO\) del diagrama \(\bar{x}\), para diferentes valores de k y n

De manera general si se define la variable aleatoria \(M\) como el número de muestras inspeccionadas hasta que el diagrama detecta el estado fuera de control una vez que este ha ocurrido, la probabilidad de que el diagrama detecte el estado fuera de control en la m-ésima muestra es \(\beta^{m - 1} (1-\beta) = (1 - \beta) \beta^{m - 1}\), es decir

\[ \begin{equation} p\!\left (m, \beta \right ) = \begin{cases} \left ( 1 - \beta \right )\beta^{m - 1}, & \text{ si }\; m = 1, 2, \dots \text{y}\;0<\beta<1\\ 0, & \text{ en otros casos } \end{cases} \end{equation}. \tag{4.70}\]

Por otro lado, la probabilidad de que el diagrama detecte el corrimiento a los más en la m-ésima muestra después de haber ocurrido el cambio viene dada por la función de distribución acumulada de \(M\), la cual viene dada por

\[ \begin{equation} F\!\left (m, \beta \right ) = \begin{cases} 0, & \text{ si }\; m < 1 \\ \sum_{i=1}^{m}\left ( 1 - \beta \right )\beta^{i - 1}, & \text{ en otros casos } \end{cases} \end{equation}. \] Como

\[ \sum_{i=1}^{m} \left( 1 - \beta \right )\beta^{i - 1} = \left( 1 - \beta \right )\sum_{i=1}^{m} \beta^{i - 1}, \]

Se puede notar que la sumatoria ubicada en el miembro derecho de la ecuación anterior converge; ya que se corresponde con la suma de los \(m\) términos de una serie geométrica que comienza en uno y tiene razón \(\beta\). Por lo que

\[ \sum_{i=1}^{m} \left( 1 - \beta \right )\beta^{i - 1} = \left( 1 - \beta \right ) \frac{1 - \beta^m}{1 - \beta} \]

En base a lo anterior la función de distribución acumulada de m se puede reescribir como

\[ \begin{equation} F\!\left (m, \beta \right ) = \begin{cases} 0, & \text{ si }\; m < 1 \\ 1 - \beta^m, & \text{ si }\; m = 1, 2, \dots \text{y}\;0<\beta<1 \end{cases} \end{equation}. \tag{4.71}\]

Una medida importante de la efectividad de un diagrama de control es la longitud media de corrida fuera de control (\({LMC}_1\)) la cual representa el número de muestras, en promedio, que se requieren inspeccionar para que el diagrama detecte un corrimiento en el proceso una vez que este ha ocurrido, y esta viene dada por el valor esperado de \(M\), es decir

\[ \begin{align} {LMC}_1 & = E \left( M \right) = \sum_{m=1}^{\infty}m \left( 1 - \beta \right )\beta^{m - 1} = \left( 1 - \beta \right ) \sum_{m=1}^{\infty}m \beta^{m - 1}\\ & = \left( 1 - \beta \right )\frac{\mathrm{d}}{\mathrm{d} x} \left(\sum_{m=1}^{\infty}\beta^m \right) = \left( 1 - \beta \right )\frac{\mathrm{d}}{\mathrm{d} x} \left( \frac{\beta}{1 - \beta} \right) \end{align} \]

(El intercambio de derivadas y sumatorias se justifica aquí puesto que se trata de una serie geométrica que converge para \(\lvert \beta \rvert<1\)). Siguiendo con la demostración,

\[ {LMC}_1 = \left( 1 - \beta \right ) \frac{\left( 1 - \beta \right ) - \beta(-1)}{\left( 1 - \beta \right )^2} = \frac{1}{\left( 1 - \beta \right )} \]

En resumen,

\[ \begin{equation} {LMC}_1 = \frac{1}{\left( 1 - \beta \right )} \end{equation}. \tag{4.72}\]

En la Tabla 4.13 se muestran las longitudes medias de corridas fuera de control para a probabilidad del error tipo II mostradas en la Tabla 4.12.

Código

```{r}
#| label: tbl-lmc_dcxbarra
#| tbl-cap:  "${LMC}_1$ del diagrama $\\bar{x}$ para diferentes valores de $k$ y $n$"

lmc_dcxbarra <- tibble::tibble(
  k = seq(from = 0, to = 5, by = 0.5),
  lmc_n1 = 1 / (1 - beta_dcxbarra$beta_n1),
  lmc_n2 = 1 / (1 - beta_dcxbarra$beta_n2),
  lmc_n3 = 1 / (1 - beta_dcxbarra$beta_n3),
  lmc_n4 = 1 / (1 - beta_dcxbarra$beta_n4),
  lmc_n5 = 1 / (1 - beta_dcxbarra$beta_n5),
  lmc_n6 = 1 / (1 - beta_dcxbarra$beta_n6),
  lmc_n10 = 1 / (1 - beta_dcxbarra$beta_n10),
  lmc_n20 = 1 / (1 - beta_dcxbarra$beta_n20)
) |> data.table::setDT()

knitr::kable(
  lmc_dcxbarra,
  format = "markdown",
  col.names = c(
  "$k$", "${LMC}_{n = 1}$", "${LMC}_{n = 2}$", "${LMC}_{n = 3}$", 
  "${LMC}_{n = 4}$", "${LMC}_{n = 5}$", "${LMC}_{n = 6}$", 
  "${LMC}_{n = 10}$", "${LMC}_{n = 20}$"
  ), 
  digits = 4,
  format.args = list(decimal.mark = ",", big.mark = "."), 
  escape = FALSE
)
```

Tabla 4.13: \({LMC}_1\) del diagrama \(\bar{x}\) para diferentes valores de \(k\) y \(n\)

\(k\)	\({LMC}_{n = 1}\)	\({LMC}_{n = 2}\)	\({LMC}_{n = 3}\)	\({LMC}_{n = 4}\)	\({LMC}_{n = 5}\)	\({LMC}_{n = 6}\)	\({LMC}_{n = 10}\)	\({LMC}_{n = 20}\)
0,0	370,3983	370,3983	370,3983	370,3983	370,3983	370,3983	370,3983	370,3983
0,5	155,2242	90,6462	60,6879	43,8947	33,4008	26,3575	12,8251	4,4953
1,0	43,8947	17,7308	9,7648	6,3030	4,4953	3,4366	1,7716	1,0758
1,5	14,9677	5,2690	2,9081	2,0000	1,5665	1,3335	1,0424	1,0001
2,0	6,3030	2,3154	1,4734	1,1886	1,0758	1,0296	1,0004	1,0000
2,5	3,2411	1,4207	1,1010	1,0233	1,0048	1,0009	1,0000	1,0000
3,0	2,0000	1,1198	1,0142	1,0014	1,0001	1,0000	1,0000	1,0000
3,5	1,4462	1,0263	1,0011	1,0000	1,0000	1,0000	1,0000	1,0000
4,0	1,1886	1,0040	1,0000	1,0000	1,0000	1,0000	1,0000	1,0000
4,5	1,0716	1,0004	1,0000	1,0000	1,0000	1,0000	1,0000	1,0000
5,0	1,0233	1,0000	1,0000	1,0000	1,0000	1,0000	1,0000	1,0000

Como se puede notar en la Tabla 4.13 la longitud media de corrida fuera de control disminuye en la medida que el tamaño de la muestra y el cambio que se desea detectar aumenta. Aunque para tamaños de muestras típicos (\(3 \leq n \leq 6\)) y un cambio en la media relativamente pequeño (menor a \(1,5\sigma\)) la longitud media de corrida fuera de control es relativamente grande. Esto se evidencia en la Figura 4.47.

Código

```{r}
#| label: fig-lmc-dcxbarra
#| fig-cap: "${LMC}_1$ del diagrama $\\bar{x}$, para diferentes valores de $k$ y $n$"

highchart() |>
  hc_add_series(
    data = lmc_dcxbarra,
    type = "line", hcaes(x = k, y = lmc_n1),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>LMC<sub>n = 1</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = lmc_dcxbarra,
    type = "line", hcaes(x = k, y = lmc_n2),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>LMC<sub>n = 2</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = lmc_dcxbarra,
    type = "line", hcaes(x = k, y = lmc_n3),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>LMC<sub>n = 3</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = lmc_dcxbarra,
    type = "line", hcaes(x = k, y = lmc_n4),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>LMC<sub>n = 4</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = lmc_dcxbarra,
    type = "line", hcaes(x = k, y = lmc_n5),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>LMC<sub>n = 5</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = lmc_dcxbarra,
    type = "line", hcaes(x = k, y = lmc_n6),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>LMC<sub>n = 6</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = lmc_dcxbarra,
    type = "line", hcaes(x = k, y = lmc_n10),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>LMC<sub>n = 10</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_add_series(
    data = lmc_dcxbarra,
    type = "line", hcaes(x = k, y = lmc_n20),
    marker = list(radius = 3),useHTML = TRUE, 
    name = "<b><i>LMC<sub>n = 20</sub></i></b>",
    dashStyle = "Dash",
    tooltip = list(valueDecimals = 2)
  ) |>
  hc_xAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>k</b><br>"
    )
  ) |>
  hc_yAxis(
    title = list(
      useHTML = TRUE,
      text = "<b><i>LMC</i></b><br>"
    )
  ) |>
  hc_tooltip(crosshairs = TRUE, shared = TRUE) |> 
  hc_plotOptions(series = list(animation = FALSE))
```

Figura 4.47: \({LMC}_1\) del diagrama \(\bar{x}\), para diferentes valores de \(k\) y \(n\)

Otra medida de la efectividad de un diagrama de control es la longitud media de corrida bajo control (\({LMC}_0\)) la cual se define como el número de muestras en promedio para que el diagrama envíe una señal de falsa alarma. Supóngase que el proceso funciona bajo control y que la probabilidad de que el diagrama envíe una señal de falsa alarma es \(\alpha\). Siguiendo un procedimiento análogo al establecido para establecer la longitud media de corrida fuera de control se puede determinar que la probabilidad de que el diagrama envíe una señal de falsa alarma en la m-ésima muestra es

\[ \begin{equation} p\!\left (m, \beta \right ) = \begin{cases} \alpha\left ( 1 - \alpha \right )^{m-1}, & \text{ si }\; m = 1, 2, \dots \text{y}\;0<\alpha<1\\ 0, & \text{ en otros casos } \end{cases} \end{equation}. \tag{4.73}\]

Y la probabilidad de que el diagrama envíe una señal de falsa alarma a lo más en la muestra m , viene dada por

\[ \begin{equation} F\!\left (m, \alpha \right ) = \begin{cases} 0, & \text{ si }\; m < 1 \\ 1 - \left( 1 - \alpha \right)^m, & \text{ si }\; m = 1, 2, \dots \text{y}\;0 < \alpha < 1 \end{cases} \end{equation}. \tag{4.74}\]

Mientras que la longitud media de corrida bajo control bajo control viene dada por

\[ \begin{equation} {LMC}_1 = \frac{1}{\alpha} \end{equation}. \tag{4.75}\]

Si la variable que se monitorea es normal, entonces

\[ \alpha = 1 - P\left[\mu_0 - L \, \frac{\sigma}{\sqrt{n}} \leq \bar{X} \leq \mu_0 + L \, \frac{\sigma}{\sqrt{n}} \middle| \, \mu = \mu_0 \right] \]

Estandarizando \(\bar{X}\), se obtiene que,

\[ \alpha = 1 -P\left[\frac{\mu_0 - L \, \frac{\sigma}{\sqrt{n}} -\mu_0}{\frac{\sigma}{\sqrt{n}}} \leq Z \leq \frac{\mu_0 + L \, \frac{\sigma}{\sqrt{n}} - \mu_o}{\frac{\sigma}{\sqrt{n}}} \right]. \] Simplificando la expresión anterior, resulta que,

\[ \alpha = 1 - P\left[- L \leq Z \leq L \right]. \]

Por propiedad dela función de distribución de probabilidad acumulad,

\[ \alpha = 1 - P\left[Z \leq L \right] + P\left[Z \leq - L \right]. \]

La ecuación anterior puede reescribirse de la siguiente manera,

\[ \begin{equation} \alpha = 1 - \Phi\!\left( L \right) + \Phi\!\left( - L \right). \end{equation} \tag{4.76}\]

Note de la ecuación 4.76, que la tasa de falsa alarma no depende del tamaño de la muestra \(n\). De tal manera que para \(L = 3\), estoces

\[ \alpha = 1 - \Phi\!\left( 3 \right) + \Phi\!\left( - 3 \right) = 1 - 0,9987 + 0,0013 = 0,0027 . \]

De lo anterior, la longitud media de corrida bajo control \({LMC}_0\), es

\[ \begin{equation} {LMC}_0 = \frac{1}{\alpha}= \frac{1}{0,9973} = 370,3983 \end{equation}. \]

Es decir, si la característica de la calidad que se monitorea es normal, se espera que el diagrama \(\bar{x}\) envíe una señal de falsa alarma, en promedio, cada 370 muestra aproximadamente.