Control y Aseguramiento de la Calidad

Capitulo 2

Ejercicio 17.

En una empresa que fabrica y vende equipo para fotocopiado utilizan como un indicador importante de la calidad en el servicio posventa, el tiempo de respuesta a solicitudes de apoyo técnico debido a fallas en los equipos. Para problemas mayores, en cierta zona del país se estableciá como meta que la respuesta se dé en un máximo de 6 horas hábiles; es decir, de que habla el cliente solicitando apoyo, y que si el problema se clasifica como grave no deben pasar más de 6 horas hábiles para que un técnico acuda a resolver el problema. A continuación se aprecian los tiempos de respuesta en horas para los primeros nueve meses del año (65 datos).

data <- c(5.0, 5.4, 7.1, 7.0, 5.5, 4.4, 5.4, 6.6, 7.1, 4.2, 
          4.1, 3.0, 5.7, 6.7, 6.8, 4.7, 7.1, 3.2, 5.7, 4.1,
          5.5, 7.9, 2.0, 5.4, 2.9, 5.3, 7.4, 5.1, 6.9, 7.5,
          3.2, 3.9, 5.9, 3.6, 4.0, 2.3, 8.9, 5.8, 5.8, 6.4, 
          7.7, 3.9, 5.8, 5.9, 1.7, 3.2, 6.8, 7.0, 5.4, 5.6,
          4.5, 6.5, 4.1, 7.5, 6.8, 4.3, 5.9, 3.1, 8.3, 5.4,
          4.7, 6.3, 6.0, 3.1, 4.8)
datam <<- matrix(data,5,13)
datam
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,]  5.0  4.4  4.1  4.7  5.5  5.3  3.2  2.3  7.7   3.2   4.5   4.3   4.7
## [2,]  5.4  5.4  3.0  7.1  7.9  7.4  3.9  8.9  3.9   6.8   6.5   5.9   6.3
## [3,]  7.1  6.6  5.7  3.2  2.0  5.1  5.9  5.8  5.8   7.0   4.1   3.1   6.0
## [4,]  7.0  7.1  6.7  5.7  5.4  6.9  3.6  5.8  5.9   5.4   7.5   8.3   3.1
## [5,]  5.5  4.2  6.8  4.1  2.9  7.5  4.0  6.4  1.7   5.6   6.8   5.4   4.8

Literal a)

Calcule las medidas de tendencia central y con base en éstas, ¿cree que se cumple con la meta?

mu <- mean(data)
med <- median(data)
mod <- mode(data)
sd <- sd(data)

{
  cat("Media =", mu)
  cat("\n Mediana =", med)
  cat("\n Moda =", mod)
  cat("\n Desviacion Estandar =", sd)
}
## Media = 5.366154
##  Mediana = 5.5
##  Moda = numeric
##  Desviacion Estandar = 1.618475

No se cumple con la meta ya que la mediana nos indica que por lo menos la mitad de los datos son menores o iguales a 5.5 el cual es menor al valor especificado y además como la media que es 5.36 nos indica que la mayoria de los datos se encuentran por arriba del especificado.

Literal b)

Aplique la regla empérica, interprete y diga qué tan bien se cumple la meta.

Calculando los limites de especificacion reales tenemos:

LRS <- mu + 3*sd
LRI <- mu - 3*sd

{
  cat("Limite real superior =", LRS)
  cat("\n Limite real ingerior", LRI)
}
## Limite real superior = 10.22158
##  Limite real ingerior 0.5107286

Además consideramos como \(LSE=6\). entonces:

plot(density(data), col='red', lwd='2')
abline(v = 6,col='blue',lwd='2')
abline(v = LRS , col='green',lwd='2')
legend(x="topright", legend=c("LES","LRS"), fill=c("blue","green"))

Como vemos en el gráfico existen muchos datos fuera del limite de especificación, asi pues la meta no se cumple satisfactoriamente.

Literal c)

Haga un histograma e interprete sus aspectos más relevantes.

hist(data,border='orange',lwd=2,xlim=c(0,12))
abline(v = 6,col='blue',lwd='2')
abline(v = LRS , col='green',lwd='2')
legend(x="topright", legend=c("LES","LRS"), fill=c("blue","green"))

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)
}  
Indices(0,6,sd,mu,6)
##          cp       cr      cpi       cps       cpk         k        t
## 1 0.6178656 1.618475 1.105187 0.1305439 0.1305439 -21.12821 1.738166
##         cpm         z
## 1 0.5753189 0.3916317

