El “Control Estadístico de la Calidad” se define como la aplicación de diferentes técnicas estadísticas a procesos industriales, administrativos y/o servicios con objeto de comprobar si todas y cada una de las partes del proceso o servicio cumplen unas ciertas exigencias de calidad y ayudar a cumplirlas. Entendiendo por calidad de un producto o servicio como su adecuación para ser usado.
Calidad de diseño: todos los productos y servicios pueden proporcionarse con diferentes niveles de calidad elegidos en la fase de diseño del producto o servicio.
Calidad de conformidad: grado de adecuación a las especificaciones y tolerancias del diseño que se consigue en la fase de fabricación del producto. Depende del proceso de fabricación que se use, los sistemas de control de calidad, el grado de seguimiento de los programas de calidad, de la maquinaria usada, etc.
Mejorar la calidad:
Reduciendo el número de unidades defectuosas que deben desecharse
Reduciendo el número de unidades defectuosas que deben reprocesarse
Eliminando tests e inspecciones
Ocasionando menos retrasos
Aprovechando mejor el tiempo de máquinas y operarios
Utilizando mejor los materiales
Estos efectos contribuyen a aumentar la productividad.
La mayor dificultad para proporcionar productos o servicios de calidad perfecta es la variabilidad inherente a cualquier proceso de fabricación o de prestación de servicios.
Si la diferencia entre dos unidades es pequeña no tiene importancia, pero si es relativamente grande, alguna unidad puede ser inaceptable, o lo que es lo mismo defectuosa.
El estudio y evaluación de esa variabilidad es el objetivo de la aplicación de técnicas estadísticas al control de la calidad.
El principal objetivo del control de calidad será reducir sistemáticamente la variabilidad en productos y servicios. Para ello es necesario, primero identificar las causas que provocan variabilidad y posteriormente eliminarlas del proceso de fabricación.
Diremos que un proceso está bajo control o en estado de control cuando la característica de calidad observada en el proceso varía de forma estable alrededor de un valor medio fijo.
Las causas de variabilidad se pueden clasificar como:
Causas comunes: (o aleatorias) afectan a todo el proceso de fabricación. Suelen ser muchas pero cada una de ellas tiene muy poca influencia en la variabilidad total. Se observan cuando el proceso está bajo control. Resultan de cambios inherentes al proceso, (ej. variaciones de Tª y humedad en el ambiente…)
Causas especiales o asignables: hacen que el proceso abandone su estado de control. Suelen ser pocas, pero sus efectos son muy importantes. Aparecen esporádicamente afectando alguna fase concreta del proceso. El tratamiendo adecuado, incluye su detección y eliminación del sistema. (ej. ajuste incorrecto de una máquina, errores humanos, etc.).
El objetivo del Control Estadístico de la Calidad es detectar rápidamente la ocurrencia debida a causas asignables e investigar las causas que la han producido para eliminarlas.
Las siete herramientas de Ishiwaka*, son un conjunto de técnicas de control estadístico utilizadas durante el proceso de fabricación del producto o de prestación del servicio para mejorar la calidad y la productividad:
Plantillas para recogida de datos (plantillas que recogen datos de una característica de calidad)
Histogramas (representación gráfica de las variables)
Diagramas causa-efecto (busca el factor principal de los problemas)
Diagramas de Pareto (representación gráfica de variables cualitativas)
Diagramas de dispersión (estudia la relación entre 2 variables)
Gráficos de flujo (esquema que describe el proceso en sus múltiples partes con el fin de identificar el problema)
Gráficos de control (representación de una característica de la calidad con límites de control)
library(qcc)
library(readxl)
library(tidyverse)
library(stringr)
library(reshape)
library(reshape2)
library(qicharts)
library(qicharts2)
library(DT)
library(mlbench)
library(MSQC)
#library("MSQC", lib.loc="~/R/win-library/3.1")
library(SixSigma)
library(scatterplot3d)
Este diagrama nos permite identificar causas directamente relacionadas con un problema central que abarca la participacion de las 6 M como parte de la cadena de valor de la empresa y del proceso. Así, tener presente los metodos, mediciones, maquinaria, mano de obra, materiales y medio ambiente, genera una perspectiva global que deriva el problema comprendiendo la sinergia para el ambito de actuación.
Un reconocida pizzeria viene recibiendo diversas quejas por su servicio de reparto a domicilio. Los tres principales problemas son:
Pedidos incorrectos.
Demoran más de lo “normal”.
Pedidos llegan dañados.
El gerente, decide abordar el problema para encontrar soluciones. Uno de sus colaboradores le informa sobre el diagrama de espina de pescado de las 6M y deciden utilizarlo.
Empiezan con una lluvia de ideas, donde encuentran diferentes motivos como: el uso del embalaje incorrecto que provocó daños durante el tránsito, dirección indicada en el producto no era correcta, zonas de mucho tráfico, entre otros. El diagrama de causas y efecto quedó de la siguiente forma:
cause.and.effect(cause=list("Mediciones"=c("Desconocimiento de direcciones", "Error en tiempos de envio"),
"Materiales"=c("Material de empaque inadecuado", "Recepción de insumos dañados"),
"Personal"=c("Falta de GPS para ubicación", "Falta de capacitación en cuanto a recepción y manipulación de alimentos"),
"Entorno"=c("Clientes dan malas referencias", "Alta demanda en la noche", "Mucho tráfico en la zona"),
"Métodos"=c("Personal desconoce las calles", "Mal manejo de productos"),
"Maquinaria"=c("Se dispone de muy pocos repartidores", "Falta de mantenimiento de los vehículos repartidores")),
effect="Pedido errado, dañado y tarde", cex = c(1.75, 1.25, 1.00))
effect <- "Flight Time"
causes.gr <- c("Operator", "Environment", "Tools", "Design",
"Raw.Material", "Measure.Tool")
causes <- vector(mode = "list", length = length(causes.gr))
causes[1] <- list(c("operator #1", "operator #2", "operator #3"))
causes[2] <- list(c("height", "cleaning"))
causes[3] <- list(c("scissors", "tape"))
causes[4] <- list(c("rotor.length", "rotor.width2", "paperclip"))
causes[5] <- list(c("thickness", "marks"))
causes[6] <- list(c("calibrate", "model"))
ss.ceDiag(effect, causes.gr, causes, sub = "Paper Helicopter Project")
La inspección y el seguimiento del proceso deben centrarse en detectar la regularidad estadística de las fallas para identificar dónde, cuándo y cómo ocurren las fallas a fin de orientar mejor las acciones correctivas.
El desafío no es solo detectar defectos antes de que lleguen al cliente, sino también eliminarlos.
Con frecuencia se olvida lo anterior y se recurre a la inspección para detectar efectos ya partir de ahí generar acciones reactivas que solo aborden el efecto y no la causa.
La situación se agrava cuando las causas están relacionadas con errores humanos, ya que las personas son olvidadizas y la rutina de trabajo puede llevar al descuido.
En este contexto, el propósito fundamental de un sistema poka-yoke es diseñar sistemas, métodos y procesos de trabajo a prueba de errores. El término proviene del japonés: poka (error involuntario), yugo (prevenir).
El enfoque poka-yoke propone atacar los problemas desde su causa y actuar antes de que ocurra el defecto entendiendo su mecánica.
Asimismo, reconoce que los seres humanos cometen errores, que olvidan y que olvidan que olvidan.
Por lo tanto, en algunas situaciones la formación y la experiencia no son suficientes. De esta forma, para aquellos errores más críticos que están influidos por el cansancio de las personas, los estados de ánimo, la urgencia de producción o la presión, es necesario diseñar sistemas a prueba de errores (dispositivo poka-yoke) que permitan eliminar la posibilidad de falla, que el sistema avisa y previene en lo posible antes de que el error tenga consecuencias.
En otras palabras, un sistema poka-yoke inspecciona la fuente o causa del error, determinando si existen las condiciones para producir con calidad.
Si estas condiciones no se dan, el sistema impide que el proceso continúe o al menos envía una señal de alerta.
Un dispositivo poka-yoke también permite a las personas revisar su propio trabajo. Los hay de dos tipos: los dispositivos preventivos poka-yoke que nunca permiten error
El microondas no funciona si la puerta está abierta y el dispositivo de detección, que envía una señal cuando hay posibilidad de error
Cuando la puerta del coche está abierta y la llave de encendido todavía está encendida, el sistema envía una señal-bip para que el conductor no olvide la llave dentro del automóvil
Es una representación gráfica para variables cualitativas. La ley del 80/20 representada por el diagrama de pareto nos permite identificar los muchos triviales y pocos vitales involucrados en el estudio. De esta manera comprender que las variables o problemas de mayor relevancia se centra en pocos vitales que deben ser corregidos o son altamente significativos.
Para el anáisis de los problemas presentados en la Pizzería puede hacerse uso del diagrama de pareto. Supongamos que la gerencia se fijó el objetivo de reducir un 90% los errores.
paretochart(x = PROBLEMAS, title = "Gráfico de Pareto", subtitle = "Problemas en la entrega de las pizzas", caption = "Pedido errado, dañado y tarde", x.angle = 45/2, print.data = TRUE)
## x y y.cum p p.cum
## 1 Mal mantenimiento de vehículos 49001 49001 0.49001 0.49001
## 2 Material de empaque inadecuado 29874 78875 0.29874 0.78875
## 3 Se reciben productos dañados 9092 87967 0.09092 0.87967
## 4 Mucho tráfico en la zona 2115 90082 0.02115 0.90082
## 5 Desconocimiento de direcciones 2041 92123 0.02041 0.92123
## 6 Muy pocos repartidores 1014 93137 0.01014 0.93137
## 7 Mal cálculo de tiempos de envio 1012 94149 0.01012 0.94149
## 8 Capacitación manejo de alimentos 1004 95153 0.01004 0.95153
## 9 GPS para ubicarse en la ciudad 990 96143 0.00990 0.96143
## 10 Alta demanda en la noche 974 97117 0.00974 0.97117
## 11 Desconocimiento de zonas 974 98091 0.00974 0.98091
## 12 Mal manejo de productos 959 99050 0.00959 0.99050
## 13 Dan malas referencias 950 100000 0.00950 1.00000
Eliminando del proceso las causas que provocan los cuatro primeros tipos de problemas presentados se desaparecerían la mayoría de los defectos.
inputs.overall<-c("operators", "tools", "raw material", "facilities")
outputs.overall<-c("helicopter")
steps<-c("INSPECTION", "ASSEMBLY", "TEST", "LABELING")
#Inputs of process "i" are inputs of process "i+1"
input.output<-vector(mode="list",length=length(steps))
input.output[1]<-list(c("sheets", "..."))
input.output[2]<-list(c("sheets"))
input.output[3]<-list(c("helicopter"))
input.output[4]<-list(c("helicopter"))
#Parameters of each process
x.parameters<-vector(mode="list",length=length(steps))
x.parameters[1]<-list(c(list(c("width", "NC")),list(c("operator", "C")),
list(c("Measure pattern", "P")), list(c("discard", "P"))))
x.parameters[2]<-list(c(list(c("operator", "C")),list(c("cut", "P")),
list(c("fix", "P")), list(c("rotor.width", "C")),list(c("rotor.length",
"C")), list(c("paperclip", "C")), list(c("tape", "C"))))
x.parameters[3]<-list(c(list(c("operator", "C")),list(c("throw", "P")),
list(c("discard", "P")), list(c("environment", "N"))))
x.parameters[4]<-list(c(list(c("operator", "C")),list(c("label", "P"))))
x.parameters
## [[1]]
## [[1]][[1]]
## [1] "width" "NC"
##
## [[1]][[2]]
## [1] "operator" "C"
##
## [[1]][[3]]
## [1] "Measure pattern" "P"
##
## [[1]][[4]]
## [1] "discard" "P"
##
##
## [[2]]
## [[2]][[1]]
## [1] "operator" "C"
##
## [[2]][[2]]
## [1] "cut" "P"
##
## [[2]][[3]]
## [1] "fix" "P"
##
## [[2]][[4]]
## [1] "rotor.width" "C"
##
## [[2]][[5]]
## [1] "rotor.length" "C"
##
## [[2]][[6]]
## [1] "paperclip" "C"
##
## [[2]][[7]]
## [1] "tape" "C"
##
##
## [[3]]
## [[3]][[1]]
## [1] "operator" "C"
##
## [[3]][[2]]
## [1] "throw" "P"
##
## [[3]][[3]]
## [1] "discard" "P"
##
## [[3]][[4]]
## [1] "environment" "N"
##
##
## [[4]]
## [[4]][[1]]
## [1] "operator" "C"
##
## [[4]][[2]]
## [1] "label" "P"
#Features of each process
y.features<-vector(mode="list",length=length(steps))
y.features[1]<-list(c(list(c("ok", "Cr"))))
y.features[2]<-list(c(list(c("weight", "Cr"))))
y.features[3]<-list(c(list(c("time", "Cr"))))
y.features[4]<-list(c(list(c("label", "Cr"))))
y.features
## [[1]]
## [[1]][[1]]
## [1] "ok" "Cr"
##
##
## [[2]]
## [[2]][[1]]
## [1] "weight" "Cr"
##
##
## [[3]]
## [[3]][[1]]
## [1] "time" "Cr"
##
##
## [[4]]
## [[4]][[1]]
## [1] "label" "Cr"
ss.pMap(steps, inputs.overall, outputs.overall,
input.output, x.parameters, y.features,
sub="Paper Helicopter Project")
El histograma es una representación gráfica de valores en cada forma de barras donde la superficie de cada barra es proporcional a la frecuencia de los dos valores representados.
la línea vertical indica la frecuencia de cada clase y la línea horizontal indica los límites de todas las clases correspondientes a la variable bajo estudio.
Siendo un gráfico de barras especial se utiliza mostrar las variaciones cuando se proporcionan datos continuos como: tiempo, peso, tamaño, temperatura, frecuencia, etc.
Observaciones al gráfico
Si la mayor de frecuencia de datos se encuentra en el centro, se habla de una distribución normal y se puede concluir que el proceso es estable.
Si la mayor frecuencia de datos está hacia la izquierda o derecha de la media, la distribución no es normal y el proceso debe ser investigado.
DESPACHOS
## [1] 38 42 38 35 40 54 40 29 54 50 56 68 47 37 43 46 49 59 49 41 42 42 44 43 44
## [26] 48 49 41 46 59 55 41 44 46 39 34 41 53 41 51 37 46 49 51 52 47 39 50 46 41
## [51] 45 43 49 52 45 53 52 41 37 39 38 40 44 42 48 48 39 45 36 42 47 60 51 40 55
## [76] 47 49 42 42 43 50 49 46 41 44 47 41 39 37 37 49 39 59 42 61 48 46 41 56 41
## [101] 45 45 49 47 45 39 38 41 44 39 50 30 39 53 46 50 32 49 36 29 52 38 44 37 50
## [126] 59 45 34 58 32 40 43 48 43 34 34 44 54 49 50 39 43 40 52 45 51 30 43 62 41
## [151] 35 46 48 38 47
hist(DESPACHOS, ylab = "frecuencia", xlab = "retrasos", las=1, breaks = "Sturges", main="Histrograma", col = "blue")
ss.study.ca(ss.data.ca$Volume, rnorm(40, 753, 3),
LSL = 740, USL = 760, T = 750, alpha = 0.05,
f.sub = "Winery Project")
## Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(density)` instead.
## ℹ The deprecated feature was likely used in the SixSigma package.
## Please report the issue to the authors.
El gráfico de caja (“box-plot” en inglés) es una forma de presentación estadística destinada, fundamentalmente, a resaltar aspectos de la distribución de las observaciones en una o más series de datos cuantitativos. Reemplaza, en consecuencia, al histograma y a la curva de distribución de frecuencias sobre los que tiene ventajas en cuanto a la información que brinda y a la apreciación global que surge de la lectura. Fue ideado por John Tukey, de la Universidad de Princeton (U.S.A.) en 1977.
Elementos constitutivos del gráfico
La caja: Es un rectángulo que abarca el recorrido (o rango, o intervalo) intercuartílico (IQC) de la distribución; o sea, el tramo de la escala que va desde el primer cuartil (Q1) al tercer cuartil (Q3). Esto incluye el 50% de las observaciones centrales.
Mediana (Q2): Se dibuja mediante una línea (algunos lo marcan con un asterisco, otros con una cruz) dentro de la caja y a la altura de la escala que corresponde al valor de esa medida.
Bigotes: Son líneas que salen a los costados de la caja y que sirven como referencia para ubicar las observaciones que están por fuera del 50% central de la distribución.
Cercados interiores: Indica la finalización de los bigotes.
Cercados exteriores: Ubicados más periféricamente en la distribución.
Periféricos (o periféricos próximos): Señalamiento de las observaciones que se encuentran entre el cercado interior y el cercado exterior. Se marcan con un asterístico.
Periféricos lejanos (o periféricos extremos): Señalamiento de las observaciones que se encuentran fuera del cercado exterior. Se marcan con un punto grande.
Los tiempos de cada uno de los procedimientos desde la recepción de un pedido hasta la entrega al ciente final se pueden resumir en los tres principales:
Cocina: Primera actividad concerniente a la preparación del pedido
Mesero: Segunda actividad asociada al llevado de la solicitud del pedido a la mesa
Repartidor: Última actividad, llevada a a cabo para aquellos pedidos que seran llevados hasta el lugar de recepcicón por parte del cliente
TIEMPOS <- rbind(COCINEROS, MESEROS, REPARTIDORES)
boxplot(Time ~ Employ, data = TIEMPOS, col = c("darkblue", "blue", "lightblue"))
Las políticas y procedimientos de control de calidad son parte fundamental del Sistema de Control Interno de la firma de auditoría. El seguimiento consiste principalmente en conocer este sistema de control y determinar -mediante entrevistas, pruebas de revisión a fondo e inspección de archivos del encargo y de otra documentación que sea relevante- si el sistema de control está diseñado y opera de manera eficaz (y en qué medida). También incluye dar recomendaciones para mejorar el sistema, particularmente si se detectan debilidades o si han cambiado las normas y prácticas profesionales.
Normalmente las revisiones deben ser ejecutadas por personas que no han participado en el trabajo. En firmas medianas y grandes, la revisión puede ser realizada por personal de otras oficinas miembros de la Firma.
Este proceso debe incluir estas acciones:
Considerar y evaluar continuamente el Sistema de Control de Calidad de la Firma, incluyendo, de manera cíclica, la inspección de, por lo menos, un compromiso terminado de cada socio del compromiso.
Determinar qué socio(s), u otras personas que cuenten con experiencia y autoridad suficientes y adecuadas en la Firma, tendrá(n) las responsabilidad del proceso de vigilancia; y
Determinar que quienes lleven a cabo la revisión de control de calidad del compromiso no participen en la inspección del mismo.
Las políticas y procedimientos que debe incluir el Sistema de Control de Calidad están relacionadas con lo siguiente:
El diseño de la inspección puede verse afectado por muchos factores. La planificación del proceso de inspección generalmente incluye factores como los siguientes:
La documentación de las inspecciones puede incluir los siguientes elementos:
Las evaluaciones efectuadas deben comprender temas como los siguientes:
Los mecanismos de seguimiento que la firma de auditoría puede usar incluyen los siguientes:
La decisión de contratar a un tercero independiente, o de establecer un sistema interno de seguimiento, y sus términos de referencia, variará de una firma de auditoría a otra y dependerá del nivel de los recursos con que cuente la Firma en el momento de la inspección y de su habilidad para llevar a cabo el programa de manera efectiva.
En el caso de firmas de auditoría de reducida dimensión, esta función de seguimiento la pueden realizar profesionales externos, siempre que estén debidamente cualificados, o la Firma puede optar por contratar a otra firma de auditoría con la que tenga una alianza.
Esta libreria nos permite generar las cartas de control estadistico de la calidad con un objeto de clase “qcc” el cual puede ser graficado. Así se analizan importantes graficas como las curvas caracteristicas operartivas OC, Carta Schewhart, indices de capacidad del proceso y mas.
library(qcc)
Se dispone de tiempos de entrega, en la pizzería, de pedidos seleccionados aleatoriamente durante 25 días. En este caso el tamaño de muestra constante.
MUESTREO <- rep(x = 1:31, each = 5, len = 31*5)
TIEMPOSXDIA <- qcc.groups(data = DESPACHOS, sample = MUESTREO)
\[ \begin{align} LSL &= \overline{\bar{x}} - 3{\times}\frac{\widehat{\sigma}}{{d}_{2}}\\ &= \overline{\bar{x}} - 3{\times}\frac{\frac{\overline{R}}{{d}_{2}}}{\sqrt{n}}\\ &= \overline{\bar{x}} - \frac{3}{{d}_{2}\sqrt{n}}{\times}\overline{R} \end{align} \]
\[Center = \overline{\bar{x}}\]
\[ \begin{align} USL &= \overline{\bar{x}} + 3{\times}\frac{\widehat{\sigma}}{{d}_{2}}\\ &= \overline{\bar{x}} + 3{\times}\frac{\frac{\overline{R}}{{d}_{2}}}{\sqrt{n}}\\ &= \overline{\bar{x}} + \frac{3}{{d}_{2}\sqrt{n}}{\times}\overline{R} \end{align} \]
xbarra <- qcc(data = TIEMPOSXDIA, type="xbar")
summary(object = xbarra)
##
## Call:
## qcc(data = TIEMPOSXDIA, type = "xbar")
##
## xbar chart for TIEMPOSXDIA
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 38.60000 42.90000 44.60000 44.75484 46.30000 50.60000
##
## Group sample size: 5
## Number of groups: 31
## Center of group statistics: 44.75484
## Standard deviation: 6.656866
##
## Control limits:
## LCL UCL
## 35.82372 53.68596
La carta xbar nos permite monitoreorear la media y la variación de un proceso cuando se tienen datos continuos.
xrango <- qcc(data = TIEMPOSXDIA[1:25,], type="R")
summary(object = xrango)
##
## Call:
## qcc(data = TIEMPOSXDIA[1:25, ], type = "R")
##
## R chart for TIEMPOSXDIA[1:25, ]
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.00 9.00 15.00 14.44 19.00 31.00
##
## Group sample size: 5
## Number of groups: 25
## Center of group statistics: 14.44
## Standard deviation: 6.208083
##
## Control limits:
## LCL UCL
## 0 30.53294
La carta R nos permite identificar el rango, con esta carta se detectarán cambios en la amplitud o magnitud de la variación del proceso.
xdes <- qcc(data = TIEMPOSXDIA[1:25,], type="S")
summary(object = xdes)
##
## Call:
## qcc(data = TIEMPOSXDIA[1:25, ], type = "S")
##
## S chart for TIEMPOSXDIA[1:25, ]
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000000 3.674235 6.188699 5.948425 7.635444 12.111978
##
## Group sample size: 5
## Number of groups: 25
## Center of group statistics: 5.948425
## Standard deviation: 6.328209
##
## Control limits:
## LCL UCL
## 0 12.42625
Es la forma de medir qué tanto se ajusta nuestro proceso a las expectativas del cliente, y por lo tanto muestra la variabilidad inherente de un proceso en ausencia de cualquier causa especial indeseable, lo que implica que la variabilidad del mismo es debida exclusivamente a causas comunes. La capacidad del proceso se utiliza también según la ISO 15504 trata de las bases del management y de la definición de procesos en una organización.
La capacidad del proceso puede subdividirse en:
Medición la variabilidad del proceso.
Contrastar la variabilidad medida con una tolerancia o especificación predefinida.
Mientras los procesos no sufran modificaciones o reajustes, para evaluar su capacidad suele recurrirse a algunas de las siete herramientas de la calidad, tales como:
Histogramas
Gráficos de control
Planillas de inspección
Cuando el proceso se ve modificado, por ejemplo con la implementación de una nueva máquina, o con un reajuste de métodos, debe efectuarse un estudio de índices de capacidad.
El principal requerimiento para iniciar con un estudio de aptitud del proceso consiste en que éste se encuentre estadísticamente estable. Además se precisa que:
Las mediciones individuales del proceso se comporten siguiendo una distribución normal.
Las especificaciones de ingeniería representen con exactitud los requerimientos de los clientes.
Los índices de capacidad se pueden clasificar según su posición y alcance temporal en:
Respecto a su posición
Índices centrados con respecto a los límites
Índices descentrados con respecto a los límites
Solo con límite superior
Solo con límite inferior
Respecto a su alcance temporal
A corto plazo: Capacidad potencial
A largo plazo: Capacidad global
Sí una vez determinadas las capacidades se encuentra una diferencia significativa entre los índices de corto y largo plazo, es un síntoma de inconsistencias en el proceso, y de que éste es susceptible de aplicar mejoras.
Para considerar que un producto sea de calidad, las mediciones de sus características deben ser iguales a su valor ideal, sin embargo al conocer que la variabilidad es una característica ínsita de todo proceso estas mediciones deben al menos estar dentro de cierta especificación inferior y/o superior. La medida de la capacidad potencial del proceso para cumplir con tales especificaciones de calidad nos la proporciona el índice de capacidad del proceso (Cp).
Cuando se han identificado desviaciones en el comportamiento estadístico de las mediciones de alguna característica de calidad, la evaluación de la capacidad del proceso inicia después de que en las gráficas de control las causas especiales han sido identificadas, analizadas y corregidas, por ende, las gráficas actuales de control muestran un proceso dentro de control estadístico.
El Cp compara el ancho de las especificaciones (tolerancia) con la amplitud de la variación (dispersión natural) del proceso. Sí la variación del proceso es mayor que la amplitud de las especificaciones, entonces el Cp es menor que 1, lo que sería evidencia de que no se está cumpliendo con las especificaciones. Sí el Cp es mayor que 1 es una evidencia de que el proceso es potencialmente capaz de cumplir con las especificaciones.
El Cp se utiliza para conocer y tomar decisiones sobre el proceso dependiendo de su valor, es el tipo de proceso y la decisión que debe de tomarse. La siguiente tabla nos muestra la interpretación cualitativa del índice Cp.
Suponiendo una característica de calidad cuya variable de respuesta sigue una distribución normal, es posible afirmar que dicha curva representa lo que está ocurriendo, efectivamente, en el proceso, es decir, es la “realidad del proceso”; de otro lado, los límites de especificación definen lo que se considerará una falla y, por en consecuencia, representan la “necesidad del cliente” e indica lo que debería ocurrir.
De entre los más utilizados, el Cp mide la capacidad potencial de un proceso, pues, evalúa si el proceso es potencialmente capaz de cumplir con las especificaciones del cliente o no, y para ello compara la variación tolerada con la variación real:
\[ \begin{align} Cp &= \frac{Vaciación\ tolerada}{Varicación\ real}\\ &= \frac{USL - LSL}{6{\sigma}} \end{align} \]
Y en este sentido es posible interpretar que lo deseable es que los procesos tengan un índice Cp mayor a \(1\) y, por el contrario, si fuese menor a \(1\), sería evidencia suficiente de que el proceso no será capaz de cumplir con las especificaciones. Además, el analisis de capacidad de proceso nos provee una matriz de índices de capacidad y los límites de confianza correspondientes.
Cp | Categoría del proceso | Descripción del proceso |
---|---|---|
Cp > 2 | Word class | Seis sigma |
1.33 < Cp < 2 | 1 | Adecuado |
1 < Cp < 1.33 | 2 | Requiere control estricto |
0.67 < Cp < 1 | 3 | Requiere modificaciones serias |
Cp < 0.67 | 4 | No adecuado |
Para evaluar la capacidad de procesos no centrados, se utilizan dos índices complementarios: Cpi y Cps. Estos evalúan al proceso contra cada uno de sus límites, es decir, Cpi mide la capacidad del proceso de cumplir con la especificación inferior mientras que Cps lo hace con la especificación superior.
\[ \begin{align} Cp_l &= \frac{Vaciación\ tolerada\ superior}{Varicación\ real\ superior}\\ &= \frac{Target - LSL}{3{\sigma}} \end{align} \]
\[ \begin{align} Cp_u &= \frac{Vaciación\ tolerada\ inferior}{Varicación\ real\ inferior}\\ &= \frac{USL - Target}{3{\sigma}} \end{align} \]
Sin embargo, para expresar la capacidad global del proceso, consideramos el caso menos favorable: aquel en el cual la media (Target \(\mu\)) se encuentra más cerca del límite de especificación. Es decir: el menor valor entre Cpi y Cps. A este valor lo denominamos Cpk:
\[ Cp_k = \min(Cp_l,Cp_u) \]
A fin de apoyar la interpretación del mismo, podemos identificar algunas consideraciones:
Cp es siempre positivo
Si el proceso está centrado Cpk = Cp
Cpk puede ser positivo, cero o negativo
Si Cpk es cero, el 50% del producto está fuera de especificación
Si Cpk es negativo, más del 50% del producto está fuera de especificación
Si nos adentramos un poco más en la medición de capacidad de los procesos, podremos observar que estos tienen fluctuaciones según el marco temporal en que lo midamos. Hay estudios que indican que, en el largo plazo, la media del proceso suele desplazarse hasta \(1.5{\sigma}\) respecto a la medida turno a turno o día a día.
En términos generales, Seis Sigma dejó de ser una medida netamente estadística y se convirtió en el nombre propio de la estrategia para mejorar la calidad de los procesos, mediante la identificación y eliminación de los defectos, así como la minimización de la variabilidad en las salidas del proceso.
El tiempo de retraso en los pedidos de la pizzería ha sido seguido tomando un total de 720 iempos de entrega con retraso por día 720, durante 80 días para analizar si el proceso se encuentra bajo control estadístico o no, se analiza a continuación la capacidad del proceso.
process.capability(object = xbarra, spec.limits = c(30, 60), confidence.level = 0.95)
##
## Process Capability Analysis
##
## Call:
## process.capability(object = xbarra, spec.limits = c(30, 60), confidence.level = 0.95)
##
## Number of obs = 155 Target = 45
## Center = 44.75 LSL = 30
## StdDev = 6.657 USL = 60
##
## Capability indices:
##
## Value 2.5% 97.5%
## Cp 0.7511 0.6673 0.8348
## Cp_l 0.7388 0.6568 0.8209
## Cp_u 0.7634 0.6794 0.8474
## Cp_k 0.7388 0.6410 0.8366
## Cpm 0.7506 0.6670 0.8341
##
## Exp<LSL 1.3% Obs<LSL 1.3%
## Exp>USL 1.1% Obs>USL 1.9%
Cálculo de los índices de capacidad del proceso; \({C}_{p}\), \({C}_{pk}\) y \(Z\) (Sigma Score)
ss.ca.cp(x = rowMeans(TIEMPOSXDIA, na.rm = TRUE), LSL = 30, USL = 60, LT = FALSE, f.na.rm = TRUE,
ci = TRUE, alpha = 0.05)
## [1] 1.213074 2.029107
ss.ca.cpk(x = rowMeans(TIEMPOSXDIA, na.rm = TRUE), LSL = 30, USL = 60, LT = FALSE, f.na.rm = TRUE,
ci = TRUE, alpha = 0.05)
## [1] 1.174691 2.015273
ss.ca.z(x = rowMeans(TIEMPOSXDIA, na.rm = TRUE), LSL = 30, USL = 60, LT = FALSE, f.na.rm = TRUE)
## [1] 4.784947
Histograma y densidad sobre los datos del proceso. Comprobación de la normalidad mediante el gráfico de qqplot y pruebas de normalidad; Límites de Especificación e Índices de Capacidad.
ss.study.ca(xST = rowMeans(TIEMPOSXDIA, na.rm = TRUE), Target = 45, LSL = 30, USL = 60, alpha = 0.05, f.sub = "Retrasos en entregas de la pizzería")
qcc(data = TIEMPOSXDIA[1:15,], type = "xbar", newdata = TIEMPOSXDIA[16:31,], nsigmas=2)
## List of 15
## $ call : language qcc(data = TIEMPOSXDIA[1:15, ], type = "xbar", newdata = TIEMPOSXDIA[16:31, ], nsigmas = 2)
## $ type : chr "xbar"
## $ data.name : chr "TIEMPOSXDIA[1:15, ]"
## $ data : num [1:15, 1:5] 38 54 56 46 42 48 55 34 37 47 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics : Named num [1:15] 38.6 45.4 50.2 48.8 43 48.6 45 44 47 44.6 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ sizes : Named int [1:15] 5 5 5 5 5 5 5 5 5 5 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ center : num 45.4
## $ std.dev : num 6.56
## $ newstats : Named num [1:16] 44.6 46 40.2 50 46.4 46.2 40.2 43.6 39.2 44.2 ...
## ..- attr(*, "names")= chr [1:16] "16" "17" "18" "19" ...
## $ newdata : num [1:16, 1:5] 47 50 47 49 48 45 39 50 50 52 ...
## ..- attr(*, "dimnames")=List of 2
## $ newsizes : Named int [1:16] 5 5 5 5 5 5 5 5 5 5 ...
## ..- attr(*, "names")= chr [1:16] "16" "17" "18" "19" ...
## $ newdata.name: chr "TIEMPOSXDIA[16:31, ]"
## $ nsigmas : num 2
## $ limits : num [1, 1:2] 39.6 51.3
## ..- attr(*, "dimnames")=List of 2
## $ violations :List of 2
## - attr(*, "class")= chr "qcc"
qcc(TIEMPOSXDIA[1:15,], type="R", newdata = TIEMPOSXDIA[16:31,])
## List of 15
## $ call : language qcc(data = TIEMPOSXDIA[1:15, ], type = "R", newdata = TIEMPOSXDIA[16:31, ])
## $ type : chr "R"
## $ data.name : chr "TIEMPOSXDIA[1:15, ]"
## $ data : num [1:15, 1:5] 38 54 56 46 42 48 55 34 37 47 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics : Named num [1:15] 7 25 31 18 2 18 16 19 15 11 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ sizes : Named int [1:15] 5 5 5 5 5 5 5 5 5 5 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ center : num 15.3
## $ std.dev : num 6.56
## $ newstats : Named num [1:16] 7 9 10 22 15 4 6 23 21 15 ...
## ..- attr(*, "names")= chr [1:16] "16" "17" "18" "19" ...
## $ newdata : num [1:16, 1:5] 47 50 47 49 48 45 39 50 50 52 ...
## ..- attr(*, "dimnames")=List of 2
## $ newsizes : Named int [1:16] 5 5 5 5 5 5 5 5 5 5 ...
## ..- attr(*, "names")= chr [1:16] "16" "17" "18" "19" ...
## $ newdata.name: chr "TIEMPOSXDIA[16:31, ]"
## $ nsigmas : num 3
## $ limits : num [1, 1:2] 0 32.3
## ..- attr(*, "dimnames")=List of 2
## $ violations :List of 2
## - attr(*, "class")= chr "qcc"
qcc(TIEMPOSXDIA[1:15,], type="S", newdata = TIEMPOSXDIA[16:31,])
## List of 15
## $ call : language qcc(data = TIEMPOSXDIA[1:15, ], type = "S", newdata = TIEMPOSXDIA[16:31, ])
## $ type : chr "S"
## $ data.name : chr "TIEMPOSXDIA[1:15, ]"
## $ data : num [1:15, 1:5] 38 54 56 46 42 48 55 34 37 47 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics : Named num [1:15] 2.61 10.81 12.11 6.57 1 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ sizes : Named int [1:15] 5 5 5 5 5 5 5 5 5 5 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ center : num 6.11
## $ std.dev : num 6.5
## $ newstats : Named num [1:16] 3.21 3.67 4.15 9.85 6.19 ...
## ..- attr(*, "names")= chr [1:16] "16" "17" "18" "19" ...
## $ newdata : num [1:16, 1:5] 47 50 47 49 48 45 39 50 50 52 ...
## ..- attr(*, "dimnames")=List of 2
## $ newsizes : Named int [1:16] 5 5 5 5 5 5 5 5 5 5 ...
## ..- attr(*, "names")= chr [1:16] "16" "17" "18" "19" ...
## $ newdata.name: chr "TIEMPOSXDIA[16:31, ]"
## $ nsigmas : num 3
## $ limits : num [1, 1:2] 0 12.8
## ..- attr(*, "dimnames")=List of 2
## $ violations :List of 2
## - attr(*, "class")= chr "qcc"
Las curvas de operación son útiles para evaluar a priori la sensibilidad del gráfico de control frente a desplazamiento del proceso o al cambio de su variabilidad. De estas curvas se deduce que el hecho de que “los puntos estén dentro de los límites” proporciona muy poca seguridad de que el proceso se encuentre realmente bajo control estadístico y pone de manifiesto las limitaciones de esta técnica. La aplicación de gráficos de control debe continuarse con técnicas estadísticas avanzadas encaminadas al conocimiento de los parámetros que influyen en el proceso (CTP en terminología 6 Sigma) y a la reducción de la variabilidad (o lo que es lo mismo, al aumento de los índices de capacidad. La curva CO se construye a partir de la grafica del riesgo Beta contra la magitud del cambio que se desee detectar, expresado en unidades de desviacion estandar para varios tamaños muestrales n. Así, poder evaluar las probabilidades.
\[ d = \frac{{\mu}_{1}- {\mu}_{0}}{{\sigma}_{}} \]
\[ {\lambda} = \frac{{\sigma}_{1}}{{\sigma}_{0}} \]
La probabilidad de que la media muestral caiga dentro de los límites de control en función de \(\lambda\) y \(d\) es:
\[ \begin{align} Pr(d,\lambda) &= Pr\left(\frac{{\mu}_{1}-LCL}{\frac{{\sigma}_{1}}{\sqrt{n}}}\leq\frac{\overline{x}-{\mu}_{1}}{\frac{{\sigma}_{1}}{\sqrt{n}}}\leq\frac{LCS-{\mu}_{1}}{\frac{{\sigma}_{1}}{\sqrt{n}}}\right)\\ &= Pr\left(\frac{{\mu}_{1}-LCL}{\lambda}\leq\frac{\overline{x}-{\mu}_{1}}{\lambda\frac{{\sigma}_{0}}{\sqrt{n}¸}}\leq\frac{LCS-{\mu}_{1}}{\lambda}\right) \end{align} \]
beta <- oc.curves.xbar(qcc(data = TIEMPOSXDIA, type = "xbar", nsigmas = 3, plot = TRUE))
Si analizamos los dos efectos por separado y dibujamos las curvas para distintos tamaños de muestras, vemos que el gráfico de medias es sensible al desplazamiento y muy poco sensible al cambio de la variabilidad.
print(x = round(x = beta, digits = 4))
## sample size
## shift (std.dev) n=5 n=1 n=10 n=15 n=20
## 0 0.9973 0.9973 0.9973 0.9973 0.9973
## 0.05 0.9971 0.9973 0.9970 0.9968 0.9966
## 0.1 0.9966 0.9972 0.9959 0.9952 0.9944
## 0.15 0.9957 0.9970 0.9940 0.9920 0.9900
## 0.2 0.9944 0.9968 0.9909 0.9869 0.9823
## 0.25 0.9925 0.9964 0.9864 0.9789 0.9701
## 0.3 0.9900 0.9960 0.9798 0.9670 0.9514
## 0.35 0.9866 0.9956 0.9708 0.9500 0.9243
## 0.4 0.9823 0.9950 0.9586 0.9266 0.8871
## 0.45 0.9769 0.9943 0.9426 0.8957 0.8383
## 0.5 0.9701 0.9936 0.9220 0.8562 0.7775
## 0.55 0.9616 0.9927 0.8963 0.8078 0.7055
## 0.6 0.9514 0.9916 0.8649 0.7505 0.6243
## 0.65 0.9390 0.9905 0.8275 0.6853 0.5371
## 0.7 0.9243 0.9892 0.7842 0.6137 0.4481
## 0.75 0.9071 0.9877 0.7351 0.5379 0.3616
## 0.8 0.8871 0.9860 0.6809 0.4608 0.2817
## 0.85 0.8642 0.9842 0.6225 0.3851 0.2115
## 0.9 0.8383 0.9821 0.5612 0.3136 0.1527
## 0.95 0.8094 0.9798 0.4983 0.2485 0.1059
## 1 0.7775 0.9772 0.4355 0.1913 0.0705
## 1.05 0.7428 0.9744 0.3743 0.1431 0.0450
## 1.1 0.7055 0.9713 0.3161 0.1038 0.0275
## 1.15 0.6659 0.9678 0.2622 0.0730 0.0161
## 1.2 0.6243 0.9641 0.2134 0.0497 0.0090
## 1.25 0.5812 0.9599 0.1703 0.0328 0.0048
## 1.3 0.5371 0.9554 0.1333 0.0209 0.0024
## 1.35 0.4925 0.9505 0.1022 0.0129 0.0012
## 1.4 0.4481 0.9452 0.0768 0.0077 0.0006
## 1.45 0.4043 0.9394 0.0564 0.0045 0.0002
## 1.5 0.3616 0.9332 0.0406 0.0025 0.0001
## 1.55 0.3206 0.9265 0.0286 0.0013 0.0000
## 1.6 0.2817 0.9192 0.0197 0.0007 0.0000
## 1.65 0.2453 0.9115 0.0133 0.0003 0.0000
## 1.7 0.2115 0.9032 0.0088 0.0002 0.0000
## 1.75 0.1806 0.8943 0.0056 0.0001 0.0000
## 1.8 0.1527 0.8849 0.0036 0.0000 0.0000
## 1.85 0.1278 0.8749 0.0022 0.0000 0.0000
## 1.9 0.1059 0.8643 0.0013 0.0000 0.0000
## 1.95 0.0869 0.8531 0.0008 0.0000 0.0000
## 2 0.0705 0.8413 0.0004 0.0000 0.0000
## 2.05 0.0566 0.8289 0.0002 0.0000 0.0000
## 2.1 0.0450 0.8159 0.0001 0.0000 0.0000
## 2.15 0.0353 0.8023 0.0001 0.0000 0.0000
## 2.2 0.0275 0.7881 0.0000 0.0000 0.0000
## 2.25 0.0211 0.7734 0.0000 0.0000 0.0000
## 2.3 0.0161 0.7580 0.0000 0.0000 0.0000
## 2.35 0.0121 0.7422 0.0000 0.0000 0.0000
## 2.4 0.0090 0.7257 0.0000 0.0000 0.0000
## 2.45 0.0066 0.7088 0.0000 0.0000 0.0000
## 2.5 0.0048 0.6915 0.0000 0.0000 0.0000
## 2.55 0.0034 0.6736 0.0000 0.0000 0.0000
## 2.6 0.0024 0.6554 0.0000 0.0000 0.0000
## 2.65 0.0017 0.6368 0.0000 0.0000 0.0000
## 2.7 0.0012 0.6179 0.0000 0.0000 0.0000
## 2.75 0.0008 0.5987 0.0000 0.0000 0.0000
## 2.8 0.0006 0.5793 0.0000 0.0000 0.0000
## 2.85 0.0004 0.5596 0.0000 0.0000 0.0000
## 2.9 0.0002 0.5398 0.0000 0.0000 0.0000
## 2.95 0.0002 0.5199 0.0000 0.0000 0.0000
## 3 0.0001 0.5000 0.0000 0.0000 0.0000
## 3.05 0.0001 0.4801 0.0000 0.0000 0.0000
## 3.1 0.0000 0.4602 0.0000 0.0000 0.0000
## 3.15 0.0000 0.4404 0.0000 0.0000 0.0000
## 3.2 0.0000 0.4207 0.0000 0.0000 0.0000
## 3.25 0.0000 0.4013 0.0000 0.0000 0.0000
## 3.3 0.0000 0.3821 0.0000 0.0000 0.0000
## 3.35 0.0000 0.3632 0.0000 0.0000 0.0000
## 3.4 0.0000 0.3446 0.0000 0.0000 0.0000
## 3.45 0.0000 0.3264 0.0000 0.0000 0.0000
## 3.5 0.0000 0.3085 0.0000 0.0000 0.0000
## 3.55 0.0000 0.2912 0.0000 0.0000 0.0000
## 3.6 0.0000 0.2743 0.0000 0.0000 0.0000
## 3.65 0.0000 0.2578 0.0000 0.0000 0.0000
## 3.7 0.0000 0.2420 0.0000 0.0000 0.0000
## 3.75 0.0000 0.2266 0.0000 0.0000 0.0000
## 3.8 0.0000 0.2119 0.0000 0.0000 0.0000
## 3.85 0.0000 0.1977 0.0000 0.0000 0.0000
## 3.9 0.0000 0.1841 0.0000 0.0000 0.0000
## 3.95 0.0000 0.1711 0.0000 0.0000 0.0000
## 4 0.0000 0.1587 0.0000 0.0000 0.0000
## 4.05 0.0000 0.1469 0.0000 0.0000 0.0000
## 4.1 0.0000 0.1357 0.0000 0.0000 0.0000
## 4.15 0.0000 0.1251 0.0000 0.0000 0.0000
## 4.2 0.0000 0.1151 0.0000 0.0000 0.0000
## 4.25 0.0000 0.1056 0.0000 0.0000 0.0000
## 4.3 0.0000 0.0968 0.0000 0.0000 0.0000
## 4.35 0.0000 0.0885 0.0000 0.0000 0.0000
## 4.4 0.0000 0.0808 0.0000 0.0000 0.0000
## 4.45 0.0000 0.0735 0.0000 0.0000 0.0000
## 4.5 0.0000 0.0668 0.0000 0.0000 0.0000
## 4.55 0.0000 0.0606 0.0000 0.0000 0.0000
## 4.6 0.0000 0.0548 0.0000 0.0000 0.0000
## 4.65 0.0000 0.0495 0.0000 0.0000 0.0000
## 4.7 0.0000 0.0446 0.0000 0.0000 0.0000
## 4.75 0.0000 0.0401 0.0000 0.0000 0.0000
## 4.8 0.0000 0.0359 0.0000 0.0000 0.0000
## 4.85 0.0000 0.0322 0.0000 0.0000 0.0000
## 4.9 0.0000 0.0287 0.0000 0.0000 0.0000
## 4.95 0.0000 0.0256 0.0000 0.0000 0.0000
## 5 0.0000 0.0228 0.0000 0.0000 0.0000
Ahora analizaremos el proceso para tamaños de muestra grande
MUESTRA <- c(rep(1,5),rep(2,5),rep(3:5,each=5,length=15),rep(6:7,each=4,length=8),
rep(8,5),rep(9,4),rep(10:12,each=5,length=15),rep(13,3),rep(14,5),rep(15,3),
rep(16,5),rep(17,4),rep(18:19,each=5,length=10),rep(20,3),rep(21:25,each=5,length=25),rep(26,5),rep(27,5),rep(28:29,each=5,length=10),rep(30:31,each=5,length=15),rep(32,5))
La función qcc.groups devuelve una matriz de dimensiones adecuadas. Si uno o más grupos tienen pocas observaciones que otros, se agregan los valores NA
TIEMPOSXGRUPO <- qcc.groups(data = TIEMPOSXDIA, sample = MUESTRA)
Se visualizan los datos asignados a los grupos completando con datos faltantes
head(x = TIEMPOSXGRUPO, n = 5)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## 1 38 54 56 46 42 NA NA NA NA NA
## 2 48 55 34 37 47 NA NA NA NA NA
## 3 45 53 38 48 47 NA NA NA NA NA
## 4 47 50 47 49 48 NA NA NA NA NA
## 5 45 39 50 50 52 NA NA NA NA NA
Se realiza una carta x barra
xbarra <- qcc(data = TIEMPOSXGRUPO[1:15,], type="xbar")
Establecer limites por intervalos correpondientes a la tendencia de los datos esto nos permite tener un ajuste personalizado para controlar el proceso.
xrango <- qcc(data = TIEMPOSXGRUPO[1:15,], type="R")
en el UCL aunque conserva su LCL en o constante.
xdes <- qcc(data = TIEMPOSXGRUPO[1:15,], type="S")
La carta S de desviacion estandar esta bajo control.
process.capability(object = xbarra, spec.limits = c(30, 60), confidence.level = 0.95)
##
## Process Capability Analysis
##
## Call:
## process.capability(object = xbarra, spec.limits = c(30, 60), confidence.level = 0.95)
##
## Number of obs = 68 Target = 45
## Center = 44.56 LSL = 30
## StdDev = 6.917 USL = 60
##
## Capability indices:
##
## Value 2.5% 97.5%
## Cp 0.7229 0.6007 0.8449
## Cp_l 0.7016 0.5818 0.8214
## Cp_u 0.7441 0.6192 0.8690
## Cp_k 0.7016 0.5588 0.8444
## Cpm 0.7214 0.6001 0.8425
##
## Exp<LSL 1.8% Obs<LSL 1.5%
## Exp>USL 1.3% Obs>USL 1.5%
TiemposCocina
## [1] 38 36 23 27 25 24 32 41 30 27 26 23 28 27 23 30 45 40 32 34 25 28 30 34 27
## [26] 28 23 17 29 38 37 29 22 32 25 33 35 29 43 32 24 36 30 31 28 31 27 37 23 42
Carta x barra para datos individuales.
xbarone <- qcc(data = TiemposCocina, type="xbar.one")
summary(xbarone)
##
## Call:
## qcc(data = TiemposCocina, type = "xbar.one")
##
## xbar.one chart for TiemposCocina
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 17.00 26.25 29.50 30.32 34.00 45.00
##
## Group sample size: 1
## Number of groups: 50
## Center of group statistics: 30.32
## Standard deviation: 5.71718
##
## Control limits:
## LCL UCL
## 13.16846 47.47154
Se tiene la carta XBar bajo control incluso se podria ajustar los limites para precisar la variabilidad.
process.capability(xbarone, spec.limits = c(15, 45), confidence.level = 0.95)
##
## Process Capability Analysis
##
## Call:
## process.capability(object = xbarone, spec.limits = c(15, 45), confidence.level = 0.95)
##
## Number of obs = 50 Target = 30
## Center = 30.32 LSL = 15
## StdDev = 5.717 USL = 45
##
## Capability indices:
##
## Value 2.5% 97.5%
## Cp 0.8746 0.7018 1.047
## Cp_l 0.8932 0.7258 1.061
## Cp_u 0.8559 0.6939 1.018
## Cp_k 0.8559 0.6629 1.049
## Cpm 0.8732 0.7022 1.044
##
## Exp<LSL 0.37% Obs<LSL 0%
## Exp>USL 0.51% Obs>USL 0%
Dentro de los gráficos de control por atributos (esto es, para variables categóricas), nos encontramos ante varios tipos de gráficos. Dos de ellos son los gráficos P y NP. El gráfico P se utiliza para controlar proporciones, mientras que el NP para conteos cuando, por ejemplo, la proporción tiende a ser muy pequeñas; y dentro de grupos con un tamaño determinado, por ejemplo, lotes, pedidos en un día, etc.
PedidosErrados
## [,1] [,2] [,3] [,4] [,5]
## 1 1 1 1 1 1
## 2 0 1 0 1 1
## 3 1 1 1 1 1
## 4 1 1 1 1 1
## 5 1 1 0 1 0
## 6 0 1 0 1 1
## 7 1 0 1 1 0
## 8 1 1 0 1 1
## 9 1 0 1 0 0
## 10 1 1 0 1 1
## 11 1 0 0 1 1
## 12 1 1 1 1 1
## 13 0 1 1 1 1
## 14 0 1 0 1 1
## 15 1 1 1 0 0
## 16 1 1 1 0 1
## 17 1 1 1 0 1
## 18 1 1 1 1 1
## 19 0 1 1 0 1
## 20 1 1 0 1 1
## 21 1 1 0 0 1
## 22 1 1 1 0 1
## 23 0 0 1 0 1
## 24 1 0 1 0 1
## 25 0 0 1 1 1
## 26 1 0 1 1 1
## 27 1 1 1 0 1
## 28 1 1 1 0 1
## 29 1 1 1 1 1
## 30 1 1 1 1 1
## 31 1 1 1 1 1
grap <- qcc(data = rowSums(PedidosErrados), type = "p", sizes = rep(5,31), rules = shewhart.rules)
La visualización de los gráficos P y NP es la misma, lo que cambia es la escala: proporciones y números naturales, respectivamente.
summary(grap)
##
## Call:
## qcc(data = rowSums(PedidosErrados), type = "p", sizes = rep(5, 31), rules = shewhart.rules)
##
## p chart for rowSums(PedidosErrados)
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.4000000 0.6000000 0.8000000 0.7548387 0.9000000 1.0000000
##
## Group sample size: 5
## Number of groups: 31
## Center of group statistics: 0.7548387
## Standard deviation: 0.4301828
##
## Control limits:
## LCL UCL
## 0.1776879 1
## 0.1776879 1
## ...
## 0.1776879 1
granp <- qcc(data = rowSums(PedidosErrados), type = "np", sizes = rep(5,31), rules = shewhart.rules)
summary(granp)
##
## Call:
## qcc(data = rowSums(PedidosErrados), type = "np", sizes = rep(5, 31), rules = shewhart.rules)
##
## np chart for rowSums(PedidosErrados)
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.000000 3.000000 4.000000 3.774194 4.500000 5.000000
##
## Group sample size: 5
## Number of groups: 31
## Center of group statistics: 3.774194
## Standard deviation: 0.961918
##
## Control limits:
## LCL UCL
## 0.8884397 5
La carta NP tambien nos muestra dos defectos que superan el UCL. Miremos la curva operativa del proceso.
beta3 <- oc.curves(qcc(data = rowSums(PedidosErrados), type = "np", sizes = rep(5,31), rules = shewhart.rules))
## Warning in oc.curves.p(object, ...): Some computed values for the type II error
## have been rounded due to the discreteness of the binomial distribution. Thus,
## some ARL values might be meaningless.
nn2<-rep(50,28)
dis2<-c(12,15,8,10,4,7,16,9,14,10,5,6,17,12,8,10,5,13,
11,20,18,15,9,12,7,13,9,6)
grap3<-qcc(dis2,type="p",sizes=nn2,rules = shewhart.rules)
summary(grap3)
##
## Call:
## qcc(data = dis2, type = "p", sizes = nn2, rules = shewhart.rules)
##
## p chart for dis2
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.080 0.155 0.200 0.215 0.265 0.400
##
## Group sample size: 50
## Number of groups: 28
## Center of group statistics: 0.215
## Standard deviation: 0.4108223
##
## Control limits:
## LCL UCL
## 0.04070284 0.3892972
## 0.04070284 0.3892972
## ...
## 0.04070284 0.3892972
granp4<-qcc(dis2,type="np",sizes=nn2,rules = shewhart.rules)
summary(granp4)
##
## Call:
## qcc(data = dis2, type = "np", sizes = nn2, rules = shewhart.rules)
##
## np chart for dis2
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 4.00 7.75 10.00 10.75 13.25 20.00
##
## Group sample size: 50
## Number of groups: 28
## Center of group statistics: 10.75
## Standard deviation: 2.904953
##
## Control limits:
## LCL UCL
## 2.035142 19.46486
nn3<-rep(50,54);nn3
## [1] 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50
## [26] 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50 50
## [51] 50 50 50 50
dis3<-c(12,15,8,10,4,7,16,9,14,10,5,6,17,12,22,8,10,5,13,
11,20,18,24,15,9,12,7,13,9,6,9,6,12,5,6,4,6,3,7,6,2,4,3,6,5,4,8,5,6,7,5,6,3,5)
nn4<-nn3[1:30]
nn5<-nn3[31:54]
prueba<-dis3[1:30]
moni<-dis3[31:54]
q1<-qcc(prueba,sizes=nn4, type="p")
summary(q1)
##
## Call:
## qcc(data = prueba, type = "p", sizes = nn4)
##
## p chart for prueba
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0800000 0.1600000 0.2100000 0.2313333 0.2950000 0.4800000
##
## Group sample size: 50
## Number of groups: 30
## Center of group statistics: 0.2313333
## Standard deviation: 0.421685
##
## Control limits:
## LCL UCL
## 0.05242755 0.4102391
## 0.05242755 0.4102391
## ...
## 0.05242755 0.4102391
q2<-qcc(moni,sizes=nn5, type="p")
summary(q2)
##
## Call:
## qcc(data = moni, type = "p", sizes = nn5)
##
## p chart for moni
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0400000 0.0800000 0.1100000 0.1108333 0.1200000 0.2400000
##
## Group sample size: 50
## Number of groups: 24
## Center of group statistics: 0.1108333
## Standard deviation: 0.3139256
##
## Control limits:
## LCL UCL
## 0 0.2440207
## 0 0.2440207
## ...
## 0 0.2440207
qcc(prueba,sizes=nn4, type="p", newdata=moni,newsizes=nn5,ylim=c(0,0.5))
## List of 15
## $ call : language qcc(data = prueba, type = "p", sizes = nn4, newdata = moni, newsizes = nn5, ylim = c(0, 0.5))
## $ type : chr "p"
## $ data.name : chr "prueba"
## $ data : num [1:30, 1] 12 15 8 10 4 7 16 9 14 10 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics : Named num [1:30] 0.24 0.3 0.16 0.2 0.08 0.14 0.32 0.18 0.28 0.2 ...
## ..- attr(*, "names")= chr [1:30] "1" "2" "3" "4" ...
## $ sizes : num [1:30] 50 50 50 50 50 50 50 50 50 50 ...
## $ center : num 0.231
## $ std.dev : num 0.422
## $ newstats : Named num [1:24] 0.18 0.12 0.24 0.1 0.12 0.08 0.12 0.06 0.14 0.12 ...
## ..- attr(*, "names")= chr [1:24] "31" "32" "33" "34" ...
## $ newdata : num [1:24, 1] 9 6 12 5 6 4 6 3 7 6 ...
## $ newsizes : num [1:24] 50 50 50 50 50 50 50 50 50 50 ...
## $ newdata.name: chr "moni"
## $ nsigmas : num 3
## $ limits : num [1:54, 1:2] 0.0524 0.0524 0.0524 0.0524 0.0524 ...
## ..- attr(*, "dimnames")=List of 2
## $ violations :List of 2
## - attr(*, "class")= chr "qcc"
muest<-c(rep(100,1),rep(80,2),rep(100,1),rep(110,2),rep(100,2),rep(90,2),
rep(110,1),rep(120,3),rep(110,1),rep(80,3),rep(90,1),rep(100,4),rep(90,2) )
discon<-c(12,8,6,9,10,12,11,16,10,6,20,15,9,8,6,8,10,7,5,8,5,8,10,6,9)
q3<-qcc(discon,sizes=muest, type="p")
prop2<-c(discon/muest)
plot(prop2,pch=16,type="o")
data.frame(muest,discon,prop2)
## muest discon prop2
## 1 100 12 0.12000000
## 2 80 8 0.10000000
## 3 80 6 0.07500000
## 4 100 9 0.09000000
## 5 110 10 0.09090909
## 6 110 12 0.10909091
## 7 100 11 0.11000000
## 8 100 16 0.16000000
## 9 90 10 0.11111111
## 10 90 6 0.06666667
## 11 110 20 0.18181818
## 12 120 15 0.12500000
## 13 120 9 0.07500000
## 14 120 8 0.06666667
## 15 110 6 0.05454545
## 16 80 8 0.10000000
## 17 80 10 0.12500000
## 18 80 7 0.08750000
## 19 90 5 0.05555556
## 20 100 8 0.08000000
## 21 100 5 0.05000000
## 22 100 8 0.08000000
## 23 100 10 0.10000000
## 24 90 6 0.06666667
## 25 90 9 0.10000000
n<-mean(muest)
muest2<-rep(n,25)
q4<-qcc(discon,sizes=muest2, type="p")
muest<-c(rep(100,1),rep(80,2),rep(100,1),rep(110,2),rep(100,2),rep(90,2),
rep(110,1),rep(120,3),rep(110,1),rep(80,3),rep(90,1),rep(100,4),rep(90,2) )
discon<-c(12,8,6,9,10,12,11,16,10,6,20,15,9,8,6,8,10,7,5,8,5,8,10,6,9)
muest2<-rep(1,25)
n<-mean(muest)
pro<-c(discon/muest);pro
## [1] 0.12000000 0.10000000 0.07500000 0.09000000 0.09090909 0.10909091
## [7] 0.11000000 0.16000000 0.11111111 0.06666667 0.18181818 0.12500000
## [13] 0.07500000 0.06666667 0.05454545 0.10000000 0.12500000 0.08750000
## [19] 0.05555556 0.08000000 0.05000000 0.08000000 0.10000000 0.06666667
## [25] 0.10000000
p<-mean(discon/n);p
## [1] 0.0955102
nop<-1-p;nop
## [1] 0.9044898
sigma<-sqrt(p*nop/muest);sigma
## [1] 0.02939184 0.03286107 0.03286107 0.02939184 0.02802402 0.02802402
## [7] 0.02939184 0.02939184 0.03098172 0.03098172 0.02802402 0.02683095
## [13] 0.02683095 0.02683095 0.02802402 0.03286107 0.03286107 0.03286107
## [19] 0.03098172 0.02939184 0.02939184 0.02939184 0.02939184 0.03098172
## [25] 0.03098172
zeta<-(pro-p)/sigma;zeta
## [1] 0.8332176 0.1366296 -0.6241490 -0.1874740 -0.1641846 0.4846095
## [7] 0.4929871 2.1941397 0.5035521 -0.9309858 3.0797861 1.0990961
## [13] -0.7644232 -1.0750098 -1.4617730 0.1366296 0.8974082 -0.2437597
## [19] -1.2896203 -0.5277045 -1.5483961 -0.5277045 0.1527566 -0.9309858
## [25] 0.1449176
length(zeta)
## [1] 25
length(muest2)
## [1] 25
length(discon)
## [1] 25
plot(zeta,ylim=c(-3,3),type="b")
abline(h=0)
abline(h=-3)
abline(h=3)
El objetivo de la carta c es analizar la variabilidad del número de defectos por subgrupo, cuando el tamaño de éste se mantiene constante. En esta carta se gra fica c i que es igual al número de defectos o eventos en el i-ésimo subgrupo o muestra
Los límites de control se obtienen suponiendo que el estadístico \({c}_{i}\) sigue una distribución de Poisson; por lo tanto, las estimaciones de la media y la desviación estándar de este estadístico están dadas por:
\[ \begin{align} {\mu}_{{c}_{i}} &= \overline{c}\\ &= \frac{total\ de\ defectos}{Total\ de\ subgrupos}\\ &= {\sigma}_{{c}_{i}} \end{align} \]
por ello, los límites de control de la carta c se obtienen con las expresiones
\[ LSL = \overline{c} - 3\sqrt{\overline{c}} \]
\[ center = \overline{c} \]
\[ USL = \overline{c} + 3\sqrt{\overline{c}} \]
disconf<-c(21,24,16,12,15,5,28,20,31,25,20,24,16,19,10,17,13,22,18,39,30,24,16,19,17,15)
tamaño<-rep(100,26)
q6<-qcc(disconf,sizes=tamaño,type="c")
summary(q6)
##
## Call:
## qcc(data = disconf, type = "c", sizes = tamaño)
##
## c chart for disconf
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5.00000 16.00000 19.00000 19.84615 24.00000 39.00000
##
## Group sample size: 100
## Number of groups: 26
## Center of group statistics: 19.84615
## Standard deviation: 4.454902
##
## Control limits:
## LCL UCL
## 6.481447 33.21086
beta4 <- oc.curves(qcc(disconf, sizes=tamaño, type="c", plot=TRUE))
## Warning in oc.curves.c(object, ...): Some computed values for the type II error
## have been rounded due to the discreteness of the Poisson distribution. Thus,
## some ARL values might be meaningless.
disconf2<-c(21,24,16,12,15,5,28,20,31,25,20,24,16,19,10,17,13,22,18,39,30,24,16,19,17,15 ,16,18,12,15,24,21,28,20,25,19,18,21,16,22,19,12,14,9,16,21)
tamaño2<-rep(100,46)
tamaño3<-tamaño2[1:26]
tamaño4<-tamaño2[27:46]
disconf3<-disconf2[1:26]
disconf4<-disconf2[27:46]
c1<-qcc(disconf3,sizes=tamaño3,type="c")
c2<-qcc(disconf4,sizes=tamaño4,type="c")
c3<-qcc(disconf3,sizes=tamaño3, type="c", newdata=disconf4,newsizes=tamaño4)
Cuando en el tipo de variables que se comentaron al inicio de esta sección (con distribución Poisson), el tamaño del subgrupo no es constante, se usa la carta \(u\), en la cual se analiza la variación del número promedio de defectos por artículo o unidad, en lugar del total de defectos en el subgrupo. Así, en esta carta, un subgrupo lo forman varias unidades. De manera que para cada subgrupo se grafica,
\[ {u}_{I} = \frac{{c}_{i}}{{n}_{i}} \]
donde \({c}_{i}\) es la cantidad de defectos en el subgrupo \(i\) y \({n}_{i}\) es el tamaño del subgrupo \(i\). Para calcular los límites es necesario estimar la media y la desviación estándar del estadístico \({u}_{i}\), que bajo el supuesto de que \({c}_{i}\) sigue una distribución Poisson, resultan ser
\[ \begin{align} {\mu}_{{u}_{i}} &= \overline{u}\\ &= \frac{total\ de\ defectos}{Total\ de\ articulos\ inspeccionados} \end{align} \]
\[ \begin{align} {\sigma}_{{u}_{i}} &= \sqrt{\frac{\overline{u}}{n}} \end{align} \]
Donde \(n\) es el tamaño de subgrupo. De esta manera, los límites de control en la carta \(u\) están dados por
\[ LSL = \overline{u} - 3\sqrt{\frac{\overline{u}}{n}} \]
\[ center = \overline{u} \]
\[ USL = \overline{c} + 3\sqrt{\frac{\overline{u}}{n}} \]
Cuando \(n\) no es el mismo en todos los subgrupos, entonces se sustituye por el tamaño promedio de subgrupo, \(\overline{n}\). Otra alternativa es obtener una carta con límites variables, en la que para cada subgrupo se calculan sus límites en función del tamaño del subgrupo \({n}_{i}\) y con éstos se evalúa el proceso para tal subgrupo.
tama<-rep(5,20)
total<-c(10,12,8,14,10,16,11,7,10,15,9,5,7,11,12,6,8,10,7,5)
q10<-qcc(total,sizes=tama,type="u")
beta5 <- oc.curves(qcc(total, sizes=tama, type="u", plot=TRUE))
## Warning in oc.curves.c(object, ...): Some computed values for the type II error
## have been rounded due to the discreteness of the Poisson distribution. Thus,
## some ARL values might be meaningless.
La ventaja de usar límites promedio es que al ser sólo un par de límites no es necesario calcularlos para cada punto y se tiene una perspectiva e interpretación más directa; pero su desventaja es que en ocasiones no detecta cambios, o puede ser que registre un cambio cuando en realidad no ocurrió.
defec<-c(14,12,20,11,7,10,21,16,19,23)
mue<-c(10,8,13,10,9.5,10,12,10.5,12,12.5)
q11<-qcc(defec,sizes=mue,type="u")
Una buena alternativa sería usar límites promedio cuando los tamaños muestrales no discrepen más del 20% entre sí.
Otra alternativa a usar cuando los tamaños de subgrupo son muy distintos entre sí, es construir una carta u estandarizada, en la cual, en lugar de graficar ui se grafica la siguiente variable estandarizada:
\[ {z}_{i} = \frac{{u}_{i} - \overline{u}}{\sqrt{\frac{\overline{u}}{{n}_{i}}}} \stackrel{\sim}{n{\rightarrow}\infty}{N}\left(0,1\right) \]
Por lo tanto, la línea central en esta carta es igual a cero, y los límites de control inferior y superior son –3 y 3, respectivamente
upro<-c(defec/mue);upro
## [1] 1.4000000 1.5000000 1.5384615 1.1000000 0.7368421 1.0000000 1.7500000
## [8] 1.5238095 1.5833333 1.8400000
ubarra<-c(sum(defec)/sum(mue));ubarra
## [1] 1.423256
zeta1<-(upro-ubarra)/(sqrt(ubarra/mue));zeta1
## [1] -0.06164389 0.18194872 0.34818035 -0.85685012 -1.77339822 -1.12191886
## [7] 0.94876140 0.27311859 0.46481431 1.23504583
plot(zeta1,type="o",ylim=c(-3,3))
abline(h=0,lty=2)
abline(h=-3,lty=2)
abline(h=3,lty=2)
Detección oportuna de cambios pequeños
tiempo<-c(286,948,536,124,816,729,4,143,431,8,2837,596,81,227,603,492,1199,1214,2831,96)
y<-tiempo^0.2777;y
## [1] 4.809865 6.709029 5.726497 3.813671 6.435412 6.237053 1.469576 3.967682
## [9] 5.390069 1.781509 9.096180 5.897744 3.388335 4.510954 5.916898 5.591891
## [17] 7.161238 7.186005 9.090833 3.552031
qcc(y, type="xbar.one")
## List of 11
## $ call : language qcc(data = y, type = "xbar.one")
## $ type : chr "xbar.one"
## $ data.name : chr "y"
## $ data : num [1:20, 1] 4.81 6.71 5.73 3.81 6.44 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics: Named num [1:20] 4.81 6.71 5.73 3.81 6.44 ...
## ..- attr(*, "names")= chr [1:20] "1" "2" "3" "4" ...
## $ sizes : int [1:20] 1 1 1 1 1 1 1 1 1 1 ...
## $ center : num 5.39
## $ std.dev : num 2.09
## $ nsigmas : num 3
## $ limits : num [1, 1:2] -0.888 11.661
## ..- attr(*, "dimnames")=List of 2
## $ violations:List of 2
## - attr(*, "class")= chr "qcc"
Carta fue propuesta por Page (1954), y el nombre de CUSUM se debe a que es una carta en la cual se grafica la suma acumulada de las desviaciones con respecto a la media global
\[ \begin{align} {S}_{1} &= \left(\overline{x}_{1} - \widehat{\mu}\right)\\ {S}_{2} &= \left(\overline{x}_{1} - \widehat{\mu}\right) + \left(\overline{x}_{2} - \widehat{\mu}\right)\\ {S}_{3} &= \left(\overline{x}_{1} - \widehat{\mu}\right) + \left(\overline{x}_{2} - \widehat{\mu}\right) + \left(\overline{x}_{3} - \widehat{\mu}\right)\\ &\vdots\\ {S}_{p} &= \left(\overline{x}_{1} - \widehat{\mu}\right) + \left(\overline{x}_{2} - \widehat{\mu}\right) + \left(\overline{x}_{3} - \widehat{\mu}\right) + \cdots + \left(\overline{x}_{p} - \widehat{\mu}\right)\\ &= {\sum}_{i=1}^{p}\left(\overline{x}_{i} - \widehat{\mu}\right) \end{align} \]
Si el proceso está centrado, se podrían considerar las desviaciones con respecto al valor nominal de la característica de interés
Mientras el proceso se mantenga en control estadístico centrado sobre \(\widehat{\mu}\), los valores de estas sumas acumuladas oscilarán alrededor de cero
La suma \({S}_{m}\) pondera por igual a todas las medias observadas hasta ese momento.
Si el proceso se va modificando poco a poco o cambia a una nueva media, entonces las sumas acumuladas serán bastante sensibles para detectar el cambio rápidamente.
Hay dos maneras de construir esta carta:
La CUSUM de dos lados, que se interpreta con un dispositivo especial llamado “máscara”
\[ \begin{align} d &\stackrel{\ \ \ \ \ \ \ \ }{=} \frac{h}{k}\\ &\stackrel{\ \ \ \ \ \ \ \ }{=} \frac{1}{2k^2}\ln{\left(\frac{1-\beta}{\alpha}\right)}\\ &\stackrel{\beta<.1}{=} \frac{-1}{2k^2}\ln{\left(\alpha\right)}\\ \end{align} \]
y
\[ {\alpha} = \exp{\left({-2dk^2}\right)} \]
Al conocer dos de los parámetros del conjunto \(\left\{\alpha, \theta, d, h, k\right\}\) es posible deducir los tres restantes.
\[ \begin{align} \theta &= \arctan\left[\frac{k}{2}\right]\\ &= \arctan\left[\frac{h}{2d}\right]\\ \end{align} \]
\[ \begin{align} {S}_{H}(i) = \max{\left\{0, \overline{x}_{i} - ({\mu}_{0} + K) + {S}_{H}(i-1)\right\}}\}\\ {S}_{L}(i) = \max{\left\{0, ({\mu}_{0} + K) - \overline{x}_{i} + {S}_{L}(i-1)\right\}} \end{align} \]
Con \({S}_{H}(0) = 0\) y \({S}_{L}(0) = 0\).
El parámetro K es el valor de referencia y corresponde a la mitad del cambio de nivel que interesa detectar expresado en las unidades originales, es decir, \(K = k{\sigma}_{\overline{x}}\).
El criterio para decidir que el proceso está fuera de control es que alguna de las sumas rebase el intervalo de decisión dado por \(H = h{\sigma}_{\overline{x}}\)
Las sumas anteriores sólo acumulan cuando la media observada se aleja de la media del proceso más allá de \(K\);uando no acumulan al menos esta cantidad asumen el valor cero.
Los números \({N}_{H}\) y \({N}_{L}\) en una tabla (por aproximaciones), que cuentan los puntos consecutivos donde las sumas se mantienen distintas de cero, son útiles para estimar la nueva media del proceso una vez que se sale de control. Tal estimación se hace mediante una de las siguientes fórmulas:
\[ \begin{align} \widehat{\mu} &= \mu_0 + K \frac{{S}_{H}(i)}{{N}_{H}}\text{ si }{S}_{H}(i)>H\\ \widehat{\mu} &= \mu_0 + K \frac{{S}_{L}(i)}{{N}_{L}}\text{ si }{S}_{L}(i)>H \end{align} \]
La CUSUM tabular es la más recomendada en la práctica, ya que se evita el engorroso diseño de la máscara.
x1<-c(9.45,7.99,9.29,11.66,12.16,10.18,8.04,11.46,9.2,10.34,9.03,11.47,
10.51,9.4,10.08,9.37,10.62,10.31,8.52,10.84,10.9,9.33,12.29,11.5,
10.6,11.08,10.38,11.62,11.31,10.52)
cu <- cusum(x1, lambda=0.1, nsigmas=3)
summary(cu)
##
## Call:
## cusum(data = x1, lambda = 0.1, nsigmas = 3)
##
## cusum chart for x1
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 7.990 9.377 10.445 10.315 11.252 12.290
##
## Group sample size: 1
## Number of groups: 30
## Center of group statistics: 10.315
## Standard deviation: 1.199865
##
## Decision interval (std.err.): 5
## Shift detection (std. err.): 1
x11<-x1[1:20]
x12<-x1[21:30]
cu1 <- cusum(x11, lambda=0.1, nsigmas=3,center=10)
x12<-x1[21:30]
cu2 <- cusum(x12, lambda=0.1, nsigmas=3,center=11)
cu3<-cusum(x11, newdata=x12,nsigmas=3,lambda=0.1)
La carta EWMA (por sus siglas en inglés: Exponentially Weighted Moving-Average, “promedios móviles exponencialmente ponderados” fue propuesta por Roberts (1959). Esta carta tiene un desempeño muy parecido a la CUSUM en la detección de pequeños cambios de nivel del proceso, con la ventaja de que es más fácil de construir.
\[ {Z}_{t} = {\lambda}{X}_{t} + \left(1 - {\lambda}\right){Z}_{t-1} \]
Donde \({Z}_{0} = \overline{\bar{x}}\)
\[ V\left({Z}_{t}\right) = \frac{{\sigma}^{2}}{n}\left(\frac{\lambda}{2 - \lambda}\right)\left[1 - (1 - \lambda)^{2t}\right] \]
donde \(n\) es el tamaño del subgrupo. De aquí que los límites en el punto o subgrupo \(t\) están dados por:
\[ \begin{align} LSL &= {Z}_{0} - 3\sqrt{\frac{{\sigma}^{2}}{n}\left(\frac{\lambda}{2 - \lambda}\right)\left[1 - (1 - \lambda)^{2t}\right]}\\ USL &= {Z}_{0} + 3\sqrt{\frac{{\sigma}^{2}}{n}\left(\frac{\lambda}{2 - \lambda}\right)\left[1 - (1 - \lambda)^{2t}\right]} \end{align} \]
x2<-c(9.45,7.99,9.29,11.66,12.16,10.18,8.04,11.46,9.2,10.34,9.03,11.47,
10.51,9.4,10.08,9.37,10.62,10.31,8.52,10.84,10.9,9.33,12.29,11.5,
10.6,11.08,10.38,11.62,11.31,10.52)
ew <- ewma(x2, lambda=0.1, nsigmas=3,center=10)
summary(cu)
##
## Call:
## cusum(data = x1, lambda = 0.1, nsigmas = 3)
##
## cusum chart for x1
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 7.990 9.377 10.445 10.315 11.252 12.290
##
## Group sample size: 1
## Number of groups: 30
## Center of group statistics: 10.315
## Standard deviation: 1.199865
##
## Decision interval (std.err.): 5
## Shift detection (std. err.): 1
n1<-rep(10,20)
resistencia<-matrix(c(115.25,115.91,115.05,116.21,115.9,115.55,114.98,115.25,116.15,115.92,115.75,
114.9,116.01,115.83,115.29,115.63,115.47,115.58,115.72,115.40))
diam<-matrix(c(1.04,1.06,1.09,1.05,1.07,1.06,1.05,1.10,1.09,1.05,0.99,1.06,1.05,1.07,
1.11,1.04,1.03,1.05,1.06,1.04))
X <- list(diam, resistencia)
carta <- mqcc(X, type = "T2",confidence.level = 0.999,sizes=n1)
summary(carta)
##
## Call:
## mqcc(data = X, type = "T2", confidence.level = 0.999, sizes = n1)
##
## T2.single chart for X
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.013347 0.733726 1.274115 1.900000 2.931810 6.501636
##
## Number of variables: 2
## Number of groups: 20
## Group sample size: 1
##
## Center:
## X[1] X[2]
## 1.0580 115.5875
##
## Covariance matrix:
## X[1] X[2]
## X[1] 0.0007115789 -0.001468421
## X[2] -0.0014684211 0.147188158
## |S|: 0.0001025797
##
## Control limits:
## LCL UCL
## 0 10.04178
ellipseChart(carta,confidence.level = 0.999)
ellipseChart(carta, show.id = TRUE)
y1=matrix(c(5.4,3.2,5.2,3.5,2.9,4.6,4.4,5,8.4,4.2,3.8,4.3,3.7,3.8,2.6,2.7,7.9,6.6,4,2.5
,3.8,2.8,2.9,3.3,7.2,7.3,7,6),ncol=1)
y2=matrix(c(93.6,92.6,91.7,86.9,90.4,92.1,91.5,90.3,85.1,89.7,92.5,91.8,91.7,
90.3,94.5,94.5,88.7,84.6,90.7,90.2,92.7,91.5,91.8,90.6,87.3,79.0,82.6,83.5),ncol=1)
ca<-cov(y1,y2)
ca
## [,1]
## [1,] -4.655767
va=var(y1)
va
## [,1]
## [1,] 3.019947
y=list(y1=y1,y2=y2)
y
## $y1
## [,1]
## [1,] 5.4
## [2,] 3.2
## [3,] 5.2
## [4,] 3.5
## [5,] 2.9
## [6,] 4.6
## [7,] 4.4
## [8,] 5.0
## [9,] 8.4
## [10,] 4.2
## [11,] 3.8
## [12,] 4.3
## [13,] 3.7
## [14,] 3.8
## [15,] 2.6
## [16,] 2.7
## [17,] 7.9
## [18,] 6.6
## [19,] 4.0
## [20,] 2.5
## [21,] 3.8
## [22,] 2.8
## [23,] 2.9
## [24,] 3.3
## [25,] 7.2
## [26,] 7.3
## [27,] 7.0
## [28,] 6.0
##
## $y2
## [,1]
## [1,] 93.6
## [2,] 92.6
## [3,] 91.7
## [4,] 86.9
## [5,] 90.4
## [6,] 92.1
## [7,] 91.5
## [8,] 90.3
## [9,] 85.1
## [10,] 89.7
## [11,] 92.5
## [12,] 91.8
## [13,] 91.7
## [14,] 90.3
## [15,] 94.5
## [16,] 94.5
## [17,] 88.7
## [18,] 84.6
## [19,] 90.7
## [20,] 90.2
## [21,] 92.7
## [22,] 91.5
## [23,] 91.8
## [24,] 90.6
## [25,] 87.3
## [26,] 79.0
## [27,] 82.6
## [28,] 83.5
carta2 = mqcc(y, type = "T2.single", confidence.level = 0.999)
summary(carta2)
##
## Call:
## mqcc(data = y, type = "T2.single", confidence.level = 0.999)
##
## T2.single chart for y
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.116039 0.508567 1.263033 1.928571 2.683548 8.543183
##
## Number of variables: 2
## Number of groups: 28
## Group sample size: 1
##
## Center:
## y1 y2
## 4.607143 89.728571
##
## Covariance matrix:
## y1 y2
## y1 3.019947 -4.655767
## y2 -4.655767 14.220635
## |S|: 21.2694
##
## Control limits:
## LCL UCL
## 0 11.05372
ellipseChart(carta2)
Esta Libreria nos permite crear las cartas de control en la cual lo mas recomendable es entender de manera detallada los argumentos de la funcion “qic()”
El autor de esta paqueteria recomienda dos libros de Montgomery’s Introduction to Statistical Process Control (Montgomery 2009). Y tambien, The Healthcare Data Guide (Provost 2011)
Cargamos las librerias
library(qicharts)
library(qicharts2)
El autor sugiere que se bloquee el generador de números aleatorios para reproducir los gráficos de esta viñeta
set.seed(7)
La mejor manera de ilustrar el manejo de estas cartas es comenzando con vector simple de numeros aleatorios.
Creamos el vector (y) por medio de la funcion rnorm() para 24 numeros aleatorios que siguen una distribucion normal
y <- rnorm(24)
y
## [1] 2.287247161 -1.196771682 -0.694292510 -0.412292951 -0.970673341
## [6] -0.947279945 0.748139340 -0.116955226 0.152657626 2.189978107
## [11] 0.356986230 2.716751783 2.281451926 0.324020540 1.896067067
## [16] 0.467680511 -0.893800723 -0.307328300 -0.004822422 0.988164149
## [21] 0.839750360 0.705341831 1.305964721 -1.387996217
Podemos recrear un histograma para conocer mejor nuestros datos
hist(y)
Generemos una primera carta de intervalos individuales
qic(y, chart = 'i')
En la carta anterior podemos observar que la muestra 9 se encuentra fuera del limite inferior por lo que hay que entrar en detalle que sucede.
Un experimento que podemos realizar es cambiar la muestra 9 qe identificar graficamente que pasa en la carta de control si esta muestra fuera un valor atipico.
y[9] <- 6
Recreamos la carta
qic(y, chart = 'i')
Revisando la muestra 9 que anteriormente estaba fuera de control se modifica y corrige de modo que ahora la carta de muestras individuales nos permite ver todos los subgrupos dentro de los limites establecidos
Los límites de control, también llamados límites sigma, generalmente se ubican a ±3 desviaciones estándar de la línea central. La desviación estándar es la desviación estándar estimada de la variación de causa común en el proceso de interés, que depende de la distribución teórica de los datos.
Para demostrar el uso de gráficos U y P para datos de conteo, crearemos un marco de datos que imite el número semanal de úlceras por presión adquiridas en un hospital que, en promedio, tiene 300 pacientes con una estadía promedio de cuatro días.
m.beds <- 300
m.stay <- 4
m.days <- m.beds * 7
m.discharges <- m.days / m.stay
p.pu <- 0.08
discharges <- rpois(24, lambda = m.discharges)
patientdays <- round(rnorm(24, mean = m.days, sd = 100))
n.pu <- rpois(24, lambda = m.discharges * p.pu * 1.5)
n.pat.pu <- rbinom(24, size = discharges, prob = p.pu)
week <- seq(as.Date('2014-1-1'),
length.out = 24,
by = 'week')
d <- data.frame(week, discharges, patientdays,n.pu, n.pat.pu)
d
## week discharges patientdays n.pu n.pat.pu
## 1 2014-01-01 554 2271 58 47
## 2 2014-01-08 529 2172 68 39
## 3 2014-01-15 542 2148 70 31
## 4 2014-01-22 538 1943 71 29
## 5 2014-01-29 502 2132 66 37
## 6 2014-02-05 511 2117 63 42
## 7 2014-02-12 541 2010 69 49
## 8 2014-02-19 527 2108 61 47
## 9 2014-02-26 523 2116 69 37
## 10 2014-03-05 515 2154 67 51
## 11 2014-03-12 530 2170 67 41
## 12 2014-03-19 532 2132 62 42
## 13 2014-03-26 528 2211 79 53
## 14 2014-04-02 521 2177 58 47
## 15 2014-04-09 552 2215 67 51
## 16 2014-04-16 508 2226 64 35
## 17 2014-04-23 492 2170 69 35
## 18 2014-04-30 516 2143 58 28
## 19 2014-05-07 470 2008 67 41
## 20 2014-05-14 538 2038 61 51
## 21 2014-05-21 527 2013 73 51
## 22 2014-05-28 546 1936 60 41
## 23 2014-06-04 518 1967 67 43
## 24 2014-06-11 518 2011 62 28
qic(n.pu,
x = week,
data = d,
chart = 'c',
ylab = 'Count',
xlab = 'Week', title = 'Hospital acquired pressure ulcers (C chart)')
El gráfico U traza la tasa de defectos. Una tasa difiere de una proporción en que el numerador y el denominador no necesitan ser del mismo tipo y que el numerador puede exceder al denominador. Por ejemplo, la tasa de úlceras por presión se puede expresar como el número de úlceras por presión por 1000 días-paciente.
qic(n.pu,
n = patientdays,
x = week,
data = d,
chart = 'u',
multiply = 1000,
title = 'Hospital acquired pressure ulcers (U chart)',
ylab = 'Count per 1000 patient days',
xlab = 'Week')
La gráfica \(P\) es probablemente la gráfica de control más común en el cuidado de la salud. Se utiliza para trazar la proporción (o porcentaje) de unidades defectuosas, por ejemplo, la proporción de pacientes con una o más úlceras por presión. Como se mencionó, los defectuosos se modelan mediante la distribución binomial.
qic(n.pat.pu,
n = discharges,
x = week,
data = d,
chart = 'p',
multiply = 100,
title = 'Hospital acquired pressure ulcers (P chart)',
ylab = 'Percent patients',
xlab = 'Week')
d <- c(NA, rgeom(23, 0.08))
d
## [1] NA 30 16 1 3 8 5 1 17 5 8 12 0 3 11 11 13 0 1 7 5 3 5 2
Gráfico G para unidades producidas entre unidades defectuosas
qic(d,
chart = 'g',
title = 'Patients between pressure ulcers (G chart)',
ylab = 'Count',
xlab = 'Discharge no.')
Creamos el vector de pesos al nacer de 24 bebes
y <- round(rnorm(24, mean = 3400, sd = 400))
y
## [1] 2634 2464 3593 3871 2883 3646 3502 3691 3930 3459 3161 4277 4331 3854 3324
## [16] 3590 3182 3822 3572 2672 3123 2627 3884 3288
En el cuidado de la salud, que, como habrán adivinado, es mi dominio, la mayoría de los datos de calidad son datos de conteo.
I gráfico de pesos individuales al nacer
qic(y,
chart = 'i',
title = 'Birth weight (I chart)',
ylab = 'Grams',
xlab = 'Baby no.')
Gráficos Xbar y S para mediciones promedio
sizes <- rpois(24, 12)
sizes
## [1] 8 15 11 12 8 14 19 14 11 14 16 7 17 8 16 12 6 16 14 16 8 12 8 15
Vector de fechas identificando subgrupos
date <- seq(as.Date('2015-1-1'), length.out = 24, by = 'day')
date <- rep(date, sizes)
date
## [1] "2015-01-01" "2015-01-01" "2015-01-01" "2015-01-01" "2015-01-01"
## [6] "2015-01-01" "2015-01-01" "2015-01-01" "2015-01-02" "2015-01-02"
## [11] "2015-01-02" "2015-01-02" "2015-01-02" "2015-01-02" "2015-01-02"
## [16] "2015-01-02" "2015-01-02" "2015-01-02" "2015-01-02" "2015-01-02"
## [21] "2015-01-02" "2015-01-02" "2015-01-02" "2015-01-03" "2015-01-03"
## [26] "2015-01-03" "2015-01-03" "2015-01-03" "2015-01-03" "2015-01-03"
## [31] "2015-01-03" "2015-01-03" "2015-01-03" "2015-01-03" "2015-01-04"
## [36] "2015-01-04" "2015-01-04" "2015-01-04" "2015-01-04" "2015-01-04"
## [41] "2015-01-04" "2015-01-04" "2015-01-04" "2015-01-04" "2015-01-04"
## [46] "2015-01-04" "2015-01-05" "2015-01-05" "2015-01-05" "2015-01-05"
## [51] "2015-01-05" "2015-01-05" "2015-01-05" "2015-01-05" "2015-01-06"
## [56] "2015-01-06" "2015-01-06" "2015-01-06" "2015-01-06" "2015-01-06"
## [61] "2015-01-06" "2015-01-06" "2015-01-06" "2015-01-06" "2015-01-06"
## [66] "2015-01-06" "2015-01-06" "2015-01-06" "2015-01-07" "2015-01-07"
## [71] "2015-01-07" "2015-01-07" "2015-01-07" "2015-01-07" "2015-01-07"
## [76] "2015-01-07" "2015-01-07" "2015-01-07" "2015-01-07" "2015-01-07"
## [81] "2015-01-07" "2015-01-07" "2015-01-07" "2015-01-07" "2015-01-07"
## [86] "2015-01-07" "2015-01-07" "2015-01-08" "2015-01-08" "2015-01-08"
## [91] "2015-01-08" "2015-01-08" "2015-01-08" "2015-01-08" "2015-01-08"
## [96] "2015-01-08" "2015-01-08" "2015-01-08" "2015-01-08" "2015-01-08"
## [101] "2015-01-08" "2015-01-09" "2015-01-09" "2015-01-09" "2015-01-09"
## [106] "2015-01-09" "2015-01-09" "2015-01-09" "2015-01-09" "2015-01-09"
## [111] "2015-01-09" "2015-01-09" "2015-01-10" "2015-01-10" "2015-01-10"
## [116] "2015-01-10" "2015-01-10" "2015-01-10" "2015-01-10" "2015-01-10"
## [121] "2015-01-10" "2015-01-10" "2015-01-10" "2015-01-10" "2015-01-10"
## [126] "2015-01-10" "2015-01-11" "2015-01-11" "2015-01-11" "2015-01-11"
## [131] "2015-01-11" "2015-01-11" "2015-01-11" "2015-01-11" "2015-01-11"
## [136] "2015-01-11" "2015-01-11" "2015-01-11" "2015-01-11" "2015-01-11"
## [141] "2015-01-11" "2015-01-11" "2015-01-12" "2015-01-12" "2015-01-12"
## [146] "2015-01-12" "2015-01-12" "2015-01-12" "2015-01-12" "2015-01-13"
## [151] "2015-01-13" "2015-01-13" "2015-01-13" "2015-01-13" "2015-01-13"
## [156] "2015-01-13" "2015-01-13" "2015-01-13" "2015-01-13" "2015-01-13"
## [161] "2015-01-13" "2015-01-13" "2015-01-13" "2015-01-13" "2015-01-13"
## [166] "2015-01-13" "2015-01-14" "2015-01-14" "2015-01-14" "2015-01-14"
## [171] "2015-01-14" "2015-01-14" "2015-01-14" "2015-01-14" "2015-01-15"
## [176] "2015-01-15" "2015-01-15" "2015-01-15" "2015-01-15" "2015-01-15"
## [181] "2015-01-15" "2015-01-15" "2015-01-15" "2015-01-15" "2015-01-15"
## [186] "2015-01-15" "2015-01-15" "2015-01-15" "2015-01-15" "2015-01-15"
## [191] "2015-01-16" "2015-01-16" "2015-01-16" "2015-01-16" "2015-01-16"
## [196] "2015-01-16" "2015-01-16" "2015-01-16" "2015-01-16" "2015-01-16"
## [201] "2015-01-16" "2015-01-16" "2015-01-17" "2015-01-17" "2015-01-17"
## [206] "2015-01-17" "2015-01-17" "2015-01-17" "2015-01-18" "2015-01-18"
## [211] "2015-01-18" "2015-01-18" "2015-01-18" "2015-01-18" "2015-01-18"
## [216] "2015-01-18" "2015-01-18" "2015-01-18" "2015-01-18" "2015-01-18"
## [221] "2015-01-18" "2015-01-18" "2015-01-18" "2015-01-18" "2015-01-19"
## [226] "2015-01-19" "2015-01-19" "2015-01-19" "2015-01-19" "2015-01-19"
## [231] "2015-01-19" "2015-01-19" "2015-01-19" "2015-01-19" "2015-01-19"
## [236] "2015-01-19" "2015-01-19" "2015-01-19" "2015-01-20" "2015-01-20"
## [241] "2015-01-20" "2015-01-20" "2015-01-20" "2015-01-20" "2015-01-20"
## [246] "2015-01-20" "2015-01-20" "2015-01-20" "2015-01-20" "2015-01-20"
## [251] "2015-01-20" "2015-01-20" "2015-01-20" "2015-01-20" "2015-01-21"
## [256] "2015-01-21" "2015-01-21" "2015-01-21" "2015-01-21" "2015-01-21"
## [261] "2015-01-21" "2015-01-21" "2015-01-22" "2015-01-22" "2015-01-22"
## [266] "2015-01-22" "2015-01-22" "2015-01-22" "2015-01-22" "2015-01-22"
## [271] "2015-01-22" "2015-01-22" "2015-01-22" "2015-01-22" "2015-01-23"
## [276] "2015-01-23" "2015-01-23" "2015-01-23" "2015-01-23" "2015-01-23"
## [281] "2015-01-23" "2015-01-23" "2015-01-24" "2015-01-24" "2015-01-24"
## [286] "2015-01-24" "2015-01-24" "2015-01-24" "2015-01-24" "2015-01-24"
## [291] "2015-01-24" "2015-01-24" "2015-01-24" "2015-01-24" "2015-01-24"
## [296] "2015-01-24" "2015-01-24"
Vector de pesos al nacer
y <- round(rnorm(sum(sizes), 3400, 400))
y
## [1] 3589 3176 3897 3394 3083 3239 2641 3789 3194 3406 3296 4009 2811 3393 3410
## [16] 3399 3226 3238 3462 3011 4019 3252 4185 3156 3369 2668 3722 2809 2211 2864
## [31] 3294 3246 3159 3139 4103 3392 3462 3096 2780 4500 3819 3767 3588 3153 3417
## [46] 3039 3936 3722 3527 3324 2965 3458 4385 3769 3697 3966 3901 4244 3684 2810
## [61] 3164 3456 3195 3460 3577 3335 3789 3131 4055 2973 3395 2654 3407 3301 3032
## [76] 2531 3140 3610 3290 3422 3245 3233 2934 4095 3298 3011 3844 3789 3903 4111
## [91] 2327 3664 3872 3557 2924 3257 2814 2964 3137 4305 3435 3707 3155 3461 3163
## [106] 3016 3166 3663 3284 3762 3480 3379 3037 2943 3796 3445 3860 3036 2958 2746
## [121] 2753 3065 3837 3894 3469 3448 3623 3597 3372 2860 3720 3272 3257 3196 2648
## [136] 3019 4309 3481 2477 3377 3425 3684 3163 3519 3657 4245 3767 2771 3797 3592
## [151] 3281 3726 3000 3620 3512 3767 2707 2808 4292 3555 3664 3290 3510 2490 3763
## [166] 2965 3314 3107 3485 3024 3152 3498 3549 3651 2971 3117 3763 3272 3866 3151
## [181] 3899 3976 3705 3624 4040 3361 2820 3297 2587 3635 3464 3445 3629 3014 3527
## [196] 3331 3035 2661 3668 3356 4027 3062 3839 3520 3089 3385 3844 3615 3255 3358
## [211] 3534 3724 2727 3666 3083 4011 2805 3132 4070 3645 3307 3642 2936 2934 3052
## [226] 3296 3202 2878 4209 3098 3303 3839 3021 2946 3047 3607 3265 3391 3359 3520
## [241] 3723 3385 2817 3150 3332 3910 3298 3334 3229 3377 2822 4153 3447 3568 4031
## [256] 3299 3378 3391 4332 3360 3467 3292 3738 3964 2774 3468 2798 3798 3898 3385
## [271] 3235 3914 2953 3066 4000 3760 3217 3318 3165 3126 3802 3091 2603 3036 3175
## [286] 2913 2672 3240 4247 3966 3626 2967 3023 3302 3834 3623 2530
Marco de datos de pesos y fechas de nacimiento
d <- data.frame(y, date)
head(d, 24)
## y date
## 1 3589 2015-01-01
## 2 3176 2015-01-01
## 3 3897 2015-01-01
## 4 3394 2015-01-01
## 5 3083 2015-01-01
## 6 3239 2015-01-01
## 7 2641 2015-01-01
## 8 3789 2015-01-01
## 9 3194 2015-01-02
## 10 3406 2015-01-02
## 11 3296 2015-01-02
## 12 4009 2015-01-02
## 13 2811 2015-01-02
## 14 3393 2015-01-02
## 15 3410 2015-01-02
## 16 3399 2015-01-02
## 17 3226 2015-01-02
## 18 3238 2015-01-02
## 19 3462 2015-01-02
## 20 3011 2015-01-02
## 21 4019 2015-01-02
## 22 3252 2015-01-02
## 23 4185 2015-01-02
## 24 3156 2015-01-03
Grafica del gráfico Xbar de los pesos promedio al nacer por fecha de nacimiento Gráfico Xbar de medidas promedio
qic(y,
x = date,
data = d,
chart = 'xbar',
title = 'Average birth weight (Xbar chart)',
ylab = 'Grams',
xlab = 'Date')
Trazar el gráfico S de la desviación estándar dentro del subgrupo Gráfica S de desviaciones estándar dentro de subgrupos
qic(y,
x = date,
data = d,
chart = 's',
title = 'Standard deviation of birth weight (S chart)',
ylab = 'Grams',
xlab = 'Date')
Gráfico T para el tiempo entre eventos Elija 24 fechas aleatorias y ordénelas
dates <- seq(as.Date('2015-1-1'), as.Date('2015-12-31'), by = 'day')
events <- sort(sample(dates, 24))
Vector de tiempo (días) entre eventos
d <- c(NA, diff(events))
d
## [1] NA 39 33 25 23 10 1 21 21 1 9 17 6 1 8 16 27 11 16 8 8 9 13 5
Trazar gráfico T de días entre eventos
qic(d,
chart = 't',
title = 'Days between pressure ulcers (T chart)',
ylab = 'Days',
xlab = 'Pressure ulcer no.')
d <- data.frame(n.pat.pu, discharges, week)
qic(n.pat.pu,
n = discharges,
x = week,
data = d,
chart = 'p',
title = 'Patients with hospital acquired pressure ulcers (Standardised P chart)',
ylab = 'Standard deviations',
xlab = 'Week')
x1<-c(1.83,1.75,1.89,1.65,1.54,1.56,1.70,1.65,1.90,1.66,1.87,1.75,1.98,1.56,1.87,1.54,1.65,1.74,1.87,1.86,1.50,1.70,1.75)
x1_s <- sort(x1)
x1_s
## [1] 1.50 1.54 1.54 1.56 1.56 1.65 1.65 1.65 1.66 1.70 1.70 1.74 1.75 1.75 1.75
## [16] 1.83 1.86 1.87 1.87 1.87 1.89 1.90 1.98
cu <- cusum(x1, lambda=0.1, nsigmas=3,decision.interval = 1)
summary(cu)
##
## Call:
## cusum(data = x1, decision.interval = 1, lambda = 0.1, nsigmas = 3)
##
## cusum chart for x1
##
## Summary of group statistics:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.500 1.650 1.740 1.729 1.865 1.980
##
## Group sample size: 1
## Number of groups: 23
## Center of group statistics: 1.72913
## Standard deviation: 0.1547389
##
## Decision interval (std.err.): 1
## Shift detection (std. err.): 1
x11<-x1[1:10]
x11
## [1] 1.83 1.75 1.89 1.65 1.54 1.56 1.70 1.65 1.90 1.66
x12<-x1[11:20]
x12
## [1] 1.87 1.75 1.98 1.56 1.87 1.54 1.65 1.74 1.87 1.86
summary(x11)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.540 1.650 1.680 1.713 1.810 1.900
cu1 <- cusum(x11,lambda=30, nsigmas=3,center=1.68, decision.interval = 1)
summary(x12)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.540 1.673 1.805 1.769 1.870 1.980
cu2 <- cusum(x12, nsigmas=3,center=1.805, decision.interval = 1)
cu3<-cusum(x11,newdata=x12,nsigmas=3,lambda=0.1,chart.all=TRUE, title = "Cusum Chart for x11 and x12", xlab="Groups", ylab="Cumulative Sum", col=heat.colors())
summary(cu3)
cu3
## List of 18
## $ call : language cusum(data = x11, newdata = x12, nsigmas = 3, lambda = 0.1, chart.all = TRUE, title = "Cusum Chart for x11 a| __truncated__ ...
## $ type : chr "cusum"
## $ data.name : chr "x11"
## $ data : num [1:10, 1] 1.83 1.75 1.89 1.65 1.54 1.56 1.7 1.65 1.9 1.66
## ..- attr(*, "dimnames")=List of 2
## $ statistics : Named num [1:10] 1.83 1.75 1.89 1.65 1.54 1.56 1.7 1.65 1.9 1.66
## ..- attr(*, "names")= chr [1:10] "1" "2" "3" "4" ...
## $ sizes : int [1:10] 1 1 1 1 1 1 1 1 1 1
## $ center : num 1.71
## $ std.dev : num 0.125
## $ newstats : Named num [1:10] 1.87 1.75 1.98 1.56 1.87 1.54 1.65 1.74 1.87 1.86
## ..- attr(*, "names")= chr [1:10] "11" "12" "13" "14" ...
## $ newdata : num [1:10, 1] 1.87 1.75 1.98 1.56 1.87 1.54 1.65 1.74 1.87 1.86
## $ newsizes : int [1:10] 1 1 1 1 1 1 1 1 1 1
## $ newdata.name : chr "x12"
## $ pos : num [1:20] 0.435 0.231 1.146 0.142 0 ...
## $ neg : num [1:20] 0 0 0 -0.0036 -0.8865 ...
## $ head.start : num 0
## $ decision.interval: num 5
## $ se.shift : num 1
## $ violations :List of 2
## - attr(*, "class")= chr "cusum.qcc"
Para el cálculo del estudio Gage R&R completo.
La empresa Dulce Paladar fabrica deliciosos productos de panadería y varios tipos de Pan, El director de la compañía quiere empezar un proyecto Seis Sigma para mejorar la línea de producción de pan.
Ahora el sistema de medida ha de ser evaluado antes de comenzar otros análisis.
Hay 2 multiformadoras disponibles para alistar los productos y 3 tipos de mezclas para pan son seleccionadas al azar al final de la línea de producción. Se mide el peso de cada mezcla para pan con cada instrumento de medida 3 veces. Los datos son los siguientes:”
Multiformadora = factor(rep(1:2, each = 9))
Pan = factor(rep(rep(1:3, each = 3), 2))
run = factor(rep(1:3, 6))
Peso= c(99,100, 101, 98, 99, 100,100, 101, 102,
95, 90, 98, 97, 99, 105, 105, 103, 110)
Panes = data.frame(Multiformadora, Pan ,run, Peso)
ggplot(Panes,aes(Multiformadora,Peso))+geom_boxplot(aes(colour=Pan))
library(SixSigma)
#ss.rr(var, part, appr, data, main, sub)
my.rr <- ss.rr(var = Peso, part = Pan,
appr = Multiformadora,
data = Panes,
main = "Six Sigma Gage R&R Measure",
sub = "Multiformadoras de Pan")
## Complete model (with interaction):
##
## Df Sum Sq Mean Sq F value Pr(>F)
## Pan 2 122.11 61.06 1.386 0.4191
## Multiformadora 1 0.22 0.22 0.005 0.9498
## Pan:Multiformadora 2 88.11 44.06 5.322 0.0221
## Repeatability 12 99.33 8.28
## Total 17 309.78
##
## alpha for removing interaction: 0.05
##
## Gage R&R
##
## VarComp %Contrib
## Total Gage R&R 20.203704 87.70
## Repeatability 8.277778 35.93
## Reproducibility 11.925926 51.77
## Multiformadora 0.000000 0.00
## Pan:Multiformadora 11.925926 51.77
## Part-To-Part 2.833333 12.30
## Total Variation 23.037037 100.00
##
## StdDev StudyVar %StudyVar
## Total Gage R&R 4.494853 26.96912 93.65
## Repeatability 2.877113 17.26268 59.94
## Reproducibility 3.453393 20.72036 71.95
## Multiformadora 0.000000 0.00000 0.00
## Pan:Multiformadora 3.453393 20.72036 71.95
## Part-To-Part 1.683251 10.09950 35.07
## Total Variation 4.799691 28.79815 100.00
##
## Number of Distinct Categories = 1
## Warning in widths.x[pos.widths[[nm]]] <- widths.settings[[nm]] *
## widths.defaults[[nm]]$x: number of items to replace is not a multiple of
## replacement length
Hay 2 instrumentos de medida disponibles para alistar la mezcla y 3 tipos de mezclas para pan son seleccionadas aleatoriamente al final de la línea de producción. Se mide el peso de cada mezcla para pan con cada instrumento de medida 3 veces. Los datos son los siguientes:”
InstrumentoMedida = factor(rep(1:2, each = 9))
Masa = factor(rep(rep(1:3, each = 3), 2))
run = factor(rep(1:3, 6))
Peso= c(4980,4950,4998,5050,5010,5090,4990,5030,5080,
5000,5005,5010,5000,5001,5003,5000,4999,4998)
Panes = data.frame(InstrumentoMedida, Masa ,run, Peso)
ggplot(Panes,aes(InstrumentoMedida,Peso))+geom_boxplot(aes(colour=Masa))
library(SixSigma)
#ss.rr(var, part, appr, data, main, sub)
my.rr <- ss.rr(var = Peso, part = Masa,
appr = InstrumentoMedida,
data = Panes,
main = "Six Sigma Gage R&R Measure",
sub = "Alistamiento Mezcla de Masa")
## Complete model (with interaction):
##
## Df Sum Sq Mean Sq F value Pr(>F)
## Masa 2 3971 1985.7 0.775 0.563
## InstrumentoMedida 1 1458 1458.0 0.569 0.529
## Masa:InstrumentoMedida 2 5124 2562.2 3.617 0.059
## Repeatability 12 8499 708.3
## Total 17 19053
##
## alpha for removing interaction: 0.05
##
##
## Reduced model (without interaction):
##
## Df Sum Sq Mean Sq F value Pr(>F)
## Masa 2 3971 1985.7 2.041 0.167
## InstrumentoMedida 1 1458 1458.0 1.498 0.241
## Repeatability 14 13624 973.1
## Total 17 19053
##
## Gage R&R
##
## VarComp %Contrib
## Total Gage R&R 1026.99471 85.89
## Repeatability 973.11905 81.38
## Reproducibility 53.87566 4.51
## InstrumentoMedida 53.87566 4.51
## Part-To-Part 168.76720 14.11
## Total Variation 1195.76190 100.00
##
## StdDev StudyVar %StudyVar
## Total Gage R&R 32.046758 192.28055 92.67
## Repeatability 31.194856 187.16914 90.21
## Reproducibility 7.340004 44.04003 21.23
## InstrumentoMedida 7.340004 44.04003 21.23
## Part-To-Part 12.991043 77.94626 37.57
## Total Variation 34.579790 207.47874 100.00
##
## Number of Distinct Categories = 1
## Warning in widths.x[pos.widths[[nm]]] <- widths.settings[[nm]] *
## widths.defaults[[nm]]$x: number of items to replace is not a multiple of
## replacement length
Datos que muestran el efecto de dos fármacos soporíferos (aumento de las horas de sueño respecto al control) en 10 pacientes.
Variables:
aumento numérico adicional en las horas de sueño
fármaco de factor de grupo administrado
ID del paciente del factor IS
El nombre de la variable de grupo puede ser engañoso acerca de los datos: representan mediciones de 10 personas, no en grupos.
summary(sleep)
## extra group ID
## Min. :-1.600 1:10 1 :2
## 1st Qu.:-0.025 2:10 2 :2
## Median : 0.950 3 :2
## Mean : 1.540 4 :2
## 3rd Qu.: 3.400 5 :2
## Max. : 5.500 6 :2
## (Other):8
sleep
## extra group ID
## 1 0.7 1 1
## 2 -1.6 1 2
## 3 -0.2 1 3
## 4 -1.2 1 4
## 5 -0.1 1 5
## 6 3.4 1 6
## 7 3.7 1 7
## 8 0.8 1 8
## 9 0.0 1 9
## 10 2.0 1 10
## 11 1.9 2 1
## 12 0.8 2 2
## 13 1.1 2 3
## 14 0.1 2 4
## 15 -0.1 2 5
## 16 4.4 2 6
## 17 5.5 2 7
## 18 1.6 2 8
## 19 4.6 2 9
## 20 3.4 2 10
boxplot(sleep$extra ~ sleep$group, col="lightblue", main = "Diferencias por grupo")
plot(cars$speed, cars$dist)
lm.dist.speed <- lm(cars$dist ~ cars$speed)
lm.dist.speed
##
## Call:
## lm(formula = cars$dist ~ cars$speed)
##
## Coefficients:
## (Intercept) cars$speed
## -17.579 3.932
n <- 100
x1 <- runif(n,0,10)
x2 <- runif(n,0,10)
x3 <- runif(n,0,10)
err <- rnorm(n,mean = 0, sd = 1)
# Con los valores de las X y el error calculados, construimos los dos modelos para y
y1 <- 4+1.5*x1[1:90]+8*x2[1:90]-2*x3[1:90]+err[1:90]
y2 <- 4+1.5*x1[91:100]+8*x2[91:100]-60*x3[91:100]+err[91:100]
# Jutnamos ambas y-es
y <- c(y1,y2)
# Va a resultar conveniente tener todo junto en un DF (el error no lo vamos a precisar)
df <- data.frame(x1,x2,x3,y)
#Podemos randomizar el orden de las filas, para que no queden todos los casos patológicos al final
df <- df[sample(nrow(df)),]
df
## x1 x2 x3 y
## 37 5.19860406 8.7275061 5.4461885 70.720612
## 30 9.40784471 5.5336136 9.7115294 42.953522
## 55 9.61209370 6.8968604 7.6206089 58.027162
## 3 1.90551317 6.5804727 0.5922261 58.098149
## 14 9.38300380 7.3054160 4.9139272 65.412199
## 6 4.35087113 6.2403271 7.9472176 45.514205
## 32 1.60823708 3.5448733 3.3951100 27.336517
## 86 5.32611949 4.1269896 3.1893000 39.130515
## 34 5.01673149 5.1557887 7.5100803 38.718742
## 78 3.49645096 7.2288697 0.4741287 65.329768
## 16 7.58966201 3.7628111 1.2152404 43.097504
## 94 3.03000137 4.9531492 3.4972130 -161.042925
## 98 9.47342072 5.9999858 8.5985737 -451.165395
## 22 1.50580435 7.4302028 5.0590015 54.154365
## 52 9.93756481 3.1823828 8.3378912 26.603658
## 92 6.40217139 4.7079649 7.0231469 -369.166916
## 95 2.88931371 5.5112435 7.8250152 -416.028740
## 75 7.51470729 5.7499889 5.4434789 51.441507
## 56 7.75590250 6.2033098 2.6598530 60.026967
## 18 4.74585192 5.9135734 2.9171639 52.738121
## 68 9.29383007 6.5151111 4.3184560 60.826467
## 74 9.72784844 4.8254595 4.6836751 49.200235
## 73 0.30442636 7.4187498 8.4085586 46.558832
## 29 8.81032100 8.8304418 1.9563080 82.688748
## 28 4.89153435 1.0975507 7.8407721 2.913371
## 19 7.52165437 6.0866386 3.2457881 58.060809
## 13 7.67281585 3.3937884 5.3790143 31.739781
## 59 5.09549005 9.8958803 9.3302333 71.037607
## 88 6.29687482 6.1957088 1.9326592 60.963337
## 87 2.26939719 1.8760584 4.9644640 11.613220
## 72 9.65495312 7.4049061 4.9861952 67.853754
## 76 2.94942197 0.8741146 4.2233187 6.392987
## 9 4.87777630 2.5539842 0.3390299 31.436459
## 1 8.06953274 3.4098473 8.2738766 27.828394
## 11 4.70380486 4.3301398 7.7372662 32.791377
## 44 8.99259155 7.1197699 4.7845534 63.941664
## 35 8.45250200 0.1796163 0.5306850 16.081131
## 62 1.86970309 8.1721087 5.7438655 59.160950
## 21 9.40312201 3.1001036 2.0274268 37.750429
## 64 2.71471144 3.6688669 3.3294908 31.991775
## 63 5.29995987 9.7965732 3.4421327 83.356600
## 27 9.97745159 6.5321353 1.6409538 66.043110
## 50 4.58928903 9.2870360 5.3552352 76.434222
## 8 3.30521533 0.1433951 8.2866175 -7.284850
## 43 4.30973858 8.8519422 2.4890506 76.328603
## 80 1.94396689 0.2338941 1.7614702 4.821868
## 12 9.43071315 8.3561141 0.5625918 83.283752
## 24 3.83590730 4.8508452 0.5598513 47.827828
## 81 1.08212458 8.8824426 9.9561165 56.217749
## 2 1.03706137 8.9530802 2.1144804 75.046161
## 61 3.06645680 4.2630275 8.7395845 24.356431
## 15 3.38455781 2.7746547 8.7321871 12.279537
## 54 2.18502438 5.6492759 8.5058053 36.063612
## 83 6.48561153 7.2131694 0.7699547 70.581464
## 69 0.95875682 9.2025003 0.3836906 79.730153
## 71 1.65959774 0.8688768 0.8796873 10.943269
## 17 8.32137363 8.7839237 5.2224247 75.207764
## 67 4.29691996 3.0403567 7.0050669 21.969769
## 7 3.08498100 1.6288342 1.7307439 18.724587
## 57 6.71497386 1.3259944 7.4079517 11.201620
## 93 0.04908091 5.9929252 6.4828517 -336.326640
## 31 2.67290537 4.7224627 5.3443075 35.120610
## 33 7.90786235 9.3129484 0.5941663 89.172113
## 36 4.82131434 5.5690400 1.9565467 50.318339
## 5 0.02605321 7.3901002 1.3890976 60.646041
## 89 5.16283115 2.6272248 1.3123003 30.483857
## 70 6.79531275 6.9004644 2.3041020 63.873005
## 65 1.84734483 2.5260128 0.7289719 26.104791
## 85 6.81465019 9.5083256 2.0997923 85.503665
## 23 4.23749618 8.3012733 6.5973985 61.425272
## 41 1.58387611 6.6972887 2.2310538 55.269008
## 79 8.44126436 2.7664561 8.9762890 20.714183
## 46 8.53955091 5.1669540 9.6771429 39.650556
## 39 6.95047602 5.6633242 0.2733038 58.394396
## 25 5.12022978 1.0767066 2.8233623 14.470875
## 45 6.76178167 1.8053769 8.4052916 14.219575
## 60 0.49468242 1.7129079 1.9934499 14.066945
## 58 5.08993405 7.8598761 4.7699774 64.480614
## 38 2.45520620 5.4179116 4.5182229 42.954497
## 49 3.35396522 9.8267872 1.6529206 83.965896
## 48 3.55051956 5.2536404 7.1903381 36.385951
## 84 7.25401157 2.3306735 4.5552913 24.867571
## 42 5.61625917 4.5287714 3.2249886 42.341899
## 51 9.80329708 0.1385242 7.0961855 5.965311
## 99 3.04789997 3.0485431 8.7934985 -495.992302
## 10 2.81394792 9.9115638 1.0524913 83.135778
## 53 8.49466882 6.1347954 8.8154010 48.833029
## 100 6.71923673 1.5899339 6.4640683 -361.133294
## 26 0.74517316 2.3997235 1.1957471 20.386026
## 47 6.64571578 3.2371965 8.5264398 24.696078
## 96 7.21490895 8.4252091 0.7441875 38.318208
## 4 2.47112069 2.8267722 8.8116973 11.622851
## 90 3.22310729 8.3956025 0.5806294 74.341039
## 77 6.50082665 8.7514229 2.7333571 76.770216
## 66 4.15638948 9.3711623 0.3547502 85.106436
## 20 2.29460730 9.8102897 1.4890973 80.913119
## 97 8.99829906 1.6425348 2.3616811 -111.291610
## 40 4.48182481 7.2647807 2.3663443 63.748925
## 82 3.43839587 8.2085049 2.2564777 70.954934
## 91 2.85763571 0.1683519 9.8003508 -577.497716
set.seed(1234)
muestras_bootstrapeadas <- list()
#quiero construir 100 muestras bootstrpeadas. Podrían ser más
for (i in 1:100) {
#quiero que los dataset que muestree tengan el mismo tamaño que el dataset original
muestra_i <- data.frame()
index_i <- c()
for (j in 1:nrow(df)) {
#eligo el número indice de la muestra de forma aleatoria entre los indices de mi set original
index <- sample(rownames(df),1)
#selecciono de mi df el elemento con el indice correspondiente
muestra_unitaria <- df[index,]
#agrego la observación a la muestra i
muestra_i <- bind_rows(muestra_i,muestra_unitaria)
#guardo el indice
index_i <- c(index_i,index)
}
bootstrap_i <- list("df"=muestra_i, "indices" = index_i)
muestras_bootstrapeadas[[i]] <- bootstrap_i
}
data.frame(table(muestras_bootstrapeadas[[1]]$indices)) %>%
arrange(-Freq)
## Var1 Freq
## 1 10 3
## 2 20 3
## 3 23 3
## 4 3 3
## 5 33 3
## 6 55 3
## 7 63 3
## 8 71 3
## 9 74 3
## 10 81 3
## 11 14 2
## 12 17 2
## 13 24 2
## 14 34 2
## 15 38 2
## 16 47 2
## 17 49 2
## 18 51 2
## 19 53 2
## 20 59 2
## 21 6 2
## 22 61 2
## 23 64 2
## 24 79 2
## 25 86 2
## 26 90 2
## 27 91 2
## 28 95 2
## 29 11 1
## 30 12 1
## 31 13 1
## 32 18 1
## 33 19 1
## 34 2 1
## 35 22 1
## 36 27 1
## 37 28 1
## 38 30 1
## 39 31 1
## 40 40 1
## 41 41 1
## 42 42 1
## 43 44 1
## 44 45 1
## 45 5 1
## 46 50 1
## 47 56 1
## 48 57 1
## 49 58 1
## 50 62 1
## 51 66 1
## 52 67 1
## 53 68 1
## 54 69 1
## 55 70 1
## 56 76 1
## 57 78 1
## 58 83 1
## 59 87 1
## 60 89 1
## 61 92 1
## 62 93 1
library(tidyverse)
library(rsample)
library(GGally)
library(robust)
library(ggridges)
library(ggthemes)
library(magrittr)
muestras_bootstrapeadas <- bootstraps(df,times = 100)
#muestras_bootstrapeadas
first_computos_boot <- muestras_bootstrapeadas$splits[[1]]
first_computos_boot
## <Analysis/Assess/Total>
## <100/39/100>
#parametros <- muestras_bootstrapeadas %>%
# gather(3:4) %>%
# mutate(tdy = map(statistic, tidy)) %>%
# unnest(tdy, .drop=TRUE)
#parametros
#carta <- mqcc(first_computos_boot, type = "T2",confidence.level = 0.999,sizes=n1)
#summary(carta)
#ellipseChart(carta,confidence.level = 0.999)
#ellipseChart(carta, show.id = TRUE)