Taller 1 - 2022 - 1

Estadística Industrial I

library(qcc)
## Package 'qcc' version 2.7
## Type 'citation("qcc")' for citing this R package in publications.
library(ggplot2)
library(tinytex)

PUNTO 1:

El peso neto (en onzas) de un producto blanqueador en polvo va a monitorearse con cartas de control x_barra y R utilizando un tamaño de la muestra de n = 4. Se registran datos de 25 muestras. Resuelva las siguientes preguntas.

#Lectura de la base de datos

datos_1 <- read.table("Tabla 6 Datos grupo 6-Ejercicio 1.txt", header = TRUE, sep = "", dec=".")
datos_1
##    Muestra   X1   X2   X3   X4
## 1        1 16.3 16.2 16.1 16.6
## 2        2 15.9 15.9 16.2 16.4
## 3        3 16.2 16.5 16.4 16.3
## 4        4 16.2 15.9 16.4 16.2
## 5        5 16.1 16.4 16.5 16.0
## 6        6 15.8 16.7 16.6 16.4
## 7        7 16.3 16.5 16.1 16.5
## 8        8 16.1 16.2 16.1 16.3
## 9        9 16.2 16.4 16.3 16.5
## 10      10 16.3 16.4 16.1 16.5
## 11      11 16.4 15.9 16.3 16.4
## 12      12 16.6 16.7 16.2 16.5
## 13      13 16.1 16.6 16.4 16.1
## 14      14 16.3 16.2 16.3 16.4
## 15      15 16.1 16.3 16.2 16.2
## 16      16 16.2 16.3 16.3 16.2
## 17      17 16.2 16.4 16.3 16.2
## 18      18 16.2 16.4 16.5 16.1
## 19      19 16.0 16.3 16.4 16.4
## 20      20 16.4 16.5 16.0 15.8
## 21      21 16.0 15.9 16.5 16.2
## 22      22 16.1 16.3 16.2 15.9
## 23      23 16.0 16.2 16.4 16.7
## 24      24 16.3 16.3 15.9 16.1
## 25      25 16.2 16.1 16.1 15.8
a. Realice una prueba de bondad de ajuste a la distribución normal para estos datos ¿qué puede concluir?
Swn<-shapiro.test(datos_1$value)
Swn
## 
##  Shapiro-Wilk normality test
## 
## data:  datos_1$value
## W = 0.97101, p-value = 0.02643

Al observar los resultados de la prueba podemos concluir que los datos obtenidos sobre el peso neto de un producto blanqueador en polvo no provienen de una distribución normal ya que el p-valor en este caso \(0.02643\) es menor al nivel de significancia utilizado. De igual manera asumiremos que de los datos observados provienen de una distribución normal.

b. Establecer los gráficos de control x_barra y R, ¿está el proceso en control? (si es necesario calcule los límites de control revisados)
peso_neto <- qcc.groups(value, Muestra)
qcc.options(bg.margin = "aliceblue")
prom_control <-qcc(peso_neto, type="xbar",title="Grafico Xbarra-R del peso neto",xlab="Muestra", ylab="Peso Neto Promedio") 

qcc.options(bg.margin = "aliceblue")
qcc(peso_neto, type="R",title="Grafico Rango-R del peso neto",xlab="Muestra", ylab="Peso neto promedio")

Con base en las gráficas realizadas anteriormente podemos determinar que el proceso se encuentra en control debido a que las muestras observadas se mantienen dentro de los límites de control establecidos.

c. Estime la media y la desviación estándar del proceso.
#Media

prom_control$center
## [1] 16.255
#Desviacion estandar
rango_promedio <- 0.428
d2 <- 2.0590

sigma <-rango_promedio/d2
sigma
## [1] 0.2078679
d. Si las especificaciones son 16±0.75 , ¿Qué porcentaje de defectuosos está generando el proceso?
16-0.75
## [1] 15.25
16+0.75
## [1] 16.75
#Calculando el porcentaje de defectuosos:

1-(pnorm(16.75,mean=16.255,sd=0.2078679)-pnorm(15.25,mean=16.255,sd=0.2078679))
## [1] 0.008626025
100*0.008624692
## [1] 0.8624692

El \(0.8624692%\) es el porcentaje de productos defectuosos que está generando el proceso sobre el peso neto del producto blanqueador en polvo.

