1 Introducción

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.

2 Conceptos básicos

  • 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.

3 Objetivo

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.

4 Variabilidad

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.

4.1 Causas

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.

5 Métodos

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)

5.1 Diagrama de Ishikawa o Diagrama de Causa Efecto

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.

5.1.1 Ejempplo

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")

5.2 Sistemas poka-yoke

  • 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

5.3 Diagrama de Pareto

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.

5.3.1 Ejemplo

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.

5.4 Diagramas de flujo

Alt text

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")

5.5 Histogramas

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.

5.5.1 Ejemplos

  1. En la Pizzería se quiere analizar la productividad de los repartidores, para ello se cuentan los tiempos de retraso reportados en las entregas que ha realizado cada repartidor durante el último mes. Los tiempos de despacho de los pedidos son el resultado de los tiempos en que los, repartidores que trabajan por turnos a lo largo del día, hacen la entrega; adicionando el tiempo que toma la elaboración de la comida, es decir, los tiempos de “despacho” consisten en el lapso transcurrido entre la recepción de un producto y su entrega.
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")

  1. Datos para un proceso de llenado en una bodega de vinos a través del volumen medido en 20 botellas de la producción.
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.

5.6 Gráfico de caja y bigotes

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.

5.6.1 Ejemplo

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"))

5.7 Monitoreo

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.

5.8 Procedimiento de inspección

Las políticas y procedimientos que debe incluir el Sistema de Control de Calidad están relacionadas con lo siguiente:

  • Nombrar a un responsable del monitoreo del Sistema de Control de Calidad.
  • Definir procedimientos para obtener una evaluación respecto al cumplimiento de las normas profesionales y el cumplimiento de las leyes y reglamentos que afecten la actuación de auditoría.
  • Evaluar periódicamente el diseño e implementación del Sistema de Control de Calidad.
  • Reportar el resultado de la revisión del Sistema de Control de Calidad a todos los miembros de la Firma. Esto con el fin de que los temas de mejora sean conocidos por el personal que no fue revisado.
  • Se deben definir los responsables de preparar los planes de acción para subsanar las debilidades identificadas.
  • Definir quién y con qué periodicidad debe dar seguimiento a los planes de acción diseñados para subsanar las debilidades.
  • Definir cuáles son las consecuencias del incumplimiento con los planes de acción.
  • Definir cuál es el alcance que se le dará a la revisión en términos de trabajos, socios y gerentes revisados.
  • Definir cuáles son los criterios para la sección de revisores.
  • Definir cómo se deben documentar las revisiones.
  • Definir guías o procedimientos para que los resultados del monitoreo del Sistema de Control de Calidad formen parte de los procesos de evaluación, desarrollo profesional y compensación del personal.
  • Definir cuáles son los procedimientos a seguir cuando existen quejas de terceros o del personal por incumplimiento con normas profesionales, leyes o reglamentos que afectan la actuación profesional.

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:

  • Dimensión de la Firma;
  • Naturaleza y complejidad de la actividad de la Firma;
  • Riesgos asociados con la base de clientes y tipos de servicios que se prestan en los encargos;
  • Número de oficinas y ubicación geográfica de las mismas;
  • Evaluación general del funcionamiento y cumplimiento de cada oficina (si procede);
  • Resultados de inspecciones anteriores y de inspecciones externas realizadas por organismos profesionales o entidades reguladoras; y
  • Grado de autoridad otorgado a los miembros, divisiones y oficinas de la Firma.

La documentación de las inspecciones puede incluir los siguientes elementos:

  • Una evaluación de la observancia de normas profesionales y requerimientos reglamentarios y legales aplicables;
  • Los resultados de la evaluación de los elementos del Sistema de Control de Calidad;
  • Una evaluación acerca de si la Firma ha aplicado adecuadamente las políticas y procedimientos de control de calidad;
  • Una evaluación acerca de si el informe del encargo es adecuado a las circunstancias;
  • Identificación de deficiencias, las razones subyacentes por las que surgieron, su efecto y la decisión de si se requiere tomar más medidas, describiéndolas en detalle; y
  • Un resumen de los resultados y conclusiones alcanzadas (que se entregue a la firma de auditoría), con recomendaciones para tomar medidas correctivas o realizar los cambios necesarios.

