library(openxlsx)
library(qcc)
library(ggplot2)
library(plotly)
library(readxl)
library(knitr)

Punto 1

En una empresa en la que se fabrican corcholatas o tapas metálicas para bebidas gaseosas, un aspecto importante es la cantidad de PVC que lleva cada corcholata, el cual determina el espesor de la película que hace que la bebida quede bien cerrada. El peso de los gránulos de PVC debe estar entre 212 y 218 mg. Si el peso es menor a 212, entonces, entre otras cosas, la película es muy delgada y eso puede causar fugas de gas en la bebida. Pero si el peso es mayor a 218 g, entonces se gasta mucho PVC y aumentan los costos. Para asegurar que se cumple con especifi caciones, de manera ordinaria se usa una carta de control: cada 30 minutos se toma una muestra de cuatro gránulos consecutivos de PVC y se pesan. En la tabla se muestran las últimas 25 medias y los rangos obtenidos del proceso.

a) Calcule los límites de una carta X-R y obtenga las cartas.

b) Interprete las cartas (puntos fuera, tendencias, ciclos, etcétera).

c) ¿El proceso muestra una estabilidad o estado de control estadístico razonable?

datos_1 <- read_excel("Prueba corta 2.xlsx", sheet = "Punto 1")
datos_1 <- as.data.frame(lapply(datos_1, function(x) as.numeric(as.character(x))))

# Eliminar filas vacías o con NA
datos_1 <- datos_1[!is.na(datos_1$MEDIA) & !is.na(datos_1$RANGO), ]

# Cálculo de promedios generales
media_general_1 <- mean(datos_1$MEDIA, na.rm = TRUE)
rango_promedio_1 <- mean(datos_1$RANGO, na.rm = TRUE)

# Tamaño de muestra
n <- 4
A2 <- 0.729  # valor del factor de control para n = 4
D3 <- 0
D4 <- 2.282

# Límites de control X̄
LSCx_1 <- media_general_1 + A2 * rango_promedio_1
LICx_1 <- media_general_1 - A2 * rango_promedio_1

# Límites de control R
LSCR_1 <- D4 * rango_promedio_1
LICR_1 <- D3 * rango_promedio_1


tabla_xbar_1 <- data.frame(
  Límite = c("LCS", "LC", "LIC"),
  Valor = c(media_general_1, LSCx_1, LICx_1)
)

tabla_r_1 <- data.frame(
  Límite = c("LCS", "LC", "LIC"),
  Valor = c(rango_promedio_1, LSCR_1, LICR_1)
)

kable(tabla_xbar_1, caption = "Límites de Control para X̄", digits = 3)
Límites de Control para X̄
Límite Valor
LCS 215.406
LC 216.963
LIC 213.848 
kable(tabla_r_1, caption = "Límites de Control para R", digits = 3)
Límites de Control para R
Límite Valor
LCS 2.136
LC 4.874
LIC 0.000


Gráfico de control X

xbar_chart_1 <- qcc(
  data = datos_1$MEDIA,
  type = "xbar.one",
  center = media_general_1,
  limits = c(LICx_1, LSCx_1),
  title = "Gráfico de Control X̄ - Punto 1",
  xlab = "Subgrupos",
  ylab = "Media",
  data.name = "Medias del Excel (Punto 1)"
)


En la carta de medias (X̄), se observan algunos puntos fuera de los límites de control, lo que indica la presencia de causas especiales que afectan la media del proceso. No se evidencian tendencias ni ciclos, pero estos puntos demuestran que el proceso no está completamente estable.


Gráfico de control R

r_chart_1 <- qcc(
  data = datos_1$RANGO,
  type = "xbar.one",  # se usa xbar.one si cada fila representa un solo valor de rango
  center = rango_promedio_1,
  limits = c(LICR_1, LSCR_1),
  title = "Gráfico de Control R - Punto 1",
  xlab = "Subgrupos",
  ylab = "Rango",
  data.name = "Rangos del Excel (Punto 1)"
)


En la carta R, todos los puntos se encuentran dentro de los límites de control y no se observan tendencias ni patrones, lo cual indica que la variabilidad del proceso está bajo control.