e. ¿Cuál es el promedio de muestras que se deben inspeccionar hasta encontrar una que este fuera de control?
1/(1-0.008626)
## [1] 1.008701

Con este resultado podemos determinar qué el número esperado de muestras tomadas para detectar un cambio de \(1,0*s\) con \(n = 4\) es aproximadamente \(1\) muestra para encontrar una que este fuera de control.

f. Si la media cambia a 16.2 ¿Cuál es la probabilidad de detectar este cambio en la primera muestra?
beta <-(pnorm((16.5668-16.2)/(0.2078679*sqrt(4)))-pnorm((15.9432-16.2)/(0.2078679*sqrt(4))))
1-beta
## [1] 0.4571963

Si la media tuvo un desplazamiento de \(16.2\), la probabilidad de detectar el cambio en la primera muestra es del 45.72%.

g. ¿Cuál es el número esperado de muestras que se debe inspeccionar hasta detectar el cambio que se observó en el literal anterior?
1/(1-beta)
## [1] 2.187244

Podemos concluir que el número esperado de muestras tomadas para detectar un cambio con desplazamiento de media de \(16.2\) es de aproximadamente \(2.18\) muestras para encontrar una que este fuera de control.

h. Realice la curva de operación característica para la gráfica de control x , para los siguientes tamaños de muestra n = 5, n = 10, n = 15 y n = 20. ¿Qué puede concluir?

Por medio de la gráfica podemos observar que al tener un tamaño de muestra \(n = 5\), con base en los cambios de las desviaciones estándar, las probabilidades de NO detectar un cambio con \(1\) desviación estándar son aproximadamente del \(80%\), mientras que la probabilidad de detectar el cambio será del \(1-0.8=0.2\), \(20%\).

También, para un cambio por encima de \(2\) desviaciones estándar, la probabilidad de no detectar el cambio en el proceso, en la primera muestra, para los tamaños de muestra \(10,15,20\) tienden a ser cero y por encima de \(2.5\) desviaciones estándar para todos los tamaños de muestra la probabilidad de no de detectar el cambio para todas será de cero.

PUNTO 2:

El volumen de llenado de las botellas de refresco es una característica de calidad importante. El volumen se mide colocando un medidor sobre la boca de la botella y comparando la altura del líquido en el cuello de la botella con una escala codificada. En esta escala, una lectura cero corresponde a la altura de llenado correcta. Se analizan 20 muestras de tamaño 9.

#Lectura base de datos