Las evaluaciones efectuadas deben comprender temas como los siguientes:

  • El grado de cumplimiento con las políticas y procedimientos de control de calidad y la observancia de normas profesionales y requerimientos reglamentarios y legales;
  • La relevancia y adecuación de las políticas y procedimientos de control de calidad;
  • En qué medida las políticas y procedimientos están actualizados y son congruentes respecto de los últimos pronunciamientos de la profesión;
  • El control de calidad y la cultura de ética de la firma de auditoría (incluyendo la confirmación por escrito del cumplimiento con políticas y procedimientos relacionados con la independencia);
  • La efectividad de las actividades de educación y desarrollo profesional;
  • La adecuación de los materiales de guía y los recursos técnicos que se ofrecen;
  • Los procesos de inspección interna de la firma de auditoría;
  • El contenido, oportunidad y efectividad de las comunicaciones relativas a los problemas de control de calidad dirigidas al personal de la firma de auditoría; y
  • Determinación de la efectividad del seguimiento posterior a la terminación del proceso (por ejemplo, si se realizan oportunamente las modificaciones necesarias).

Los mecanismos de seguimiento que la firma de auditoría puede usar incluyen los siguientes:

  • Programas de educación y formación práctica internos y externos;
  • El requerimiento de que los socios y empleados conozcan, entiendan y hagan cumplir las políticas y procedimientos de la firma de auditoría;
  • Una política que instruya a socios y empleados a no emitir ninguna información sobre los estados financieros del encargo a menos que se hayan obtenido todas las aprobaciones necesarias;
  • Un sistema estándar de control de finalización de los encargos y emisión de informes de la firma de auditoría, que indique todas las aprobaciones necesarias por tipo de encargo, función y persona responsable;
  • Instrucciones al socio del encargo y al revisor de control de calidad del encargo para que realicen seguimiento continuado de las aprobaciones debidas;
  • Instrucciones a todos los socios y empleados para que avisen a la Alta Dirección de la firma de auditoría cuando observen incumplimientos insignificantes o incumplimientos menores reiterados de las políticas o protocolos de la Firma.

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.

6 Cartas de control Shewhart

6.0.1 Libreria QCC

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.

6.0.2 Quality Control Charts

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)

6.0.2.1 Carta de control para la media o Shewart

6.0.2.1.1 Límites de control

\[ \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

7 Capacidad de proceso

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.

7.1 ¿Cómo evaluar la capacidad de un proceso?

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.

7.2 Requisitos para efectuar 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.

7.3 Clasificación de los índices de capacidad

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.

7.4 Índices de capacidad a corto plazo Cp y Cpk

7.4.1 Índice Cp

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.

7.5 Índice de capacidad potencial del proceso (Cp)

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

7.6 Índice de capacidad real del proceso (Cpk)

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

7.7 ¿Qué es Seis Sigma?

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.

7.7.1 Ejemplo

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")

8 Monitoreo

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"

9 Función de operación característica

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%

10 Observaciones individuales

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%

11 Grafico P y NP

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.

12 Grafico P

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

13 Monitoreo

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"

14 Tamaño de muestra variable

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

15 Tamaño de muestra promedio

n<-mean(muest)
muest2<-rep(n,25)
q4<-qcc(discon,sizes=muest2,  type="p")

16 Carta de control estandarizada

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)

17 Carta c

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}} \]

17.1 Ejemplo

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.

17.2 Monitoreo

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)

18 Carta u

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.

18.1 Ejemplo

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.

18.2 Muestra variable

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í.

18.3 Carta de control estandarizada

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)

19 Cartas CUSUM y EWMA

Detección oportuna de cambios pequeños

19.1 Defectos bajos

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"

20 Carta cusum

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} \]

  • La CUSUM tabular o de un sólo lado, en la cual se consideran de manera separada las sumas acumuladas por arriba y las sumas acumuladas por abajo

\[ \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)

21 Carta ewma

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

22 Carta Multivariada

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)

23 Pruebas de precision y exactitud.

24 Observaciones individuales

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)

25 Libreria qicharts

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)

26 Cartas de Control Basicas

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

26.1 Tipos de Cartas de Control

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.')

26.2 Ejercicio con nacimientos de bebes

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')

26.3 Carta cusum para altura estudiantes curso CEC :: cusum chart for heigth

26.3.1 Creando el df

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)

26.3.2 Ordenando

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

26.3.3 Primera carta

cu <- cusum(x1, lambda=0.1, nsigmas=3,decision.interval = 1)

26.3.4 Analisis

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

26.3.4.1 Separar primeros 10 datos

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

26.3.5 Separar siguientes 10

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())

26.3.5.1 Estadistica con R

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"

26.3.6 Panadería R y R

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

26.3.7 Dos instrumentos de medición

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

26.3.8 Datos de sueño

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")

26.3.8.1 Regresion Lineal

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

26.4 Boostrap en control de calidad

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)