Optimización de Proceso: Simulación

Estrategia de Mejora Continua y Control Estadístico

Definición de funciones a utilizar

El proceso presente se realizó un número importante de veces. Debido a esto, se considera más apropiada la creación de funciones para cada apartado, reduciendo así considerablemente las redundancias y el código a ejecutar. A continuación se presentan las funciones a utilizar. Un caso especial es el de los diagramas de Ishikawa, que sí repiten su código en cada apartado para mantener la coherencia de su formulación cualitativa.

Resumen de estadísticos
tabla_estadisticos <- function(df, grupo_var) {
  df %>%
    filter(!is.na(valor)) %>%
    group_by(across(all_of(grupo_var))) %>%
    summarise(
      n             = n(),
      Media         = mean(valor),
      Mediana       = median(valor),
      Desv_Std      = sd(valor),
      Coef_Variacion = (sd(valor) / mean(valor)) * 100,
      .groups = "drop"
    ) %>%
    kable(
      caption = paste("Resumen Estadístico por", grupo_var),
      digits  = 2,
      align   = "c",
      booktabs = TRUE
    ) %>%
    kable_styling(
      bootstrap_options = c("striped", "condensed", "hover"),
      full_width = FALSE
    )
}
Histogramas de densidad
plot_histograma <- function(df, fill_var, titulo, subtitulo = NULL) {
  df %>%
    filter(!is.na(valor)) %>%
    ggplot(aes(x = valor, fill = .data[[fill_var]])) +
    geom_histogram(
      aes(y = after_stat(density)),
      binwidth = 10, color = "white", alpha = 0.5
    ) +
    geom_density(alpha = 0.2, color = "black", linewidth = 0.8) +
    geom_vline(xintercept = TARGET, linetype = "dashed", color = "red",   linewidth = 1) +
    geom_vline(xintercept = c(LCI, LCS), linetype = "dotted", color = "black", linewidth = 0.7) +
    facet_wrap(~ .data[[fill_var]]) +
    labs(
      title    = titulo,
      subtitle = subtitulo %||% paste("Distribución por", fill_var, "| Objetivo:", TARGET, "cm ±10"),
      x        = "Distancia Recorrida (cm)",
      y        = "Densidad",
      fill     = fill_var,
      caption  = "Línea roja: objetivo | Líneas negras: límites de especificación"
    ) +
    theme_minimal() +
    theme(legend.position = "bottom", panel.grid.minor = element_blank())
}
Boxplot con JITTER
plot_boxplot <- function(df, x_var, titulo, subtitulo = NULL) {
  df %>%
    filter(!is.na(valor)) %>%
    ggplot(aes(x = .data[[x_var]], y = valor, fill = .data[[x_var]])) +
    geom_boxplot(outlier.colour = "red", outlier.shape = 8, outlier.size = 3) +
    geom_jitter(width = 0.2, alpha = 0.3) +
    geom_hline(yintercept = TARGET, linetype = "dashed",  color = "darkgreen", linewidth = 1) +
    geom_hline(yintercept = c(LCI, LCS), linetype = "dotted", color = "red", linewidth = 1) +
    labs(
      title    = titulo,
      subtitle = subtitulo %||% "Línea verde: Objetivo | Líneas rojas: Límites de Tolerancia",
      x        = x_var,
      y        = "Distancia Recorrida (cm)",
      caption  = "Asteriscos rojos: valores atípicos"
    ) +
    theme_minimal() +
    theme(legend.position = "none")
}
Gráfico de evolución por intento
plot_evolucion <- function(df, color_var, titulo, subtitulo = NULL) {
  df %>%
    filter(!is.na(valor)) %>%
    group_by(intento, .data[[color_var]]) %>%
    summarise(media_valor = mean(valor), .groups = "drop") %>%
    ggplot(aes(x = intento, y = media_valor,
               color = .data[[color_var]], group = .data[[color_var]])) +
    geom_line(linewidth = 1.2) +
    geom_point(size = 3) +
    geom_hline(yintercept = TARGET, linetype = "dashed", color = "black", alpha = 0.5) +
    annotate("text", x = 1, y = TARGET + 2, label = paste("Objetivo (", TARGET, "cm)"), hjust = 0) +
    scale_x_continuous(breaks = 1:4) +
    labs(
      title    = titulo,
      subtitle = subtitulo %||% "Promedio de lanzamientos por número de intento",
      x        = "Número de Intento",
      y        = "Distancia Promedio (cm)",
      color    = color_var
    ) +
    theme_minimal() +
    theme(legend.position = "bottom")
}
Índices de capacidad del proceso
tabla_capacidad <- function(df, grupo_var) {
  resumen <- df %>%
    filter(!is.na(valor)) %>%
    group_by(across(all_of(grupo_var))) %>%
    summarise(
      n        = n(),
      Media    = mean(valor),
      Desv_Std = sd(valor),
      Cp       = (LCS - LCI) / (6 * sd(valor)),
      Cpk      = min(
        (LCS - mean(valor)) / (3 * sd(valor)),
        (mean(valor) - LCI) / (3 * sd(valor))
      ),
      .groups = "drop"
    ) %>%
    arrange(desc(Cpk))

  colores_cpk <- case_when(
    resumen$Cpk >= 1.33 ~ "forestgreen",
    resumen$Cpk >= 1.00 ~ "darkorange",
    TRUE                ~ "red"
  )

  resumen %>%
    kable(
      caption  = paste("Índices de Capacidad de Proceso por", grupo_var),
      digits   = 3,
      align    = "c",
      booktabs = TRUE
    ) %>%
    kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
    column_spec(5, color = colores_cpk)
}
Gráficas X-barra y R
plot_xbar_r <- function(df, titulo_prefijo = "Control del Proceso") {
  matriz <- df %>%
    filter(!is.na(valor)) %>%
    mutate(subgrupo = paste(operador, ronda, sep = "_")) %>%
    select(subgrupo, intento, valor) %>%
    pivot_wider(names_from = intento, values_from = valor) %>%
    select(-subgrupo) %>%
    as.matrix()

  qcc(matriz, type = "xbar",
      center = TARGET,
      title  = paste(titulo_prefijo, "— Gráfica X-bar"),
      xlab   = "Subgrupos (Operador / Ronda)",
      ylab   = "Promedio de Distancia (cm)")

  qcc(matriz, type = "R",
      title  = paste(titulo_prefijo, "— Gráfica R"),
      xlab   = "Subgrupos (Operador / Ronda)",
      ylab   = "Rango (cm)")
}
Anova entre grupos
analisis_anova <- function(df, grupo_var) {
  df_limpio <- df %>% filter(!is.na(valor))

  formula_anova <- as.formula(paste("valor ~", grupo_var))
  modelo        <- aov(formula_anova, data = df_limpio)

  cat("\n### ANOVA:", grupo_var, "\n\n")
  print(
    summary(modelo)[[1]] %>%
      as.data.frame() %>%
      kable(caption = paste("ANOVA — Variable:", grupo_var), digits = 3, booktabs = TRUE) %>%
      kable_styling(bootstrap_options = c("striped", "condensed"), full_width = FALSE)
  )

  p_valor <- summary(modelo)[[1]][["Pr(>F)"]][1]
  if (!is.na(p_valor) && p_valor < 0.05) {
    cat("\n**p <0.05 — Se aplica prueba post-hoc de Tukey:**\n\n")
    print(TukeyHSD(modelo))
  } else {
    cat("\n*p ≥ 0.05 — No hay diferencias significativas entre grupos.*\n")
  }
}
Tabla comparativa
tabla_comparativa_sesiones <- function(lista_sesiones) {
  purrr::imap_dfr(lista_sesiones, function(df, nombre_sesion) {
    df %>%
      filter(!is.na(valor)) %>%
      summarise(
        Sesión    = nombre_sesion,
        n         = n(),
        Media     = mean(valor),
        Desv_Std  = sd(valor),
        Cp        = (LCS - LCI) / (6 * sd(valor)),
        Cpk       = min(
          (LCS - mean(valor)) / (3 * sd(valor)),
          (mean(valor) - LCI) / (3 * sd(valor))
        )
      )
  }) %>%
    kable(
      caption  = "Evolución de Capacidad de Proceso entre Sesiones",
      digits   = 3,
      align    = "c",
      booktabs = TRUE
    ) %>%
    kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
}