datos_2 <- read.table("Tabla de datos punto 2f completa.txt", header = TRUE, sep = "", dec=".")
datos_2
##    Muestra    X1    X2    X3    X4    X5    X6    X7    X8    X9
## 1        1 -0.86 -0.36 -0.41 -2.14 -0.33 -0.83 -0.04  0.56 -0.77
## 2        2 -0.92  0.55 -1.72  0.81 -0.77  0.08 -0.25  0.92 -1.58
## 3        3 -0.05  0.10 -1.84  0.07 -0.70 -0.63 -1.65  0.32 -0.80
## 4        4  0.14  1.29 -0.07 -0.94  0.54  0.14 -0.16  1.08  0.72
## 5        5 -1.15 -0.40 -0.81  0.71 -0.43  2.52 -0.51  1.43  1.51
## 6        6  1.13  2.15  0.79  0.11 -0.93 -1.06 -0.49 -0.41 -0.59
## 7        7 -2.44  0.57  1.97  0.11  1.75 -0.46 -1.51  3.34  0.04
## 8        8 -1.05 -0.92  1.13 -0.62  1.11  1.59 -0.16  0.82  0.10
## 9        9 -0.08 -0.29 -0.54  0.16 -0.18  1.84  1.18 -0.77 -0.05
## 10      10 -0.25 -0.39 -0.80 -1.84  0.71 -1.06  0.38 -1.19  0.29
## 11      11  0.44  0.28 -0.18  1.47  1.28 -0.44  0.34  0.07 -1.34
## 12      12  1.95  0.21  0.49 -0.96 -0.69 -1.87  0.76 -0.42  1.93
## 13      13 -0.15 -1.13  0.90 -2.96  0.41  0.19 -0.79 -1.65  0.30
## 14      14  1.45 -1.55  0.33  0.16  0.33  1.04 -0.23 -0.74  0.19
## 15      15 -0.59  0.21 -1.10 -1.36  1.82  1.01 -1.76 -0.12 -1.78
## 16      16  0.15 -1.41  1.92  0.41 -0.65  0.47  0.59 -0.51 -0.26
## 17      17  0.92  0.25  1.22 -0.60 -2.10  0.80 -0.19  1.19 -1.04
## 18      18  1.01 -1.58 -1.27  0.24 -0.98  1.12 -0.27  1.03  0.00
## 19      19  0.08  1.06 -1.43 -0.06 -1.18  0.24 -1.06 -0.51  1.76
## 20      20  0.17  1.65  1.17  0.52  2.31  1.90  0.37  1.14  0.73
## 21      21 -0.95  0.90  0.15  0.01  1.11  0.36  1.57  1.04 -0.67
## 22      22 -0.01  0.00  0.79  0.05  0.25 -0.04  1.26  0.59  0.53
## 23      23 -0.58 -0.35  0.11  0.11  0.33 -0.34  1.04 -1.10  0.43
## 24      24  2.71 -0.72 -1.08 -1.10  0.62 -1.23 -0.46 -1.06  1.18
## 25      25 -0.36 -0.35  0.80 -0.48 -0.02  0.32 -1.75 -1.08  0.00
## 26      26  0.18 -0.03  0.80  1.29  1.06  1.53  0.77  1.08  0.63
## 27      27  0.02  1.74  0.44  0.55 -0.36 -1.07  0.86  1.26 -0.31
## 28      28  0.44 -1.64 -0.29 -1.15  1.69  0.24  0.57 -0.28  1.11
## 29      29  0.34  1.79  1.84  1.07  1.78  1.26  0.63 -0.51  1.61
## 30      30  0.08  1.21 -0.73  0.18  0.68  1.05  0.11  0.40  0.30
## 31      31  0.60  0.07  1.08  1.34 -0.04 -0.24  1.85  0.23 -0.23
## 32      32  2.32  0.10  4.01  0.22  0.86  0.00  1.10  1.35  0.21
## 33      33  0.83  1.57 -0.88  1.02  0.25  0.83 -0.02  0.29  1.06
## 34      34 -0.68 -1.19 -0.77 -0.95 -0.06  1.87  1.49  1.15  1.02
## 35      35  0.08 -0.56  0.20 -1.50  1.07  1.98  1.97  0.49  0.23
## 36      36 -0.32 -0.16 -0.14  0.58  0.62 -0.86  0.80  1.25  1.22
## 37      37 -0.54  0.37 -0.55  0.81 -0.44  0.91  0.24  1.35  1.77
## 38      38  1.71  0.05  0.85 -0.29  2.00  2.29  0.30 -0.90  0.54
## 39      39  1.10  0.06  0.18 -0.20  0.30  1.66  1.08  1.03  0.95
## 40      40 -0.39  0.17  1.33 -0.51  0.67  0.73  1.54  0.94  1.81
attach(datos_2)
## The following object is masked from datos_1:
## 
##     Muestra
##nuevo data frame para organizar los datos 
datos_2 <- melt(datos_2,id.vars = "Muestra")
View(datos_2)
attach(datos_2)
## The following object is masked from datos_2 (pos = 3):
## 
##     Muestra
## The following objects are masked from datos_1:
## 
##     Muestra, value, variable
a. Realice una prueba de bondad de ajuste a la distribución normal para estos datos ¿qué puede concluir?.
Swn_1<-shapiro.test(datos_2[1:25,]$value)
Swn_1
## 
##  Shapiro-Wilk normality test
## 
## data:  datos_2[1:25, ]$value
## W = 0.965, p-value = 0.5226

Al observar los resultados de la prueba podemos concluir que los datos obtenidos provienen de una distribución normal ya que el p-valor en este caso \(0.5226\) es mayor al nivel de significancia utilizado.

b. Establecer los gráficos de control x_barra y s, ¿está el proceso en control? (si es necesario calcule los límites de control revisados).

Podemos observar que el proceso no está en control ya que algunos datos observados están por fuera de los límites de control establecidos, por lo que, debemos ajustar las gráficas para eliminar los datos que están por fuera de los límites. En el caso de la gráfica para xbarra el dato que debemos eliminar es 20 y en el caso de la gráfica para la desviación estándar el dato que debemos eliminar es 7.

Con los respectivos ajustes realizados, podemos determinar que el proceso se encuentra en control debido a que las muestras observadas se mantienen dentro de los límites de control establecidos.

