ÍNDICE
En este informe se pretende realizar un estudio sobre la fiabilidad de unos lanzamientos realizados en una catapulta virtual por diversos equipos, formados por 3 operarios cada equipo. Cada operario lanzará la catapulta bajo las mismas condiciones.
|
|
|
Tras que cada equipo realizara los lanzamientos con unas condiciones de tiro concretas se registraron los datos en un csv.
1 Lectura de los datos
Comenzamos por cargar el csv de los datos registrados:
library(readr)
datos <- read_csv("registro lanzamientos catapulta - Copia de registro lanzamientos.csv", locale=locale(decimal_mark = ","))
View(datos)
datos$ELEMENTO<-as.character(datos$ELEMENTO)
datos$EQUIPO<-as.factor(datos$EQUIPO)
datos$TIRO<-as.factor(datos$TIRO)
datos$OPERARIO<-as.character(datos$OPERARIO)
datos$DISTANCIA<-as.numeric(datos$DISTANCIA)
datos## # A tibble: 345 x 12
## `Marca temporal` EQUIPO `CONDICIONES DE~ `CONDICIONES DE~ `CONDICIONES DE~
## <chr> <fct> <dbl> <dbl> <dbl>
## 1 23/10/2020 9:40~ GRUPO~ 185 135 270
## 2 23/10/2020 9:41~ GRUPO~ 185 135 270
## 3 23/10/2020 9:42~ GRUPO~ 185 135 270
## 4 23/10/2020 9:43~ GRUPO~ 185 135 270
## 5 23/10/2020 9:43~ GRUPO~ 185 135 270
## 6 23/10/2020 9:45~ GRUPO~ 185 120 300
## 7 23/10/2020 9:46~ GRUPO~ 185 120 300
## 8 23/10/2020 9:46~ GRUPO~ 185 120 300
## 9 23/10/2020 9:47~ GRUPO~ 185 120 300
## 10 23/10/2020 9:48~ GRUPO~ 185 120 300
## # ... with 335 more rows, and 7 more variables: `CONDICIONES DE TIRO. PIN
## # ELEVATION` <dbl>, `CONDICIONES DE TIRO. BUNGEE POSITION` <dbl>,
## # OPERARIO <chr>, DISTANCIA <dbl>, TIRO <fct>, ELEMENTO <chr>, elegida <chr>View(datos)Para reconocer más facilmente a los operarios los renombramos, cambiando los correos electrónicos por los nombres.
datos$OPERARIO[datos$OPERARIO == "christian.ledesma@goumh.umh.es"] <- "Christian"
datos$OPERARIO[datos$OPERARIO == "alicia.diaz02@goumh.umh.es"] <- "Alicia"
datos$OPERARIO[datos$OPERARIO == "cristina.sotos@goumh.umh.es"] <- "Cristina"
datos$OPERARIO[datos$OPERARIO == "sukhwinder.singh@goumh.umh.es"] <- "Sukhi"
datos$OPERARIO[datos$OPERARIO == "gurwinder.singh@goumh.umh.es"] <- "Ghur"
datos$OPERARIO[datos$OPERARIO == "pablo.perez14@goumh.umh.es"] <- "Pablo_perez"
datos$OPERARIO[datos$OPERARIO == "alejandro.gimenez02@goumh.umh.es"] <- "Alejandro"
datos$OPERARIO[datos$OPERARIO == "francisco.richarte@goumh.umh.es"] <- "Francisco"
datos$OPERARIO[datos$OPERARIO == "juan.garcia103@goumh.umh.es"] <- "Juanro"
datos$OPERARIO[datos$OPERARIO == "pablo.pages@goumh.umh.es"] <- "Pablo_pages"
datos$OPERARIO[datos$OPERARIO == "javier.caro01@goumh.umh.es"] <- "Javier"
datos$OPERARIO[datos$OPERARIO == "jose.garcia105@goumh.umh.es"] <- "Jose"
datos$OPERARIO[datos$OPERARIO == "lorena.nacher@goumh.umh.es"] <- "Lorena"
datos$OPERARIO[datos$OPERARIO == "alberto.sancho@goumh.umh.es"] <- "Alberto"
datos$OPERARIO[datos$OPERARIO == "alexandro.garcia@goumh.umh.es"] <- "Alexandro"
datos$OPERARIO[datos$OPERARIO == "mireia.bou@goumh.umh.es"] <- "Mireia"
datos$OPERARIO[datos$OPERARIO == "sandy.sailema@goumh.umh.es"] <- "Sandy"
datos$OPERARIO[datos$OPERARIO == "miriam.castello@goumh.umh.es"] <- "Miriam"
datos$OPERARIO[datos$OPERARIO == "andrea.valiente@goumh.umh.es"] <- "Andrea"
datos$OPERARIO[datos$OPERARIO == "esther.sobrino@goumh.umh.es"] <- "Esther"
datos$OPERARIO[datos$OPERARIO == "victor.pacheco01@goumh.umh.es"] <- "Victor"
datos$OPERARIO[datos$OPERARIO == "dimitar.malamov@goumh.umh.es"] <- "Dimitar"
datos$OPERARIO[datos$OPERARIO == "diego.garcia09@goumh.umh.es"] <- "Diego"También renombramos los ELEMENTOS por A, B y C para reconocerlos mejor.
datos$ELEMENTO[datos$ELEMENTO == "185113300169185"] <- "A"
datos$ELEMENTO[datos$ELEMENTO == "185120300200200"] <- "B"
datos$ELEMENTO[datos$ELEMENTO == "185135270200200"] <- "C"
datos$ELEMENTO<-as.factor(datos$ELEMENTO)2 Creación de un data.frame
Creamos un data.frame para quedarnos con las variables necesarias para el estudio:
library(dplyr)
library(tidyverse)
datos2<-datos %>% select(c("DISTANCIA", "ELEMENTO", "OPERARIO"))
datos2$OPERARIO<-as.factor(datos2$OPERARIO)
str(datos2)## tibble [345 x 3] (S3: tbl_df/tbl/data.frame)
## $ DISTANCIA: num [1:345] 441 440 432 422 445 634 640 640 637 638 ...
## $ ELEMENTO : Factor w/ 3 levels "A","B","C": 3 3 3 3 3 2 2 2 2 2 ...
## $ OPERARIO : Factor w/ 23 levels "Alberto","Alejandro",..: 1 1 1 1 1 1 1 1 1 1 ...View(datos2)3 Análisis Gage
A continuación, realizamos un Análisis Gage, donde Gage R&R calacula la variación total (VT) a partir de tres fuentes:
- Parts o elementos que son medidos, (ELEMENTO).
- Appraisers u operarios, (OPERARIO).
- Equipment (gage) o equipación de medida, (DISTANCIA).
library(SixSigma)
# ss.rr(var, part, appr, data, main, sub)
my.rr <- ss.rr(var =DISTANCIA , part =ELEMENTO ,
appr = OPERARIO,
data = datos,
main = "Six Sigma Gage R&R Measure",
sub = "Lanzamientos")## Complete model (with interaction):
##
## Df Sum Sq Mean Sq F value Pr(>F)
## ELEMENTO 2 2245642 1122821 161.557 <2e-16
## OPERARIO 22 217080 9867 1.420 0.16
## ELEMENTO:OPERARIO 43 298850 6950 7.043 <2e-16
## Repeatability 277 273338 987
## Total 344 3034910
##
## alpha for removing interaction: 0.05
##
## Gage R&R
##
## VarComp %Contrib
## Total Gage R&R 2373.9098 19.66
## Repeatability 986.7791 8.17
## Reproducibility 1387.1307 11.49
## OPERARIO 194.4860 1.61
## ELEMENTO:OPERARIO 1192.6447 9.88
## Part-To-Part 9703.2247 80.34
## Total Variation 12077.1345 100.00
##
## StdDev StudyVar %StudyVar
## Total Gage R&R 48.72279 292.33671 44.34
## Repeatability 31.41304 188.47825 28.58
## Reproducibility 37.24420 223.46522 33.89
## OPERARIO 13.94582 83.67494 12.69
## ELEMENTO:OPERARIO 34.53469 207.20813 31.42
## Part-To-Part 98.50495 591.02969 89.63
## Total Variation 109.89602 659.37610 100.00
##
## Number of Distinct Categories = 2
ELEMENTO
4 Interpretación de los datos
En primer lugar, en la tabla de Anova podemos observar que las diferencias entre ELEMENTO - OPERARIO son significativas.
Fijándonos en el porcentaje %Contrib, observamos que la varianza en el análisis Gage tiene un 19.66% de Varianza total. También vemos que la componente Part to part contiene un 80.34% de la varianza total, lo que significa que existen diferencias entre los elementos de medición. Tenemos 2 categorías distintas, por lo que nos discrimina al menos 2 elementos distintos. En StudyVar tenemos un porcentaje del 44.34% en la componente Gage y en la componente Part to part un 89.63%, por tanto, el porcentaje de la variación del proceso como el de la variación del estudio nos indica que es inaceptable y debería ser mejorado.
En cuanto a los gráficos comprobamos lo anteriormente mencionado:
Components of variation: En el gráfico Components of variation podemos comprobar que el fallo está en Part to Part, como hemos visto anteriormente en la tabla Anova, ya que, la reproducibilidad y repetitividad estarían algo más controladas.
R Chart: Podemos ver como los operarios Alexandro, Andrea, Esther, Javier, Lorena y Diego han generado más variabilidad que los demás operarios, ya que tienen elementos muy por encima del promedio de rangos. También podemos destacar que casi todos estos operarios han generado mayor variabilidad en el tercer elemento (C), Lorena ha generado en el primer elemento (A) y Javier y Diego en el segundo elemento (B). También hemos encontrado un error, ya que Javier parece que sólo ha realizado medición de los elementos A y C, y del elemento B no ha realizado medición. Por tanto, presentaremos un pequeño problema de repetitividad (será minoritario ya que es una pequeña parte de los operarios) causados por los anteriores operarios mencionados.
Xbar Chart: Vemos que la mayoría de los operarios siguen un mismo patrón, en cuanto a las mediciones de los elementos, pero vemos como Diego y Javier destacan al tener un patrón totalmente diferente, y por tanto tendremos ahí un problema de reproducibilidad. También podemos ver que los puntos de diferentes elementos para un mismo operario son muy distintos (fluctúan bastante del elemento A al B y al C) y que existiría variabilidad entre los elementos.
Var By Part (Distancia by Elemento): Las mediciones del elemento C presentan mucha variabilidad comparado con las mediciones de los demás elementos. Las mediciones del dicho elemento son muy bajas, lo que genera tanta diferencia respecto al resto (aunque también existen algunas mediciones en los otros 2 elementos que presentan variabilidad, pero son muy reducidas en comparación con el elemento C). Hay diferencias claras entre los elementos, al presentar líneas de tendencia oblicuas entre las medias.
Var By Appraiser (Distancia by Operario): Podemos destacar como Andrea tendría unas mediciones que son mucho más variables, lo mismo pasaría con Esther, Diego y Sukhi. Además de que en promedio sus mediciones son algo más bajas que la del resto de los operarios. Por tanto, hay diferencias claras entre los diferentes operarios y problemas de consistencia y repetitividad entre los operarios anteriormente mencionados.
Part-Appraiser Interaction: La mayor parte de los operarios miden de forma muy similar cada uno de los 3 elementos. Destacarían los operarios Javier (color verde) y Diego (color azul), que parece que sólo coinciden en la forma de medición del elemento A, pero para los demás elementos habrán utilizado formas diferentes en la medición. La tendencia para los demás operarios parece similar, ya que siguen un patrón muy semejante, los patrones diferentes serían los de los operarios anteriormente mencionados (Javier y Diego).
Finalmente, podemos concluir que el sistema de medidas tiene serios problemas de fiabilidad, provocados principalmente por las mediciones realizadas por los operarios que hemos ido nombrando durante el análisis. Para solucionar estos problemas, sería conveniente que estos operarios repitiesen sus mediciones con cada uno de los elementos para que se pudiese solucionar el problema y así reducir la variabilidad.
4.1 Solución a los errores de registro
Como hemos visto, existen algunos problemas en el registro de los lanzamientos. La variable ELEMENTO presenta algunos errores, ya que cada operario debe de tener obligatoriamnete 5 lanzamientos por elemento.
table(datos$OPERARIO,datos$ELEMENTO)##
## A B C
## Alberto 5 5 5
## Alejandro 5 5 5
## Alexandro 6 5 4
## Alicia 5 5 5
## Andrea 5 5 5
## Christian 5 5 5
## Cristina 5 5 5
## Diego 5 5 5
## Dimitar 5 5 5
## Esther 5 5 5
## Francisco 5 5 5
## Ghur 5 5 5
## Javier 5 0 10
## Jose 5 5 5
## Juanro 5 5 5
## Lorena 5 5 5
## Mireia 5 5 5
## Miriam 5 5 5
## Pablo_pages 5 5 5
## Pablo_perez 5 5 5
## Sandy 5 5 5
## Sukhi 5 5 5
## Victor 5 5 5Reajustamos los datos para que el número de lanzamientos con la configuración de cada elemento por operario sea igual.
datos <- read_csv("registro lanzamientos catapulta - Copia de registro lanzamientos.csv", locale=locale(decimal_mark = ","))
library(dplyr)
library(tidyverse)
datos[186:190,'ELEMENTO']=185120300200200
datos[40,'ELEMENTO']=185135270200200
datos$OPERARIO[datos$OPERARIO == "christian.ledesma@goumh.umh.es"] <- "Christian"
datos$OPERARIO[datos$OPERARIO == "alicia.diaz02@goumh.umh.es"] <- "Alicia"
datos$OPERARIO[datos$OPERARIO == "cristina.sotos@goumh.umh.es"] <- "Cristina"
datos$OPERARIO[datos$OPERARIO == "sukhwinder.singh@goumh.umh.es"] <- "Sukhi"
datos$OPERARIO[datos$OPERARIO == "gurwinder.singh@goumh.umh.es"] <- "Ghur"
datos$OPERARIO[datos$OPERARIO == "pablo.perez14@goumh.umh.es"] <- "Pablo_perez"
datos$OPERARIO[datos$OPERARIO == "alejandro.gimenez02@goumh.umh.es"] <- "Alejandro"
datos$OPERARIO[datos$OPERARIO == "francisco.richarte@goumh.umh.es"] <- "Francisco"
datos$OPERARIO[datos$OPERARIO == "juan.garcia103@goumh.umh.es"] <- "Juanro"
datos$OPERARIO[datos$OPERARIO == "pablo.pages@goumh.umh.es"] <- "Pablo_pages"
datos$OPERARIO[datos$OPERARIO == "javier.caro01@goumh.umh.es"] <- "Javier"
datos$OPERARIO[datos$OPERARIO == "jose.garcia105@goumh.umh.es"] <- "Jose"
datos$OPERARIO[datos$OPERARIO == "lorena.nacher@goumh.umh.es"] <- "Lorena"
datos$OPERARIO[datos$OPERARIO == "alberto.sancho@goumh.umh.es"] <- "Alberto"
datos$OPERARIO[datos$OPERARIO == "alexandro.garcia@goumh.umh.es"] <- "Alexandro"
datos$OPERARIO[datos$OPERARIO == "mireia.bou@goumh.umh.es"] <- "Mireia"
datos$OPERARIO[datos$OPERARIO == "sandy.sailema@goumh.umh.es"] <- "Sandy"
datos$OPERARIO[datos$OPERARIO == "miriam.castello@goumh.umh.es"] <- "Miriam"
datos$OPERARIO[datos$OPERARIO == "andrea.valiente@goumh.umh.es"] <- "Andrea"
datos$OPERARIO[datos$OPERARIO == "esther.sobrino@goumh.umh.es"] <- "Esther"
datos$OPERARIO[datos$OPERARIO == "victor.pacheco01@goumh.umh.es"] <- "Victor"
datos$OPERARIO[datos$OPERARIO == "dimitar.malamov@goumh.umh.es"] <- "Dimitar"
datos$OPERARIO[datos$OPERARIO == "diego.garcia09@goumh.umh.es"] <- "Diego"
datos$ELEMENTO[datos$ELEMENTO == "185113300169185"] <- "A"
datos$ELEMENTO[datos$ELEMENTO == "185120300200200"] <- "B"
datos$ELEMENTO[datos$ELEMENTO == "185135270200200"] <- "C"
table(datos$OPERARIO,datos$ELEMENTO)##
## A B C
## Alberto 5 5 5
## Alejandro 5 5 5
## Alexandro 5 5 5
## Alicia 5 5 5
## Andrea 5 5 5
## Christian 5 5 5
## Cristina 5 5 5
## Diego 5 5 5
## Dimitar 5 5 5
## Esther 5 5 5
## Francisco 5 5 5
## Ghur 5 5 5
## Javier 5 5 5
## Jose 5 5 5
## Juanro 5 5 5
## Lorena 5 5 5
## Mireia 5 5 5
## Miriam 5 5 5
## Pablo_pages 5 5 5
## Pablo_perez 5 5 5
## Sandy 5 5 5
## Sukhi 5 5 5
## Victor 5 5 5library(SixSigma)
# ss.rr(var, part, appr, data, main, sub)
my.rr <- ss.rr(var =DISTANCIA , part =ELEMENTO ,
appr = OPERARIO,
data = datos,
main = "Six Sigma Gage R&R Measure",
sub = "Lanzamientos")## Complete model (with interaction):
##
## Df Sum Sq Mean Sq F value Pr(>F)
## ELEMENTO 2 2451836 1225918 212.965 <2e-16
## OPERARIO 22 114695 5213 0.906 0.588
## ELEMENTO:OPERARIO 44 253283 5756 7.386 <2e-16
## Repeatability 276 215096 779
## Total 344 3034910
##
## alpha for removing interaction: 0.05
##
## Gage R&R
##
## VarComp %Contrib
## Total Gage R&R 1774.7539 14.33
## Repeatability 779.3319 6.29
## Reproducibility 995.4220 8.04
## OPERARIO 0.0000 0.00
## ELEMENTO:OPERARIO 995.4220 8.04
## Part-To-Part 10610.1010 85.67
## Total Variation 12384.8549 100.00
##
## StdDev StudyVar %StudyVar
## Total Gage R&R 42.12783 252.7670 37.86
## Repeatability 27.91652 167.4991 25.09
## Reproducibility 31.55031 189.3019 28.35
## OPERARIO 0.00000 0.0000 0.00
## ELEMENTO:OPERARIO 31.55031 189.3019 28.35
## Part-To-Part 103.00534 618.0321 92.56
## Total Variation 111.28726 667.7236 100.00
##
## Number of Distinct Categories = 3
En conclusión, a grosso modo podemos decir que obtenemos prácticamente los mismos resultados que antes. La única diferencia destacable es que las variables han variado entorno a un 5%, y el operario Javier se parece más a los demás operarios, ya que reduce la variabilidad en cuanto a las mediciones. Por lo tanto, que el proceso no es fiable y es necesario repetir el sistema.