Introducción

Con el propósito de mostrar el tipo de trabajo realizado y del cual se posee experiencia, se realiza una simulación del mismo utilizando datos obtenidos a través de un conjunto de actividades. Se trata de un proceso donde se lanza una pelota utilizando un martillo que cuelga de un mecanismo. Cinco participantes realizan este lanzamiento con libertad para operar el martillo como deseen.

En cada caso se toma nota del desplazamiento total de la pelota. Idealmente, esta pelota debe llegar a una longitud de 130 cm, con un margen de 10 cm para cada extremo.

Se realizaron cuatro sesiones de la misma actividad. En cada caso el proceso fue el mismo, aunque obedeciendo a los cambios planteados al final de la sesión previa. Así, si se optó por un único tipo de martillo, como ocurre luego de la primera sesión, los resultados de la segunda harán eco de esto.

Se muestra cada sesión en un apartado diferente para su lectura más efectiva.

Este análisis evalúa la eficiencia operativa y la variabilidad de un sistema de lanzamiento de precisión mediante una metodología de control estadístico. El objetivo primordial es determinar el material óptimo para el cumplimiento de tolerancias específicas establecidas por estándares externos.

El estudio compara el desempeño de dos estaciones de trabajo con configuraciones mecánicas distintas, operadas bajo condiciones variables, para identificar factores críticos que inciden en la repetibilidad y reproducibilidad del proceso.

