Control Y Aseguramiento de Calidad.

Estadística Descriptiva.

Ejercicio 16.

Una característica clave en la calidad de las pinturas es su densidad, y un componente que infl uye en ésta es la cantidad de arenas que se utilizan en su elaboración. La cantidad de arena en la formulación de un lote se controla por medio del número de costales, que según el proveedor contienen 20 kg. Sin embargo, continuamente se tienen problemas en la densidad de la pintura que es necesario corregir con retrabajo y reprocesos adicionales. En este contexto se decide investigar cuánta arena contienen en realidad los costales. Para ello, se toma una muestra aleatoria de \(30\) costales de cada lote o pedido (500 costales). Los pesos obtenidos en las muestras de los últimos tres lotes se muestran adelante. Las especifi caciones iniciales que se establecen para el peso de los costales de arena son de \(20\) \(\pm\) \(0.8\) kg.

library(knitr)
## Warning: package 'knitr' was built under R version 3.5.3
data1 <- c(18.6, 19.2, 19.5, 19.2, 18.9, 19.4, 19.0, 20.0, 19.3, 20.0, 19.1, 18.6, 19.4, 18.7, 21.0, 19.8, 19.0, 18.6, 19.6, 19.0, 19.6, 19.4, 19.8, 19.1, 20.0, 20.4, 18.8, 19.3, 19.1, 19.1)
data2 <- c(18.6, 19.9, 18.8, 18.4, 19.0, 20.1, 19.7, 19.3, 20.7, 19.6, 19.5, 19.1, 18.5, 19.6, 19.4, 19.6, 20.3, 18.8, 19.2, 20.6, 20.0, 18.4, 18.9, 19.7, 17.8, 19.4, 18.9, 18.4, 19.0, 19.7)
data3 <- c(20.1, 20.2, 21.0, 19.7, 20.1, 20.0, 19.1, 20.4, 19.6, 20.6, 20.0, 19.7, 20.8, 19.7, 19.7, 20.4, 19.8, 20.5, 20.0, 20.0, 20.2, 19.7, 20.0, 19.6, 19.7, 19.8, 19.9, 20.3, 20.4, 20.2)
data <- data.frame('Lote 1'=data1,'Lote 2'=data2,'Lote 3'=data3)
kable(data)
Lote.1 Lote.2 Lote.3
18.6 18.6 20.1
19.2 19.9 20.2
19.5 18.8 21.0
19.2 18.4 19.7
18.9 19.0 20.1
19.4 20.1 20.0
19.0 19.7 19.1
20.0 19.3 20.4
19.3 20.7 19.6
20.0 19.6 20.6
19.1 19.5 20.0
18.6 19.1 19.7
19.4 18.5 20.8
18.7 19.6 19.7
21.0 19.4 19.7
19.8 19.6 20.4
19.0 20.3 19.8
18.6 18.8 20.5
19.6 19.2 20.0
19.0 20.6 20.0
19.6 20.0 20.2
19.4 18.4 19.7
19.8 18.9 20.0
19.1 19.7 19.6
20.0 17.8 19.7
20.4 19.4 19.8
18.8 18.9 19.9
19.3 18.4 20.3
19.1 19.0 20.4
19.1 19.7 20.2

Literal a

De acuerdo con los 90 datos, ¿el centrado del proceso es adecuado?

Para ello hemos recurrido a las medidas de tendencia central y dispersión, ahora bien primero verificamos la existencia o no de valores atípicos o aberrantes en nuestros datos ya que observaciones de este tipo afectarían nuestros resultados, mas concretamente a la media muestral haciendo que esta ya no sea una buena medida de tendencia central. Así el diagrama de caja obtenido a partir de nuestros datos es:

dataaux <- c(data1,data2,data3)
boxplot(data, main='Peso de costales de la muestra por lote.', col = c("orange3", "yellow3", "green3"))

boxplot(dataaux, main='Peso de costales de la muestra total.', col = c("red"))

Analizando los tres lotes es interesante notar que el tercer lote parece difenciarse mucho de los otros lotes, para ello comenzaremos realizando un test de bondad de ajuste para ver si los datos provienen de una misma distribución.

prueba1 <- ks.test(data1,data2)
prueba2 <- ks.test(data1,data3)
prueba3 <- ks.test(data2,data3)
## P.valor entre lote 1 y 2= 0.7989514
##  P.valor entre lote 1 y 3= 3.239194e-06
##  P.valor entre lote 2 y 3= 4.079901e-05

Como notamos los lotes 1 y 2 siguen la misma distribución, más no así el lote 3, así pues trabajar con una muestra total no es recomendable.

Ignorando la observación anterior procederemos a realizar un estudio de capacidad con la muestra total:

Primero obtenemos la desviacion estandar \(\sigma\) y la media muestral \(\mu\) de toda la muestra, asi pues tenemos:

En un literal posterior realizaremos un estudio de capacidad para cada lote.

## Media= 19.56222
##  Desviacion estandar= 0.6511145
##  Mediana= 19.6

Calcularemos los limites de especificacion reales, asi pues: \[ \begin{eqnarray*} LRS &=& \mu + 3 \sigma\\ &=& 19.56222 + 3(0.6511145)\\ &=& 21.51556 \end{eqnarray*} \] \[ \begin{eqnarray*} LRI &=& \mu - 3 \sigma\\ &=& 19.56222 - 3(0.6511145)\\ &=& 17.60888 \end{eqnarray*} \]

Luego tenemos los limites de especificación:

\[ \begin{eqnarray*} LES &=& 20.8\\ LEI &=& 19.2\\ \end{eqnarray*} \]

plot(density(dataaux),col='blue',lwd=2, xlim=c(17,23))
abline(v=19.56222,col='red')
abline(v=21.51556,col='green',lwd='2')
abline(v=17.60888,col='green',lwd='2')
abline(v=20.8,col='brown',lwd='2')
abline(v=19.2,col='brown',lwd='2')
legend(x = "topright", legend = c("Media real", "LER","LE"), fill = c("red", "green","brown"))

Como vemos, los límites reales se encuentran fuera de los limites de especificación, como se ve el proceso no se encuentra bien centrado, ya que la mediana de la muestra =19.6 es menor a la media esperada \(\mu=20\), asi pues tenemos la mitad de los datos se encuentran por debajo del valor esperado. Además podemos ver que existe una variabilidad muy grande, pues existe una gran cantidad de datos fuera de los limites de especificación.

Literal b

¿La variabilidad es poca o mucha? Apóyese en los estadísticos adecuados.

Para contestar esta pregunta utilizaremos el coeficiente de variación:

\[ \begin{eqnarray*} CV &=& \frac{\sigma}{\bar x} *100\\ &=& \frac{0.6511145}{19.56222}*100\\ &=& 3.328428. \end{eqnarray*} \] dado que el coeficiente de variación es mucho mayor a 1, tenemos que los datos presentan demasiada variabilidad.

Literal c

Obtenga un histograma para los 90 datos, inserte las especificaciones e interprételo con detalle.

hist(dataaux,border='blue',lwd=2)
legend(x = "topleft", legend = c("Limites de especifacion"), fill = c("brown"))
abline(v=20.8,col='brown',lwd='2')
abline(v=19.2,col='brown',lwd='2')

Para continuar el análisis del histograma, estudiaremos los diferentes indices de capacidad que el proceso posee, así pues tenemos:

Indices <- function(a,b,sigma,mu,N=0){
  cp <- (b-a)/(6*sigma)
  cr <- 1/(cp)
  cpi <- (mu-a)/(3*sigma)
  cps <- (b-mu)/(3*sigma)
  cpk <- min(cpi,cps)
  k <- ((mu-N)/(0.5*(b-a)))*100
  t <- sqrt(sigma^2 + (mu-N)^2)
  cpm <- (b-a)/(6*t)
  z <- min(((b-mu)/sigma),((mu-a)/sigma))
  ICapacidad <- data.frame(cp,cr,cpi,cps,cpk,k,t,cpm,z)
  return(ICapacidad)
}  


tablaindices <- Indices(19.2,20.8,19.56222,0.6511145,20)
  
tablaindices
##           cp       cr        cpi       cps        cpk         k        t
## 1 0.01363172 73.35832 -0.3160665 0.3433299 -0.3160665 -2418.611 27.51472
##           cpm          z
## 1 0.009691782 -0.9481994

Literal d

De su conclusión general acerca de si los bultos cumplen con el peso especificado.

En base a los literales anterior y tomando en cuenta las gráficas e índices de capacidad tenemos que los bultos no cumplen con el peso especificado, existen una gran cantidad que estan fuera de los limites de especificación y además existe la tendencia de presentar valores menores al especificado. Aun así es interesante notar que como mencionamos antes, no es recomendable el analizar la muestra total, ya que en el lote 3 parecen existir demasiados problemas dentro del proceso.

Literal e

Haga un análisis de cada lote por separado y con apoyo de estadísticos y gráficas, señale si hay diferencias grandes entre los lotes.

Procederemos a realizar un estudio de capacidad para el lote 1, así pues:

lote1 <- data1
hist(lote1,border='blue',lwd='2')
legend(x = "topleft", legend = c("Limites de especifacion"), fill = c("brown"))
abline(v=20.8,col='brown',lwd='2')
abline(v=19.2,col='brown',lwd='2')

mu <- mean(lote1)
sigma <-sd(lote1)
IndicesLote1 <- Indices(19.2,20.8,sigma,mu,20)
IndicesLote1
##          cp       cr        cpi     cps        cpk      k         t
## 1 0.4804193 2.081515 0.09007862 0.87076 0.09007862 -81.25 0.8547534
##         cpm         z
## 1 0.3119808 0.2702359