c. Estime la media y la desviación estándar del proceso.
media_est <- prom_control$center
media_est
## [1] 0.0012
c4<-0.9693
sd_est<-round(des_control$center/0.9693,6)
sd_est
## [1] 0.959736
d. Encuentre un intervalo de confianza del 95 % para el índice de capacidad del proceso real si se sabe que las especificaciones son 0±0.5.
lei <-0-0.5
les <-0+0.5

#CP estimado
CP_pest <- (les-lei)/(6*0.95973)
CP_pest
## [1] 0.17366
#CPK estimado
CP_kest <- (les-media_est)/(3*0.95973)
CP_kest1 <- (media_est-lei)/(3*0.95973)
CPK<-min(CP_kest,CP_kest1)
CPK
## [1] 0.1732432
n<-9

li <-CPK*(1-qnorm(0.05/2,lower.tail = F)*sqrt(1/(9*n*CPK^2)+1/(2*(n-1))))
ls <-CPK*(1+qnorm(0.05/2,lower.tail = F)*sqrt(1/(9*n*CPK^2)+1/(2*(n-1))))


c(li,ls)*100
## [1] -6.049027 40.697661

Podemos concluir que, con una confianza del 95% el índice de capacidad del proceso real se encuentra entre el -6.05% y el 40.69% de las especificaciones de este.

e. Si se define como regla de control que 2 de 3 puntos consecutivos están por fuera de 2σ y al mismo lado de la línea de control ¿cuál es el promedio de muestras que se deben inspeccionar hasta encontrar una que este fuera de control?
##Debemos normalizar:

##Probabilidad por encima

p<-1-pnorm((0.0012+2*(sd_est/sqrt(n))-0.0012)/(sd_est/sqrt(n)))
p
## [1] 0.02275013
##Probabilidad por debajo
p1<-pnorm((0.0012-2*(sd_est/sqrt(n))-0.0012)/(sd_est/sqrt(n)))
p1
## [1] 0.02275013
p2<-p+p1

##Probabilidad total de encontrar dos de tres puntos sucesivos fuera de 2*sigma

prob<-choose(3,2)*p2^2*(1-p2)

##número promedio de muestras
1/(prob)
## [1] 168.6845

Observando los resultados podemos concluir que el promedio de muestras que se deben inspeccionar hasta encontrar una que este fuera de control es de \(168.6845\) muestras.

f. Después de establecer las cartas de control del inciso c), se tomaron 15 nuevas muestras. Incluya esta información en los gráficos de control y concluya.

Observando la gráfica de control para los promedios, podemos observar que al agregar las nuevas 15 muestras sobre la altura de llenado del líquido, notamos claramente que dos muestras se salen de los límites de control establecidos anteriormente, también notamos que los puntos en amarillo muestran una tendencia a seguir este comportamiento. Además, podemos concluir que en la gráfica no se observa ningún patrón no deseado sobre el proceso de control que estamos haciendo sobre la altura de llenado de un líquido en las botellas de refresco.

En la gráfica de control para la desviación estándar, podemos observar que al agregar las nuevas 15 muestras sobre la altura de llenado del líquido, notamos claramente que ninguna de las muestras agregadas se salen de los límites de control establecidos, también podemos concluir que en la gráfica no se observa ningún patrón no deseado sobre el proceso de control que estamos haciendo sobre la altura de llenado de un líquido en las botellas de refresco.

PUNTO 5:

En una fábrica de producción de crema dental, se tomaron las medidas del peso (en gramos) de una referencia en particular. Cada medida representa el peso en gramos de cada tubo después de salir del proceso de llenado. Las medidas fueron tomadas por una balanza automatizada que se encuentra justo después del proceso de llenado. Los datos son los siguientes.