A través de este diagnóstico, se identificaron áreas de oportunidad que requieren una reestructuración del proceso para mitigar variables externas. Los análisis estadísticos realizados, particularmente el ANOVA, no encontraron diferencias significativas entre los dos proyectiles evaluados. No obstante, dado que una de las propuestas de mejora consiste en estandarizar el proceso a un único material, la selección del proyectil se resuelve por criterios operativos: se elige el proyectil amarillo por su menor coeficiente de variación descriptivo, a la espera de confirmación en sesiones posteriores.

El análisis emplea las siguientes herramientas de calidad:

  • Diagramas de Pareto e Ishikawa (5M): Para la categorización de fallas y causas raíz.
  • Capacidad de Proceso (\(C_p\) y \(C_{pk}\)): Para medir la aptitud del sistema frente a límites de control.
  • Histogramas de Frecuencia: Para el análisis de distribución y tendencias centrales.

Metodología y entorno experimental

Configuración del equipo

Se implementaron dos estaciones de trabajo denominadas Estación 1 (Martillo de Acero) y Estación 2 (Martillo de Goma):

  • Estación 1: Utiliza un percutor de mayor masa y área de contacto reducida, con un punto de impacto superior al centro de gravedad del proyectil.

  • Estación 2: Configurada con un percutor de menor masa que permite un impacto alineado con el centro de gravedad.

Condiciones Operativas

El despliegue se realizó en superficies de 1.5 metros. Se identificaron irregularidades en la superficie de rodamiento (trayectos de césped sintético) que introdujeron variabilidad en la trayectoria. Asimismo, se evaluaron dos tipos de proyectiles con diferencias significativas en masa, exigiendo ajustes diferenciados en el torque aplicado a la cadena de disparo.

Protocolo de Recolección de Datos

