library(qcc)
## Package 'qcc' version 2.7
## Type 'citation("qcc")' for citing this R package in publications.
library(ggplot2)
library(tinytex)
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
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.
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.
#Media
prom_control$center
## [1] 16.255
#Desviacion estandar
rango_promedio <- 0.428
d2 <- 2.0590
sigma <-rango_promedio/d2
sigma
## [1] 0.2078679
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.
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.
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%.
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.
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.
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
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.
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.
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
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.
##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.
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.
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
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.
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.
## 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.
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\)