Trabajo 1 Control estadístico de procesos

Librerías de R utilizadas

set.seed(125)
library(dplyr)
library(readxl)
library(flextable)
library(qcc)
library(nortest)
library(normtest)

Los valores siguientes corresponden a índices de refracción de un cable de fibra óptica

I_refracción<-c(96.14,94.89,96.84,98.17,98.07,98.76,93.72,96.23,97.95,95.13,95.64,94.36,94.16,95.27,
                95.54,
      93.81,95.8,96.01,96.7,96.06,96.11,96.05,98.25,96.42,96.29,95.87,99.06,97.64,99.58,95.69,
      98.66,94.46,97.22,97.69,98.99,96.42,95.86,97.4,96.04,97.5,94.67,95.44,94.57,96.06,96.49,96.57,
      96.11,99.35,94.29,95.58,93.22,98.39,94.89,95.69,97.5,97.13,97.65,97.29,94.77,95.1,97.42,
      96.94,95.32,96.22,96.7,97.25,96.71,95.36,98.95,97.16)

Deberemos agrupar cada observación ,de modo que las lecturas de observación de cada muestra estén en una columna

Para ello usamos la función qcc.groups

Finalmente los subgrupos son los siguientes:

Subgrupos de índices de refracción
grupo1	grupo2	grupo3	grupo4	grupo5	grupo6	grupo7	grupo8	grupo9	grupo10	grupo11	grupo12	grupo13	grupo14
96.14	94.89	96.84	98.17	98.07	98.76	93.72	96.23	97.95	95.13	95.64	94.36	94.16	95.27
95.54	93.81	95.80	96.01	96.70	96.06	96.11	96.05	98.25	96.42	96.29	95.87	99.06	97.64
99.58	95.69	98.66	94.46	97.22	97.69	98.99	96.42	95.86	97.40	96.04	97.50	94.67	95.44
94.57	96.06	96.49	96.57	96.11	99.35	94.29	95.58	93.22	98.39	94.89	95.69	97.50	97.13
97.65	97.29	94.77	95.10	97.42	96.94	95.32	96.22	96.70	97.25	96.71	95.36	98.95	97.16

Obtendremos ahora las medidas estadística por subgrupos

Medidas estadísticas por subgrupos
subgrupos	...2	...3	...4	...5	...6	%CV	promedios	rangos
subgrupo1	96.14	95.54	99.58	94.57	97.65	2.028719	96.696	5.01
subgrupo2	94.89	93.81	95.69	96.06	97.29	1.360000	95.548	3.48
subgrupo3	96.84	95.80	98.66	96.49	94.77	1.480000	96.512	3.89
subgrupo4	98.17	96.01	94.46	96.57	95.10	1.490000	96.062	3.71
subgrupo5	98.07	96.70	97.22	96.11	97.42	0.760000	97.104	1.96
subgrupo6	98.76	96.06	97.69	99.35	96.94	1.360000	97.760	3.29
subgrupo7	93.72	96.11	98.99	94.29	95.32	2.150000	95.686	5.27
subgrupo8	96.23	96.05	96.42	95.58	96.22	0.330000	96.100	0.84
subgrupo9	97.95	98.25	95.86	93.22	96.70	2.090000	96.396	5.03
subgrupo10	95.13	96.42	97.40	98.39	97.25	1.250000	96.918	3.26
subgrupo11	95.64	96.29	96.04	94.89	96.71	0.720000	95.914	1.82
subgrupo12	94.36	95.87	97.50	95.69	95.36	1.180000	95.756	3.14
subgrupo13	94.16	99.06	94.67	97.50	98.95	2.400000	96.868	4.90
subgrupo14	95.27	97.64	95.44	97.13	97.16	1.130000	96.528	2.37

Análisis normalidad media aritmética muestral

promedios muestrales:

promedios<-c(tabla1$promedios)
promedios

##  [1] 96.696 95.548 96.512 96.062 97.104 97.760 95.686 96.100 96.396 96.918
## [11] 95.914 95.756 96.868 96.528

Gráfica normalidad:

grafica<-qqnorm(tabla1$promedios, 
          main = "Normalidad media aritmética muestral")
qqline(tabla1$promedios, col = 2)

Prueba de normalidad:

shapiro.test(tabla1$promedios)

## 
##  Shapiro-Wilk normality test
## 
## data:  tabla1$promedios
## W = 0.96309, p-value = 0.7734

lillie.test(tabla1$promedios)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  tabla1$promedios
## D = 0.12372, p-value = 0.8124

Casi todos los puntos se agrupan en la línea recta,la prueba de Shapiro-Wilk y Lilliefors indica que no se rechaza la normalidad de la media aritmética muestral

Análisis de normalidad del rango muestral

grafica<-qqnorm(tabla1$rangos, 
          main = "Normalidad rango muestral")
qqline(tabla1$rangos, col = 3)

Pruebas de normalidad:

shapiro.test(tabla1$rangos)

## 
##  Shapiro-Wilk normality test
## 
## data:  tabla1$rangos
## W = 0.9464, p-value = 0.5063

 lillie.test(tabla1$rangos)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  tabla1$rangos
## D = 0.1486, p-value = 0.5493

Se puede observar que varios puntos se alejan levemente de la línea recta, aún así no se rechaza la normalidad del rango muestral en ninguna de las pruebas utilizadas

Diagramas de control para media y rango

## 
## Call:
## qcc(data = refracción2, type = "xbar", xlab = "Número de muestra",     ylab = "X-barra")
## 
## xbar chart for refracción2 
## 
## Summary of group statistics:
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## 94.99400 96.04300 96.45400 96.41771 96.77750 97.56800 
## 
## Group sample size:  5
## Number of groups:  14
## Center of group statistics:  96.41771
## Standard deviation:  1.402469 
## 
## Control limits:
##      LCL      UCL
##  94.5361 98.29932

Al analizar el diagrama se ve que no existen causas especiales de variación,por ejemplo ningún punto se escapa de los límites de control o no existen puntos sucesivos que aumenten o disminuyan, así que nuestro proceso está bajo control.

Esto además me lo indica el siguiente comando:

media$violations

## $beyond.limits
## integer(0)
## 
## $violating.runs
## numeric(0)

rangos <- qcc(refracción2, type="R",xlab="Número de muestra",ylab="Rango")

summary(rangos)

## 
## Call:
## qcc(data = refracción2, type = "R", xlab = "Número de muestra",     ylab = "Rango")
## 
## R chart for refracción2 
## 
## Summary of group statistics:
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## 1.480000 2.125000 3.085000 3.262143 4.370000 5.170000 
## 
## Group sample size:  5
## Number of groups:  14
## Center of group statistics:  3.262143
## Standard deviation:  1.402469 
## 
## Control limits:
##  LCL      UCL
##    0 6.897702

Nuevamente vemos que el proceso está bajo control,ningún punto se escapa de los límites

Se puede verificar visualmente y mediante el comando:

rangos$violations

## $beyond.limits
## integer(0)
## 
## $violating.runs
## numeric(0)

Diagrama de control para la Desviación estándar

sd <- qcc(refracción2, type="S",xlab="Número de muestra",ylab="Desviación estándar")

summary(sd)

## 
## Call:
## qcc(data = refracción2, type = "S", xlab = "Número de muestra",     ylab = "Desviación estándar")
## 
## S chart for refracción2 
## 
## Summary of group statistics:
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## 0.6872263 0.8617478 1.3159771 1.3334353 1.7908820 2.0615213 
## 
## Group sample size:  5
## Number of groups:  14
## Center of group statistics:  1.333435
## Standard deviation:  1.41857 
## 
## Control limits:
##  LCL      UCL
##    0 2.785544

En la gráfica Shewhart todos los puntos se distibuyen dentro de los límites establecidos por lo que no

existen fuentes de variación, el proceso está bajo control

Análisis de normalidad de los datos Individuales

Datos individuales:

I_refracción<-c(96.14,94.89,96.84,98.17,98.07,98.76,93.72,96.23,97.95,95.13,95.64,94.36,94.16,95.27,95.54,93.81,95.8,96.01,96.7,96.06,96.11,96.05,98.25,96.42,96.29,95.87,99.06,97.64,99.58,95.69,98.66,94.46,97.22,97.69,98.99,96.42,95.86,97.4,96.04,97.5,94.67,95.44,94.57,96.06,96.49,96.57,96.11,99.35,94.29,95.58,93.22,98.39,94.89,95.69,97.5,97.13,97.65,97.29,94.77,95.1,97.42,96.94,95.32,96.22,96.7,97.25,96.71,95.36,98.95,97.16)

grafica1<-qqnorm(I_refracción, 
                main = "Normalidad media aritmética muestral")
qqline(I_refracción, col = 4)

hist(I_refracción,main="Análisis de normalidad",col="blue")

Pruebas de Normalidad para datos individuales

shapiro.test(I_refracción)

## 
##  Shapiro-Wilk normality test
## 
## data:  I_refracción
## W = 0.98854, p-value = 0.776

lillie.test(I_refracción)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  I_refracción
## D = 0.065561, p-value = 0.6434

jb.norm.test(I_refracción)

## 
##  Jarque-Bera test for normality
## 
## data:  I_refracción
## JB = 0.99191, p-value = 0.542

El histograma y el gráfico qqnorm se ajustan muy bien a la distribución normal,en el qqnorm todos los puntos se agrupan perfectamente a la línea recta, y en el histograma la forma es muy acampanada

Además de ello las pruebas estadísticas no rechazan la normalidad

Trabajo 1 Control estadístico de procesos

Cartas de control para la media y rango

Renato Esteban Méndez Muñoz y Felipe Javier Rivera Fernández

26-05-2022