El objetivo fue alcanzar un desplazamiento objetivo de 130 cm con una tolerancia de $$10 cm. El diseño experimental se estructuró de la siguiente manera:

  1. Fase de Operación: Cada operador realizó series de 4 lanzamientos por combinación de estación y proyectil.
  2. Rotación Transversal: Se ejecutó un cambio de estación para eliminar sesgos de aprendizaje específicos de la herramienta.
  3. Validación Cruzada: El proceso se repitió íntegramente intercambiando el tipo de proyectil.
  4. Registro de Eventos: Se documentó cada medición junto con observaciones cualitativas para identificar causas especiales de variación.

Los parámetros que se tomarán en cuenta son un límite superior de 140 cm y un límite inferior de 120 cm. El objetivo es 130 cm.

# Parámetros del proceso
LCI <- 120
LCS <- 140
TARGET <- 130

Primera sesión

Análisis de Variabilidad y Control Estadístico de Procesos: Simulación de Precisión

Inicialmente, se vacían los datos en dos dataframes distintos para un uso más limpio. Primero, un dataframe que cuenta únicamente con los valores de las distancias de cada tiro, luego uno únicamente con los comentarios realizados en el caso de cada uno de estos tiros. Debido a restricciones de tiempo, para sesiones siguientes no se contará con un análisis tiro a tiro, sino con los resultados obtenidos en conversaciones posteriores en lluvias de ideas y otros ejercicios usualmente utilizados en Lean.

df_s1 <- data.frame(
  operador = rep(paste("Operador", 1:5), each = 16),
  ronda    = rep(rep(c("Ronda 1", "Ronda 2"), each = 8), 5),
  intento  = rep(rep(1:4, each = 2), 10),
  estacion = rep(c("Estación 1", "Estación 2"), 40),
  valor    = c(
    # Operador 1
    233, 176, 128.5, 145, NA, 142, 79, 169,
    134, 132, 149, 131.5, 61, 102, 148, 123.5,
    # Operador 2
    135.5, 115, 158, 141, 120, 131, 153, 130.8,
    132, 92.5, 155.5, 113, 157, 131, 115, 123.5,
    # Operador 3
    154, 105, 120, 129.5, 128.5, 131, 126, 129,
    115, 119.5, 121.5, 110, 157, 96, 132, 95.5,
    # Operador 4
    81, 112, 150, 130, 129.5, 107, 119, 130.5,
    82, 132, 150, 134, 145, 122.5, 110, 135,
    # Operador 5
    144.5, 124.5, 129, 138.5, NA, 123, 131, 121,
    133.5, 100.5, 104, 121, 122, 113.5, 157, 132
  )
)
df_s1_comentarios <- data.frame(
  operador  = rep(paste("Operador", 1:5), each = 16),
  ronda     = rep(rep(c("Ronda 1", "Ronda 2"), each = 8), 5),
  intento   = rep(rep(1:4, each = 2), 10),
  estacion  = rep(c("Estación 1", "Estación 2"), 40),
  comentario = c(
    # Operador 1
    "Se desvió, salió del límite", "Estiró demasiado el martillo",
    "Ajustó la fuerza", "Ajustó tiro",
    "Se pasó demasiado", "Ajustó fuerza",
    "Poca fuerza", "Latigueó la cuerda del martillo",
    "Ajustó la fuerza", "Acomodó el martillo",
    "Se pasó, lo regresó el borde", "Se desvió poco el tiro",
    "Poca fuerza, se acomodó en cuclillas", "Poca fuerza",
    "Se pasó, lo regresó el borde", "Ajustó tiro, inclinó hacia la derecha la cadena",
    # Operador 2
    "Ajustó tiro, se apoyó de varilla", "No estiró lo suficiente el martillo",
    "Se pasó, estiró demasiado", "Aumentó fuerza",
    "Ajustó fuerza", "Ajustó fuerza",
    "Se pasó, lo regresó el borde", "Se apoyó en la varilla",
    "Ajustó fuerza", "Poca fuerza, estiró poco",
    "Se pasó de fuerza", "Ajustó, faltó fuerza",
    "Acomodó martillo", "Acomodó martillo",
    "Disminuyó fuerza, quedó corto", "Estiró menos la cadena",
    # Operador 3
    "En cuclillas, mucha fuerza", "Falta fuerza",
    "En cuclillas, se guió con la varilla", "3 cm antes de la varilla",
    "En cuclillas, se guió con la varilla", "3 cm antes de la varilla",
    "En cuclillas, se guió con la varilla", "3 cm antes de la varilla",
    "En cuclillas, faltó fuerza", "Falto fuerza",
    "En cuclillas", "Falto fuerza",
    "En cuclillas, mucha fuerza", "Falto fuerza, el ajuste fue malo",
    "En cuclillas", "Faltó fuerza",
    # Operador 4
    "Falto fuerza", "Falto fuerza",
    "Ajustó con la cadena", "Ajustó con la cadena",
    "Falto fuerza", "Falto fuerza",
    "Mal ajuste con la cadena", "Contó los elementos de la cadena",
    "En cuclillas, el ajuste fue malo", "12 elementos de la cadena",
    "En cuclillas, pegó con el borde del trayecto", "13 elementos de la cadena",
    "En cuclillas, mucha fuerza", "11 elementos de la cadena",
    "En cuclillas, faltó fuerza", "12 elementos de la cadena",
    # Operador 5
    "En cuclillas, mucha fuerza", "Falto fuerza",
    "En cuclillas, se guió con la varilla", "Falto fuerza",
    "La pelota viró", "Falto fuerza",
    "En cuclillas, se guió con la varilla", "Falto fuerza",
    "En cuclillas, contó elementos de la cadena", "Contó 6 elementos de la cadena",
    "En cuclillas, golpeó el borde", "Contó 10 elementos de la cadena",
    "En cuclillas, poca fuerza", "Contó 8 elementos de la cadena",
    "En cuclillas, mucha fuerza", "Contó 11 elementos de la cadena"
  )
)
plot_histograma(
  df_s1,
  fill_var   = "estacion",
  titulo     = "Distribución por Estación de Trabajo",
  subtitulo  = "Sesión 1 — Histograma de densidad vs. Objetivo (130 cm ±10)"
)