Calculamos los limites reales para el lote 1, tal que:

lrs <- mu + 3*sigma
lri <- mu - 3*sigma
plot(density(lote1),col='blue',lwd='2',xlim = c(17,22))
abline(v=20.8,col='brown',lwd='2')
abline(v=20,col='red',lwd='2')
abline(v=19.2,col='brown',lwd='2')
abline(v=lrs,col='green',lwd='2')
abline(v=lri,col='green',lwd='2')
legend(x = "topright", legend = c("Media", "LER","LE"), fill = c("red", "green","brown"))

Como podemos ver los limites reales se encuentran fuera de los limites de especificación

Procederemos a realizar un estudio de capacidad para el lote 2, así pues:

lote2 <- data2
hist(lote2,border='blue',lwd='2')
legend(x = "topleft", legend = c("Limites de especifacion"), fill = c("brown"))
abline(v=20.8,col='brown',lwd='2')
abline(v=19.2,col='brown',lwd='2')

mu <- mean(lote2)
sigma <-sd(lote2)
IndicesLote2 <- Indices(19.2,20.8,sigma,mu,20)
IndicesLote2
##          cp       cr        cpi       cps        cpk         k        t
## 1 0.3864347 2.587759 0.04669419 0.7261752 0.04669419 -87.91667 0.985329
##         cpm         z
## 1 0.2706372 0.1400826

Calculamos los limites reales para el lote 2, tal que:

lrs <- mu + 3*sigma
lri <- mu - 3*sigma
plot(density(lote2),col='blue',lwd='2',xlim = c(17,22))
abline(v=20,col='red',lwd='2')
abline(v=20.8,col='brown',lwd='2')
abline(v=19.2,col='brown',lwd='2')
abline(v=lrs,col='green',lwd='2')
abline(v=lri,col='green',lwd='2')
legend(x = "topright", legend = c("Media", "LER","LE"), fill = c("red", "green","brown"))

Como podemos ver los limites reales se encuentran fuera de los limites de especificación

Procederemos a realizar un estudio de capacidad para el lote 2, así pues:

lote3 <- data3
hist(lote3,border='blue',lwd='2')
legend(x = "topleft", legend = c("Limites de especifacion"), fill = c("brown"))
abline(v=20.8,col='brown',lwd='2')
abline(v=19.2,col='brown',lwd='2')

mu <- mean(lote3)
sigma <-sd(lote3)
IndicesLote3 <- Indices(19.2,20.8,sigma,mu,20)
IndicesLote3
##          cp       cr       cpi       cps       cpk k         t       cpm
## 1 0.6643796 1.505164 0.6975986 0.6311607 0.6311607 5 0.4033652 0.6611049
##          z
## 1 1.893482

Calculamos los limites reales para el lote 3, tal que:

lrs <- mu + 3*sigma
lri <- mu - 3*sigma
plot(density(lote3),col='blue',lwd='2',xlim = c(18,22))
abline(v=20.8,col='brown',lwd='2')
abline(v=20,col='red',lwd='2')
abline(v=19.2,col='brown',lwd='2')
abline(v=lrs,col='green',lwd='2')
abline(v=lri,col='green',lwd='2')
legend(x = "topleft", legend = c("Media", "LER","LE"), fill = c("red", "green","brown"))

Como podemos ver los limites reales se encuentran fuera de los limites de especificación

Literal f

¿Las diferencias encontradas se podrían haber inferido a partir del histograma del inciso c)?

En el inciso c), notamos que el proceso no se encuentra centrado y existe una gran cantidad de datos fuera de los limites de especificación, lo cual sucede en los lotes 1 y 2, pero en el lote 3 tenemos indices aceptables, en otras palabras, estas diferencias no se podrían haber inferido a partir del inciso c), pues en primera instancia supondriamos que todos los lotes presentan el mismo comportamiento, pero como vimos en el inciso a), el lote 1 y el lote 2 presentan mayores problemas.

Literal g

Obtenga un diagrama de caja para cada lote y compárelos.

boxplot(data, main='Peso de costales de la muestra por lote.', col = c("orange3", "yellow3", "green3"))
legend(x = "topleft", legend = c("Lote1","Lote2","Lote3"), fill = c("orange3", "yellow3", "green3"))
abline(h=20,col='brown',lwd='2')

Notamos que los lotes 1 y 2 se encuentran por debajo de la especificación, pero el lote 3, se encuentra aceptablemente centrado en el proceso, además logramos evidencias que existe una gran variabilidad en el lote 2, mientras que los lotes 1 y 3 presentan una variabilidad similar. Además notamos que el lote 1 se encuentra sesgado hacia la izquierda.