Literal d)

A partir del análisis que se ha realizado, ¿Qué recomendaciones daría para ayudar a cumplir mejor la meta?

Un plan para cumplir la meta podría ser: + Intentar modificar el centrado del proceso, es decir, calculando una media adecuada tenemos:

\[\begin{eqnarray*} 6 &=& mu + 3(1.618475)\\ mu &=& 6-3(1.618475)\\ mu &=& 1.144575. \end{eqnarray*}\]

Con las media propuesta, lograriamos cumplir con la meta que se especifica, aun así en este caso modificar la media no resultaría sencillo ni factible, ya que seria necesario que muchos de los tiempos de respuesta esten muy cercanos al valor de 1 hora de tiempo de respuesta.

  • Otra solución podria ser recudir la variavilidad del proceso con el objetivo de lograr que el LRS este dentro del LES, lo cual en la practica es muy costoso.

Ejercicio 18

Los siguientes datos representan las horas caídas de equipos por semana en tres líneas de producción.

linea1 <- c(7.7, 6.8, 8.5, 8.6, 5.7, 7.9, 8.1, 7.6, 7.1, 7.3, 7.8, 6.1, 6.4,
            6.3, 7.8, 6.7,7.3,5.7,6.2,7.3,5.0,5.0,5.4,7.5,6.0)
linea2 <- c(6.6,5.2,7.2,9.2,6.7,6.2,7.1,8.1,6.4,6.3,8.2,8.4,7.4,6.5,7.7,7.4,
            6.1,6.2,7.3,6.9,6.1,6.9,8.4,5.0,7.4)
linea3 <- c(7.5,8.1,6.2,7.4,8.2,6.0,8.2,8.1,6.7,8.0,8.1,8.1,7.0,8.5,8.0,7.7,7.5,
            8.2,7.7,7.0,6.5,6.2,6.0,6.1,5.8)
semanas <- c(1:25)

data2 <- data.frame(semanas,linea1,linea2,linea3)

Literal a)

Analice los datos para cada línea y anote las principales características de la distribución de los datos.

# Analisis de Datos

andata <- function(x,LES=NULL,LEI=NULL){
  sigma <- sd(x)
  mu <- mean(x)
  LRS <- mu + 3*sigma 
  LRI <- mu - 3*sigma 
  
  boxplot(x,col='blue')
  abline(h=mu,col='red',lwd='2')
  #==========================================
  
  hist(x, border='blue',lwd='2',xlim=c(0,15))
  abline(v=LRS,col='green',lwd='2')
  abline(v=LRI,col='green',lwd='2')
  abline(v=mu,col='red',lwd='2')
  legend(x="topright", legend=c("LER","Media"), fill=c("green","red"))
  #==========================================
  
  plot(density(x),col='blue',lwd=2)
  abline(v=LRS,col='green',lwd='2')
  abline(v=LRI,col='green',lwd='2')
  abline(v=mu,col='red',lwd='2')
  legend(x="topright", legend=c("LER","Media"), fill=c("green","red"))
  
  
  {
    cat("Media =", mu)
    cat("\n Desviacion estandar = ", sigma)
    cat("\n Limite Real Superior = ", LRS)
    cat("\n Limite Real Inferior = ", LRI)
  }
}
andata(linea1)

## Media = 6.872
##  Desviacion estandar =  1.04981
##  Limite Real Superior =  10.02143
##  Limite Real Inferior =  3.722571

Como vemos en el diagrama de caja, el proceso no se encuentra bien centrado. Y presenta mucha variabilidad, ademas de presentar un sesgo hacia la derecha.

andata(linea2)

## Media = 6.996
##  Desviacion estandar =  1.000616
##  Limite Real Superior =  9.997849
##  Limite Real Inferior =  3.994151

El proceso se encuentra mejor centrado y tiene poca variabilidad.

andata(linea3)

## Media = 7.312
##  Desviacion estandar =  0.8776484
##  Limite Real Superior =  9.944945
##  Limite Real Inferior =  4.679055

No se encuentra bien centrado y presenta mucha variabilidad y un sesgo hacia la derecha.

Literal b)

Compare las tres líneas, ¿Nota alguna diferencia importante?

Como vimos en el literal anterior, tenemos que la linea 1 y 3, no se encuentran centradas, y presentan alta variabilidad ademas de un sesgo a la derecha, mientras que la linea 3 esta mejor centrada y presenta poca variabilidad.