En un primer momento se puede pensar que la estación 2 es la mejor opción, pues es en esta donde menos valores atípicos existen, y donde la mayor parte de los resultados se centran en la media. Sin embargo, como se verá más adelante, esto no necesariamente es el caso, con lo que se remarca el riesgo de tomar estadísticos sencillos para tomar decisiones.

plot_boxplot(
  df_s1,
  x_var   = "estacion",
  titulo  = "Comparativa de Dispersión por Estación",
  subtitulo = "Sesión 1 — Línea verde: objetivo | Líneas rojas: límites de tolerancia"
)

Un diagrama de caja sostiene la evidencia de que lo ideal es mantener la estación 2 y dejar de utilizar la estación 1.

tabla_estadisticos(df_s1, "estacion")
Resumen Estadístico por estacion
estacion n Media Mediana Desv_Std Coef_Variacion
Estación 1 38 131.58 131.50 29.09 22.1
Estación 2 40 124.78 126.75 17.35 13.9

Si bien el coeficiente de variación y la desviación estándar parecen ser menores en la estación 2, es relevante evaluar si estas diferencias ocurren a causar del operador o si es el mecanismo propio quien las ocasiona. Este resultado será observable si se muestran los resultados en función del tiempo, si los operadores fueron corrigiendo errores propios, entonces se debería notar una mejora en los lanzamientos. Si por el contrario es la maquinaria la que falla, entonces se entenderá que ésta es más propensa al error

plot_evolucion(
  df_s1,
  color_var = "estacion",
  titulo    = "Evolución del Desempeño: Estación 1 vs. Estación 2",
  subtitulo = "Sesión 1 — Promedio de lanzamientos por número de intento"
)