datos_3 <- read.table("Tabla de datos grupo 6-Ejercicio 5.txt", header = TRUE, sep = "", dec=".")
View(datos_3)
attach(datos_3)
## The following object is masked from datos_2 (pos = 3):
## 
##     Muestra
## The following object is masked from datos_2 (pos = 4):
## 
##     Muestra
## The following object is masked from datos_1:
## 
##     Muestra
datos_3
##    Muestra Peso
## 1        1 2.07
## 2        2 2.17
## 3        3 2.17
## 4        4 2.07
## 5        5 2.12
## 6        6 2.05
## 7        7 2.10
## 8        8 2.07
## 9        9 2.10
## 10      10 2.14
## 11      11 2.12
## 12      12 2.05
## 13      13 2.07
## 14      14 2.12
## 15      15 2.16
## 16      16 2.17
## 17      17 2.14
## 18      18 2.01
## 19      19 2.02
## 20      20 2.10
## 21      21 2.12
## 22      22 2.13
## 23      23 2.16
## 24      24 2.09
## 25      25 2.15
a. Realice una prueba de bondad de ajuste a la distribución normal para los datos ¿qué puede concluir?
SWn_2 <- shapiro.test(datos_3$Peso)
SWn_2
## 
##  Shapiro-Wilk normality test
## 
## data:  datos_3$Peso
## W = 0.94804, p-value = 0.2264

Al observar los resultados de la prueba podemos concluir que los datos obtenidos sobre el peso en gramos de una referencia particular de crema dental producto provienen de una distribución normal ya que el p-valor en este caso \(0.2264\) es mayor al nivel de significancia utilizado.

b. Establecer los gráficos de control para medidas individuales y promedios móviles. ¿Está el proceso en control? (si es necesario calcule los límites de control revisados).

Al observar las gráficas de control para las medidas individuales y para el rango móvil podemos observar que el proceso para el peso en gramos de una referencia en particular de crema dental, se encuentra en control debido a que los datos observados están dentro de los límites de control establecidos.

c. Después de establecer las cartas de control del inciso a), se tomaron 15 nuevas muestras y el peso se muestra en la tabla que se presenta a continuación. Incluya esta informacifin en los gráficos de control y concluya.
## The following objects are masked from datos_3 (pos = 3):
## 
##     Muestra, Peso
## The following object is masked from datos_2 (pos = 4):
## 
##     Muestra
## The following object is masked from datos_2 (pos = 5):
## 
##     Muestra
## The following object is masked from datos_1:
## 
##     Muestra

Al agregar las nuevas 15 muestras, para la gráfica de control de las medidas individuales podemos observar que una muestra se sale de los límites de control, esto puede ser por alguna causa de variación del proceso, a pesar de esto podemos concluir que el proceso seguirá en control.

Para la gráfica de control del Rango móvil, podemos observar que de una muestra a otra hay una variabilidad considerablemente grande, esto pudo ser debido a alguna causa de variación asignable, pero podemos concluir que el proceso seguirá en control.

PUNTO 6:

Explique como se calculan los límites de control probabilísticos para la gráfica de control s. Con los datos del ejercicio 2 calcule los límites de control para x_barra y s con un α = 0.05.

Consultando el libro de Montgomery en el punto 6.3.3, podemos observar las formulas para los limites de control probabilisticos para la grafica de control para s; es por ello que utilizamos estas formulas a continuación para realizar los respetivos calculos.

s_2_est<-des_control$center
n<-9
alpha<-0.05
UCL<-((s_2_est^2)/(n-1))*qchisq(alpha/2,n-1)
LCL<-((s_2_est^2)/(n-1))*qchisq(1-(alpha/2),n-1)
c(UCL,LCL)
## [1] 0.2357942 1.8968142

Como debemos calcular los límites de control probabilísticos para la gráfica de control s, sacamos raiz cuadrada a ambos límites:

s_ucl <- sqrt(UCL)
s_lcl <- sqrt(LCL)
c(s_ucl, s_lcl)
## [1] 0.4855864 1.3772488

Observando los resultados podemos decir que lo límites de control probalisticos para s son de \((0.4855,1.3772)\).

Ahora calcularemos los límites de control para s

s_2<-des_control$center

ucl<-s_2^2/(n-1)*qchisq(0.05/2,n-1)
lcl<-s_2^2/(n-1)*qchisq(1-0.05/2,n-1)
lc<-s_2^2
lc
## [1] 0.8654067
c(ucl,lcl)
## [1] 0.2357942 1.8968142

Así los límites de control son \(LCL=0.2358\) , \(UCL=1.8968\), \(CL=0.8654\)

Ahora calcularemos los límites de control para x_barra

prom<-prom_control$center

ucl<-prom-3*s_2/sqrt(n)
lcl<-prom+3*s_2/sqrt(n)
prom
## [1] 0.0012
c(ucl,lcl)
## [1] -0.9290724  0.9314724

Así los límites de control son \(LCL=-0.9290\) , \(UCL=0.9314\), \(CL=0.012\)