Capitulo 4

Ejercicio 26

Se tienen dos proveedores de una pieza metálica, cuyo diámetro ideal o valor objetivo es igual a 20.25 cm. Se toman dos muestras de 14 piezas a cada proveedor y los datos obtenidos se muestran a continuación:

Proveedor1 <- c(21.38, 20.13, 19.12, 19.85, 20.54,
                18.00, 22.24, 21.94, 19.07, 18.60,
                21.89, 22.60, 18.10, 19.25)
Proveedor2 <- c(21.51, 22.22, 21.49, 21.91, 21.52, 
                22.06, 21.51, 21.29, 22.71, 22.65,
                21.53, 22.22, 21.92, 20.82)

data3 <- data.frame(Proveedor1,Proveedor2)
data3
##    Proveedor1 Proveedor2
## 1       21.38      21.51
## 2       20.13      22.22
## 3       19.12      21.49
## 4       19.85      21.91
## 5       20.54      21.52
## 6       18.00      22.06
## 7       22.24      21.51
## 8       21.94      21.29
## 9       19.07      22.71
## 10      18.60      22.65
## 11      21.89      21.53
## 12      22.60      22.22
## 13      18.10      21.92
## 14      19.25      20.82

Literal a)

Pruebe la hipótesis de igualdad de los diámetros de los proveedores en cuanto a sus medias.

Realizaremos una prueba de hipotesis para la media de los datos de cada proveedor con el valor nominal.

mu1 <- mean(Proveedor1)
mu2 <- mean(Proveedor2)
sigma1 <- sd(Proveedor1)
sigma2 <- sd(Proveedor2)
  • Para el proveedor 1, tenemos:
\[\begin{eqnarray*} H_{0}: \mu_{1} &=& 20.25\\ H_{1}: \mu_{1} &\neq& 20.25 \end{eqnarray*}\] 
{
  cat("Media del proveedor 1= ", mu1)
}
## Media del proveedor 1=  20.19357

No son iguales, rechazamos \(H_{0}\).

  • Para el proveedor 2, tenemos:
\[\begin{eqnarray*} H_{0}: \mu_{2} &=& 20.25\\ H_{1}: \mu_{2} &\neq& 20.25 \end{eqnarray*}\] 
{
  cat("Media del proveedor 1= ", mu2)
}
## Media del proveedor 1=  21.81143

Son iguales, aceptamos \(H_{0}\).

Literal b)

Pruebe la hipótesis de igualdad de varianzas.

Tenemos:

\[\begin{eqnarray*} H_{0}: \sigma_{1}^{2} &=& \sigma_{2}^{2}\\ H_{1}: \sigma_{1}^{2} &\neq& \sigma_{2}^{2} \end{eqnarray*}\] 
{
  cat("Varianza para el proveedor 1 = ",sigma1^2)
  cat("\n Varianza para el proveedor 2 = ",sigma2^2)
}
## Varianza para el proveedor 1 =  2.507379
##  Varianza para el proveedor 2 =  0.279367

Usando la distribución F, tenemos:

fo <- (sigma1^2)/(sigma2^2)

{
  cat("fo=", fo)
}
## fo= 8.975213
pvalor <- pf(fo,6,6)
{
  cat("p-valor=", pvalor)
}
## p-valor= 0.9913795
  • Dependiendo de el \(\alpha\) que decidamos tolerar, podremos aceptar o no \(H_{0}: \sigma_{1}^{2} = \sigma_{2}^{2}\)

\(H_{0}\).

Literal c)

Si las especificaciones para el diámetro son 20.25 mm \(\pm\) 2.25 mm, ¿Cuál proveedor produce menos piezas defectuosas?

prueba1 <- function(x){
  n <- length(x)
  s <- 0
  for (i in 1:n) {
    ifelse(x[i]>=22.5,s<-s+1, ifelse(x[i]<=18,s<-s+1,0))
    
  }
  m <- n-s
  return((m/n)*100 )
}

{
  cat("Porcentaje de piezas en buen estado del proveedor 1= ",prueba1(Proveedor1))
  cat("\n Porcentaje de piezas en buen estado del proveedor 1= ",prueba1(Proveedor2))
}
## Porcentaje de piezas en buen estado del proveedor 1=  85.71429
##  Porcentaje de piezas en buen estado del proveedor 1=  85.71429

Ambos producen el mismo porcentaje de piezas defectuosas.