Es a partir de la evaluación de desempeño donde el panorama comienza a cambiar. A juzgar por el gráfico, la media de los intentos en la estación 1 busca estabilizarse cerca del objetivo, mientras que en el caso de la estación dos hay una variación mayor respecto a la distancia entre intentos.

Algo de importancia es que hay una mayor cantidad de valores atípicos en la estación 1, estos parecen decrecer en el tiempo, en cambio, en la estación 2 los errores permanecen, por lo que podría ser evidencia de que la propia máquina, y no los operadores, es la principal causante de estas inconsistencias.

df_s1 %>%
  filter(estacion == "Estación 1") %>%
  plot_xbar_r(titulo_prefijo = "Sesión 1 — Estación 1")

## List of 11
##  $ call      : language qcc(data = matriz, type = "R", title = paste(titulo_prefijo, "— Gráfica R"),      xlab = "Subgrupos (Operador / R| __truncated__
##  $ type      : chr "R"
##  $ data.name : chr "matriz"
##  $ data      : num [1:10, 1:4] 233 134 136 132 154 ...
##   ..- attr(*, "dimnames")=List of 2
##  $ statistics: Named num [1:10] 154 88 38 42 34 42 69 68 15.5 53
##   ..- attr(*, "names")= chr [1:10] "1" "2" "3" "4" ...
##  $ sizes     : int [1:10] 3 4 4 4 4 4 4 4 3 4
##  $ center    : num 59.1
##  $ std.dev   : num 31.1
##  $ nsigmas   : num 3
##  $ limits    : num [1:10, 1:2] 0 0 0 0 0 0 0 0 0 0 ...
##   ..- attr(*, "dimnames")=List of 2
##  $ violations:List of 2
##  - attr(*, "class")= chr "qcc"

Un aspecto a tomar en consideración es que variabilidad en el tamaño de las muestras puede afectar sensiblemene el análisis de la tabla \(\bar{X}R\). La biblioteca qcc es capaz de manejar este problema, por lo que no influye en lo que se muestra en el resultado.

Por otro lado, esta tendencia a aproximarse al objetivo en la estación 1 se ve más claramente en las tablas \(\bar{X}\) y \(\bar{X}R\). Si bien en ambos casos hay una progresión hacia el objetivo, en la estación 1 el proceso siempre está en control, mienras que para el caso de la estación 2 se comienza fuera de control, y luego las variaciones en cada ejecución, si bien se encuentran en control, siguen siendo muy fluctuantes.

Esto da pie a pensar en una hipótesis importante: quizá sea parte del mejoramiento del proceso el dejar de usar la estación 2, pues pruebas más robustas comienzan a apuntar a este descenlace.

Análisis de operadores

df_s1 %>%
  filter(estacion == "Estación 1") %>%
  plot_histograma(
    fill_var  = "operador",
    titulo    = "Perfiles de Lanzamiento por Operador (Estación 1)",
    subtitulo = "La curva de densidad revela la consistencia técnica individual"
  )

Otra parte importante a analizar son los operadores, pues en cada caso es posible que uno de ellos, o varios, sesguen el desempeño del proceso. Una vista simple a éstos muestra que en el caso del operador 1 hay carencias importantes, mientras que en caso del operador 4 existen valores atípicos constantes que mueven la media. El resto de los operadores no parecen ocasionar un problema severo.

Capacidad de proceso por operador

df_s1 %>%
  filter(estacion == "Estación 1") %>%
  tabla_capacidad("operador")
Índices de Capacidad de Proceso por operador
operador n Media Desv_Std Cp Cpk
Operador 3 8 131.750 15.584 0.214 0.176
Operador 5 7 131.571 16.714 0.199 0.168
Operador 1 7 133.214 55.681 0.060 0.041
Operador 4 8 120.812 28.224 0.118 0.010
Operador 2 8 140.750 17.431 0.191 -0.014