c) El proceso no muestra un estado de control estadístico razonable. Aunque la variabilidad (carta R) está bajo control (todos los rangos están dentro de los límites) y la carta de medias (X̄) presenta dos puntos fuera de control (subgrupos 7 y 9), sugiere que el sistema debe revisarse antes de continuar con la producción.


Punto 2

En el caso de la longitud de las bolsas del ejercicio 11, se decide emplear una carta de control X-R utilizando un tamaño de subgrupo de cinco, en donde se toman cinco bolsas consecutivas cada determinado tiempo. En la tabla se muestran las medias y los rangos de los últimos 40 subgrupos (los datos están en milímetros).

a) Calcule los límites de una carta X-R y obtenga las cartas.

b) Interprete las cartas (puntos fuera, tendencias, ciclos, alta variabilidad, etcétera).

datos_2 <- read_excel("Prueba corta 2.xlsx", sheet = "Punto 2")

datos_2 <- as.data.frame(lapply(datos_2, function(x) as.numeric(as.character(x))))

datos_2 <- datos_2[!is.na(datos_2$Media), ]


Gráfico de control X

media_central_2 <- mean(datos_2$LC_Media, na.rm = TRUE)
lsc <- mean(datos_2$LSC_Media, na.rm = TRUE)
lic <- mean(datos_2$LIC_Media, na.rm = TRUE)

tabla_xbar_2 <- data.frame(
  Límite = c("LCS", "LC", "LIC"),
  Valor = c(media_central_2, lsc, lic)
)

kable(tabla_xbar_2, caption = "Límites de Control para X̄", digits = 3)
Límites de Control para X̄
Límite Valor
LCS 300.775
LC 302.280
LIC 299.270 
if (any(!is.finite(c(lic, media_central_2, lsc)))) {
  stop("⚠️ Los límites de control contienen valores no numéricos o NA. Revisa las columnas del Excel.")
}

xbar_chart_2 <- qcc(
  data = datos_2$Media,
  type = "xbar.one",
  center = media_central_2,
  limits = c(lic, lsc),
  title = "Gráfico de Control X̄ - Volumen de llenado",
  xlab = "Muestra",
  ylab = "Promedio (cc)",
  data.name = "Medias del Excel"
)


En la carta de medias se observan algunos puntos fuera de los límites de control, como los subgrupos 10, 11, 22 y 39. Esto indica que el proceso presenta causas especiales de variación, ya que los promedios no se mantienen estables. Aunque no hay una tendencia marcada, sí se notan oscilaciones que podrían reflejar cambios cíclicos. En general, el proceso no está completamente bajo control, por lo que conviene revisar los subgrupos fuera de los límites.


Gráfico de control R

media_central_R_2 <- mean(datos_2$LC_Rango, na.rm = TRUE)
lsc_R_2 <- mean(datos_2$LSC_Rango, na.rm = TRUE)
lic_R_2 <- mean(datos_2$LIC_Rango, na.rm = TRUE)

tabla_r_2 <- data.frame(
  Límite = c("LCS", "LC", "LIC"),
  Valor = c(media_central_R_2, lsc_R_2, lic_R_2)
)

kable(tabla_r_2, caption = "Límites de Control para R", digits = 3)
Límites de Control para R
Límite Valor
LCS 2.610
LC 5.512
LIC 0.000 
if (any(!is.finite(c(lic_R_2, media_central_R_2, lsc_R_2)))) {
  stop("⚠️ Los límites de control del gráfico R contienen NA o valores no numéricos. Revisa las columnas del Excel.")
}

r_chart_2 <- qcc(
  data = datos_2$Rango,
  type = "xbar.one",  # Si cada fila representa el rango promedio de una muestra
  center = media_central_R_2,
  limits = c(lic_R_2, lsc_R_2),  # Orden correcto: (LIC, LSC)
  title = "Gráfico de Control R - Volumen de llenado",
  xlab = "Muestra",
  ylab = "Rango (cc)",
  data.name = "Rangos del Excel"
)