Literal d)

¿Con cuál proveedor se quedaría usted?

Por lo visto en el literal anterior ambos producen un mismo porcentaje de piezas defectuosas, pero el proveedor 2 posee una variabilidad menor que el proveedor 1, por lo cual, me quedaría con el proveedor 2.

Ejercicio 28

Se realiza un estudio para comparar dos tratamientos que se aplicarán a frijoles crudos con el objetivo de reducir el tiempo de cocción. Un tratamiento (T1) es a base de bicarbonato de sodio; mientras que el otro, T2, se realiza con cloruro de sodio o sal común. La variable de respuesta es el tiempo de cocción en minutos. Se hacen siete replicas. Los datos se muestran en la siguiente tabla:

t1 <- c(76,85,74,78,82,75,82)
t2 <- c(57,67,55,64,61,63,63)
data4 <- data.frame(t1,t2)
data4
##   t1 t2
## 1 76 57
## 2 85 67
## 3 74 55
## 4 78 64
## 5 82 61
## 6 75 63
## 7 82 63

Literal a)

Formule la hipótesis para probar la igualdad de medias de los tratamientos.

\[\begin{eqnarray*} H_{0}: \mu_{1} &=& \mu_{2}\\ H_{1}: \mu_{1} &\neq& \mu_{2}\\ \end{eqnarray*}\]

Literal b)

Anote la fórmula del estadístico de prueba para probar la hipótesis.

\[\begin{eqnarray*} t_{0} &=& \frac{\bar{x}_{1}-\bar{x}_{2}}{\frac{sp}{\sqrt{\frac{1}{n_{1}}+\frac{1}{n_{2}}}}}\\ sp &=& \sqrt{\frac{(n_{1}-1)s_{1}^{2}+(n_{2}-1)s_{2}^{2}}{n_{1}+n_{2}-2}} \end{eqnarray*}\]

literal c)

Pruebe la hipótesis a un nivel de significancia de 5%. Para rechazar o no la hipótesis, apóyese tanto en el criterio del valor-p como en el valor crítico de tablas.

Usando la distribución t-student, y es estadistico del literal anterior tenemos:

mu1 <- mean(t1)
mu2 <- mean(t2)
sigma1 <- sd(t1)
sigma2 <- sd(t2)

{
  cat("Media del tratamiento 1 =", mu1)
  cat("\n Media del tratamiento 2 =", mu2)
  cat("\n Desviaci昼㸳n estandar del tratamiento 1 =", sigma1)
  cat("\n Desviaci昼㸳n estandar del tratamiento 2 =",sigma2)
}
## Media del tratamiento 1 = 78.85714
##  Media del tratamiento 2 = 61.42857
##  Desviaci<f3>n estandar del tratamiento 1 = 4.180453
##  Desviaci<f3>n estandar del tratamiento 2 = 4.157609
sp <- sqrt((6*sigma1^2 + 6*sigma2^2)/(7+7-2))
t0 <- (mu1-mu2)/((sp)/(sqrt((1/7)+(1/7))))

{
  cat("To=",t0)
}
## To= 2.234555
  • Usando la tabla de la t.student para 7+7-2=12 grados de libertad, tenemos que \(t_{0}=2.1788\), como \(2.334555 > 2.1788\), rechazamos la hipotesis nula. \(H_{0}\)
pval <- pt(t0,12,lower.tail = FALSE)

{
  cat("P-valor= ", 2*pval)
}
## P-valor=  0.04523843
  • Al comparar la significancia predefinida \(\alpha = 0.05\) con el \(valor-p = 0.045\) se concluye lo mismo rechazamos \(H_{0}\).

Literal d)

Pruebe la hipótesis de igualdad de varianzas entre tratamientos.

Usando la distribición F, tenemos:

fo <- (sigma1^2)/(sigma2^2)

{
  cat("fo=", fo)
}
## fo= 1.011019
pvalor <- pf(fo,6,6)
{
  cat("p-valor=", pvalor)
}
## p-valor= 0.5051369
  • Dependiendo de el \(\alpha\) que decidamos tolerar, podremos aceptar o no \(H_{0}: \sigma_{1}^{2} = \sigma_{2}^{2}\)

Literal e)

De acuerdo con el análisis realizado hasta aquí, ¿existe algún tratamiento mejor?

Como el tratamiento 2, tiene una menor variabilidad que el tratamiento 1, consideraremos que el tratamiento 2 es mejor.