Sin embargo, cabe resaltar que incluso bajo esas condiciones, tanto el \(c_p\) como el \(c_{pk}\) determinan que el proceso no está en control.

ANOVA: ¿difieren significativamente los operadores?

df_s1 %>%
  filter(estacion == "Estación 1") %>%
  analisis_anova("operador")
## 
## ### ANOVA: operador 
## 
## <table class="table table-striped table-condensed" style="color: black; width: auto !important; margin-left: auto; margin-right: auto;">
## <caption>ANOVA — Variable: operador</caption>
##  <thead>
##   <tr>
##    <th style="text-align:left;">  </th>
##    <th style="text-align:right;"> Df </th>
##    <th style="text-align:right;"> Sum Sq </th>
##    <th style="text-align:right;"> Mean Sq </th>
##    <th style="text-align:right;"> F value </th>
##    <th style="text-align:right;"> Pr(&gt;F) </th>
##   </tr>
##  </thead>
## <tbody>
##   <tr>
##    <td style="text-align:left;"> operador </td>
##    <td style="text-align:right;"> 4 </td>
##    <td style="text-align:right;"> 1619.152 </td>
##    <td style="text-align:right;"> 404.788 </td>
##    <td style="text-align:right;"> 0.45 </td>
##    <td style="text-align:right;"> 0.772 </td>
##   </tr>
##   <tr>
##    <td style="text-align:left;"> Residuals </td>
##    <td style="text-align:right;"> 33 </td>
##    <td style="text-align:right;"> 29681.112 </td>
##    <td style="text-align:right;"> 899.428 </td>
##    <td style="text-align:right;"> NA </td>
##    <td style="text-align:right;"> NA </td>
##   </tr>
## </tbody>
## </table>
## *p ≥ 0.05 — No hay diferencias significativas entre grupos.*

Un análisis ANOVA da una visión relativamente diferente, aunque predecible, el que solo uno de los operadores esté mostrando resultados tan profundamente diferentes implica que no hay diferencias apreciables entre éstos, y por tanto es posible que el desempeño del proceso se encuentre afectado principalmente por la máquina en la estación, o el proyectil que se utiliza.

Análisis por Material (Estación 1)

La ronda 1 corresponde al proyectil blanco y la ronda 2 al proyectil amarillo.

df_s1_mat <- df_s1 %>%
  filter(estacion == "Estación 1") %>%
  mutate(material = ifelse(ronda == "Ronda 1", "Proyectil blanco", "Proyectil amarillo"))
plot_boxplot(
  df_s1_mat,
  x_var     = "material",
  titulo    = "Dispersión por tipo de proyectil (Estación 1)",
  subtitulo = "El proyectil amarillo muestra mayor concentración cerca del objetivo"
)

Respecto a esto, parece que el tipo de proyectil en efecto tiene un efecto importante en el proceso, pues el proyectil blanco tiene valores atípicos extremos en un número mayor que en el caso del proyectil amarillo. Si bien para este primer punto en el proceso existe un número importante de estos, es interesante observar esta diferencia entre cada tipo de material.

tabla_estadisticos(df_s1_mat, "material")
Resumen Estadístico por material
material n Media Mediana Desv_Std Coef_Variacion
Proyectil amarillo 20 129.02 132.75 26.05 20.19
Proyectil blanco 18 134.42 129.25 32.66 24.30

Incluso el coeficiente de variación parece apoyar la idea de que el proyectil blanco es menos eficiente que el amarillo.

df_s1_mat %>%
  group_by(operador, material) %>%
  summarise(media_distancia = mean(valor, na.rm = TRUE), .groups = "drop") %>%
  ggplot(aes(x = material, y = media_distancia, color = operador, group = operador)) +
  geom_line(linewidth = 1) +
  geom_point(size = 3) +
  geom_hline(yintercept = TARGET, linetype = "dashed", alpha = 0.5) +
  labs(
    title    = "Efecto de Interacción: Operador × Material",
    subtitle = "Sesión 1 — Cómo cambia el desempeño según el proyectil",
    x        = "Tipo de Pelota",
    y        = "Distancia Promedio (cm)",
    color    = "Operador"
  ) +
  theme_minimal()