En la carta de rangos no aparecen puntos fuera de control, lo que indica que la variabilidad del proceso es estable. Los rangos se mantienen cercanos a la media y no muestran tendencias importantes, por lo que se puede decir que la dispersión de los datos es constante. En resumen, aunque la media presenta anomalías, la variabilidad interna del proceso está controlada.


Punto 3

Con los primeros 50 datos que se presentan a continuación, diseñar un gráfico de control para la variable peso (el valor nominal de la variable es 500g ±7 g. Y a partir del gráfico diseñado, graficar los siguientes 30 datos y definir si el proceso se encuentra o no en control estadístico.

datos_3 <- read_excel("Prueba corta 2.xlsx", sheet = "Punto 3")
datos_3 <- as.data.frame(lapply(datos_3, function(x) as.numeric(as.character(x))))

# Eliminar filas con NA
datos_3 <- datos_3[!is.na(datos_3$MEDIA) & !is.na(datos_3$RANGO), ]

# Parámetros
n <- 5
A2 <- 0.577
D3 <- 0
D4 <- 2.114

#Cálculos
media_general_3 <- mean(head(datos_3$MEDIA, 50), na.rm = TRUE)
rango_promedio_3 <- mean(head(datos_3$RANGO, 50), na.rm = TRUE)

# Límites de control para la media
LSCx_3 <- media_general_3 + A2 * rango_promedio_3
LICx_3 <- media_general_3 - A2 * rango_promedio_3

# Límites de control para el rango
LSCR_3 <- D4 * rango_promedio_3
LICR_3 <- D3 * rango_promedio_3

tabla_xbar_3 <- data.frame(
  Límite = c("LCS", "LC", "LIC"),
  Valor = c(media_general_3, LSCx_3, LICx_3)
)

tabla_r_3 <- data.frame(
  Límite = c("LCS", "LC", "LIC"),
  Valor = c(rango_promedio_3, LSCR_3, LICR_3)
)

kable(tabla_xbar_3, caption = "Límites de Control para X̄", digits = 3)
Límites de Control para X̄
Límite Valor
LCS 503.916
LC 510.586
LIC 497.246 
kable(tabla_r_3, caption = "Límites de Control para R", digits = 3)
Límites de Control para R
Límite Valor
LCS 11.560
LC 24.438
LIC 0.000


Gráfico de control X

xbar_chart_3 <- qcc(
  data = datos_3$MEDIA,
  type = "xbar.one",
  center = media_general_3,
  limits = c(LICx_3, LSCx_3),
  title = "Gráfico de Control X̄ - Punto 3",
  xlab = "Muestras",
  ylab = "Media",
  data.name = "Medias del Excel (Punto 3)"
)


Con base al gráfico X se puede observar que el proceso se encuentra fuera de control, ya que presenta el patrón de puntos fuera de los límites de control. Este punto está ubicado a X = 20 y Y = 511, sabiendo que el límite superior (LSC) tiene Y = 510,586.


Gráfico de control R

r_chart_3 <- qcc(
  data = datos_3$RANGO,
  type = "xbar.one",  # Cada fila representa un valor de rango
  center = rango_promedio_3,
  limits = c(LICR_3, LSCR_3),
  title = "Gráfico de Control R - Punto 3",
  xlab = "Muestras",
  ylab = "Rango",
  data.name = "Rangos del Excel (Punto 3)"
)


Por otro lado, en el gráfico R se identificó una secuencia partiendo de X=10 a X=17 (8 puntos) que se mantienen en la mitad superior de la línea central, lo que significa que el proceso no se encuentra bajo control.

  • Por lo anterior, el proceso no se encuentra en control estadístico, ya que tanto el gráfico de medias (X) como el gráfico de rangos (R) presentan alteraciones que afectan la estabilidad del proceso.


Punto 4

Definir los límites de control para controlar la variable volumen de llenado, de acuerdo con los siguientes datos, tomados de 35 muestras del último turno. Construir el gráfico respectivo. El valor nominal de la variable es 600 cc.

datos_4 <- read_excel("Prueba Corta 2.xlsx", sheet = "Punto 4")

datos_4 <- datos_4[, c("Muestra", "X1", "X2", "X3", "X4", "X5", "X6")]

datos_4 <- datos_4[1:35, ]

datos_4[,-1] <- lapply(datos_4[,-1], function(x) {
  x <- gsub(",", ".", as.character(x))    
  x <- gsub("[^0-9.-]", "", x)            
  as.numeric(x)
})

muestras <- as.matrix(datos_4[, -1])

medias_4 <- apply(muestras, 1, function(x) mean(x, na.rm = TRUE))
rangos_4 <- apply(muestras, 1, function(x) max(x, na.rm = TRUE) - min(x, na.rm = TRUE))

xbar_bar <- mean(medias_4)
R_bar <- mean(rangos_4)

A2 <- 0.483
D3 <- 0.000
D4 <- 2.004

LCS_xbar <- xbar_bar + A2 * R_bar
LIC_xbar <- xbar_bar - A2 * R_bar
LCS_R <- D4 * R_bar
LIC_R <- D3 * R_bar

tabla_xbar <- data.frame(
  Límite = c("LCS", "LC", "LIC"),
  Valor = c(LCS_xbar, xbar_bar, LIC_xbar)
)

tabla_r <- data.frame(
  Límite = c("LCS", "LC", "LIC"),
  Valor = c(LCS_R, R_bar, LIC_R)
)

kable(tabla_xbar, caption = "Límites de Control para X̄", digits = 3)
Límites de Control para X̄
Límite Valor
LCS 603.359
LC 600.571
LIC 597.784 
kable(tabla_r, caption = "Límites de Control para R", digits = 3)
Límites de Control para R
Límite Valor
LCS 11.566
LC 5.771
LIC 0.000


Gráfico de control X

# === 1️⃣ Gráfico clásico con qcc ===
qcc_xbar <- qcc(
  data = muestras,
  type = "xbar",
  center = xbar_bar,
  limits = c(LIC_xbar, LCS_xbar),
  title = "Gráfico de Control X̄ - Volumen de Llenado",
  xlab = "Muestra",
  ylab = "Promedio"
)

# === 2️⃣ Gráfico con ggplot y línea nominal ===

# Crear data frame a partir del objeto qcc
df_qcc <- data.frame(
  Muestra = 1:length(qcc_xbar$statistics),
  Media = as.numeric(qcc_xbar$statistics)
)

# Límites
lcl <- qcc_xbar$limits[1]
ucl <- qcc_xbar$limits[2]
center <- qcc_xbar$center

# === Gráfico base con ggplot2 ===
grafico_interactivo <- ggplot(df_qcc, aes(x = Muestra, y = Media)) +
  geom_line(color = "darkblue") +
  geom_point(aes(text = paste("Muestra:", Muestra,
                              "<br>Media:", round(Media, 3))),
             size = 2, color = "darkblue") +
  
  # Líneas de control
  geom_hline(yintercept = center, color = "forestgreen", linetype = "solid", linewidth = 1.1) +
  geom_hline(yintercept = ucl, color = "red", linetype = "dashed", linewidth = 1) +
  geom_hline(yintercept = lcl, color = "red", linetype = "dashed", linewidth = 1) +
  
  # Línea nominal
  geom_hline(yintercept = 600, color = "red", linetype = "dotted", linewidth = 1) +
  annotate("text", x = 2, y = 600.2, label = "Línea nominal 600 cc", color = "red", hjust = 0) +
  
  labs(
    title = "Gráfico de Control X̄ - Volumen de Llenado (Interactivo)",
    x = "Muestra",
    y = "Promedio (cc)"
  ) +
  theme_minimal(base_size = 13)

# === 3️⃣ Convertir a interactivo con plotly ===
grafico_final <- ggplotly(grafico_interactivo, tooltip = "text")

grafico_final


Gráfico de control R

qcc_r <- qcc(
  data = muestras,
  type = "R",
  center = R_bar,
  limits = c(LIC_R, LCS_R),
  title = "Gráfico de Control R - Volumen de Llenado",
  xlab = "Muestra",
  ylab="Rango"
)


El proceso de llenado está bajo control, ya que no se observan puntos fuera de los límites en las cartas X̄ y R. Sin embargo, el promedio general es un poco menor al valor nominal, lo que muestra una ligera tendencia al subllenado posiblemente por una calibración baja en el equipo.