El caso del operador 1 es particularmente interesante al evaluar el efecto de la interacción entre el operador y el material. Fuera de ello y un ligero cruce enre el operador 5 y el operador 3, el resultado es el esperado bajo la idea de que no son los operadores, sino el material del proyectil lo que más está afectando al desempeño del proceso.

ANOVA: ¿difiere el desempeño por material?

analisis_anova(df_s1_mat, "material")
## 
## ### ANOVA: material 
## 
## <table class="table table-striped table-condensed" style="color: black; width: auto !important; margin-left: auto; margin-right: auto;">
## <caption>ANOVA — Variable: material</caption>
##  <thead>
##   <tr>
##    <th style="text-align:left;">  </th>
##    <th style="text-align:right;"> Df </th>
##    <th style="text-align:right;"> Sum Sq </th>
##    <th style="text-align:right;"> Mean Sq </th>
##    <th style="text-align:right;"> F value </th>
##    <th style="text-align:right;"> Pr(&gt;F) </th>
##   </tr>
##  </thead>
## <tbody>
##   <tr>
##    <td style="text-align:left;"> material </td>
##    <td style="text-align:right;"> 1 </td>
##    <td style="text-align:right;"> 275.401 </td>
##    <td style="text-align:right;"> 275.401 </td>
##    <td style="text-align:right;"> 0.32 </td>
##    <td style="text-align:right;"> 0.575 </td>
##   </tr>
##   <tr>
##    <td style="text-align:left;"> Residuals </td>
##    <td style="text-align:right;"> 36 </td>
##    <td style="text-align:right;"> 31024.863 </td>
##    <td style="text-align:right;"> 861.802 </td>
##    <td style="text-align:right;"> NA </td>
##    <td style="text-align:right;"> NA </td>
##   </tr>
## </tbody>
## </table>
## *p ≥ 0.05 — No hay diferencias significativas entre grupos.*

Nuevamente, no aparecen diferencias significativas entre los distintos grupos en la prueba ANOVA, por lo que no hay razón para pensar que los operadores trabajan de manera significativamente distinta a causa del proyectil. Es decir, no parece que el desempeño de los operadores varíe con un mismo proyectil, pero sí parece haber cambios, en base a lo visto previamente, entre los tipos de proyectil.

Análisis de Causas Raíz

# Ishikawa
plot_ishikawa <- function(efecto = "Variación > 10cm") {
  grupos   <- c("Mano de Obra", "Maquinaria", "Materiales",
                "Métodos", "Medición", "Medio Ambiente")
  causas   <- list(
    `Mano de Obra`    = c("Falta entrenamiento", "Torque inconsistente", "Fatiga"),
    `Maquinaria`      = c("Desgaste martillo", "Impacto alto (Acero)", "Rebote (Goma)"),
    `Materiales`      = c("Densidad variable", "Peso variable", "Elasticidad"),
    `Métodos`         = c("Ángulo variable", "Posición en cuclillas", "Sin estándar"),
    `Medición`        = c("Lectura manual", "Límites difusos", "Error de paralaje"),
    `Medio Ambiente`  = c("Superficie rugosa", "Abultamientos", "Fricción variable")
  )

  ss.ceDiag(
    effect   = efecto,
    causes.gr = grupos,
    causes   = causas,
    main     = "Diagrama de Ishikawa",
    sub      = paste("Análisis de causas:", efecto)
  )
}
plot_ishikawa("Variación > 10cm — Sesión 1")

Un diagrama de Ishikawa basado en una lluvia de ideas muestra las potenciales causas de error en el proceso. Estos se tratarán de solucionar antes de la segunda sesión de prueba del proceso.