Vamos a utilizar los tiempos de espera en cola de los clientes (estudiantes) que han solicitado el reconocimiento de créditos transversales en algún momento a lo largo del curso 2015-16.
Leemos en primer lugar los datos y seleccionamos las variables ‘tpo.espera.min’, de los tiempos de espera en cola expresados en minutos, y ‘mes’, referido al mes en el que se ha presentado la solicitud.
# utilizamos un banco de datos de tiempos de espera en cola del curso 2016-17
datosbd=load("cegeca16.RData")
# Seleccionamos exclusivamente los tiempos de espera y el mes
datos=tiemposespera %>%
select(tpo.espera.min,mes)%>%
mutate(mes=factor(mes,levels=c("sept.","oct.","nov.","dic." , "ene." , "feb.","mar.","abr." ,"may.", "jun.", "jul.")))%>%
filter(tpo.espera.min != is.na(tpo.espera.min))
head(datos)## tpo.espera.min mes
## 1 6 oct.
## 2 34 oct.
## 3 7 oct.
## 4 74 oct.
## 5 70 oct.
## 6 8 oct.Para los tiempos de espera en cola calculamos una descriptiva global y otra por meses:
resumen=datos %>%
summarise(media=mean(tpo.espera.min),min=min(tpo.espera.min),max=max(tpo.espera.min),total=n())
pander(resumen)| media | min | max | total |
|---|---|---|---|
| 27.83 | 1 | 155 | 3750 |
resumen.mes=datos %>%
group_by(mes)%>%
summarise(media=mean(tpo.espera.min),min=min(tpo.espera.min),max=max(tpo.espera.min),total=n())
pander(resumen.mes)| mes | media | min | max | total |
|---|---|---|---|---|
| sept. | 66.646073 | 1 | 155 | 955 |
| oct. | 27.321932 | 1 | 95 | 497 |
| nov. | 10.112500 | 1 | 43 | 400 |
| dic. | 5.310559 | 1 | 23 | 161 |
| ene. | 8.662162 | 1 | 35 | 222 |
| feb. | 6.588983 | 1 | 30 | 236 |
| mar. | 6.292994 | 1 | 28 | 157 |
| abr. | 4.636364 | 1 | 32 | 99 |
| may. | 5.438596 | 1 | 105 | 114 |
| jun. | 12.290000 | 1 | 121 | 300 |
| jul. | 21.369458 | 1 | 75 | 609 |
# Y los visualizamos gráficamente:
ggplot(datos,aes(mes,tpo.espera.min))+geom_boxplot(aes(colour=as.factor(mes)))
Se aprecia claramente que los meses de junio a noviembre tienen un comportamiento especialmente diferente al resto de meses. Veamos este comportamiento respecto a rendimiento/capacidad del sistema.
Creamos una función que nos calcula los índices de capacidad básicos:
cap.fun=function(datos,lsl,usl){
xbar=mean(datos)
s=sd(datos)
zu=(usl-xbar)/s
zl=(lsl-xbar)/s
pdfe=pnorm(zl)+1-pnorm(zu)
zbench=qnorm(pdfe)
zscore=min(c(zu,-zl))
Pp=(usl-lsl)/(6*s)
Ppk=min(c(zu/3,-zl/3 ))
return(data.frame(zl=zl,zu=zu,pdfe=pdfe,zbench=zbench,zscore=zscore,Pp=Pp,Ppk=Ppk))}Y calculamos dichos índices de capacidad de modo global con todos los datos:
lsl=0;usl=60
cap.global=cap.fun(datos$tpo.espera.min,lsl,usl)
pander(cap.global)| zl | zu | pdfe | zbench | zscore | Pp | Ppk |
|---|---|---|---|---|---|---|
| -0.8488 | 0.981 | 0.3613 | -0.3551 | 0.8488 | 0.305 | 0.2829 |
y de modo específico cada mes:
pormes=tapply(datos$tpo.espera.min,INDEX=as.factor(datos$mes),FUN=cap.fun,lsl=lsl,usl=usl)
pander(pormes)sept.:
zl zu pdfe zbench zscore Pp Ppk -1.73 -0.1725 0.6103 0.2801 -0.1725 0.2596 -0.0575 oct.:
zl zu pdfe zbench zscore Pp Ppk -1.341 1.604 0.1443 -1.061 1.341 0.4909 0.4471 nov.:
zl zu pdfe zbench zscore Pp Ppk -1.131 5.582 0.1289 -1.131 1.131 1.119 0.3771 dic.:
zl zu pdfe zbench zscore Pp Ppk -1.238 12.75 0.1078 -1.238 1.238 2.332 0.4128 ene.:
zl zu pdfe zbench zscore Pp Ppk -1.271 7.535 0.1018 -1.271 1.271 1.468 0.4238 feb.:
zl zu pdfe zbench zscore Pp Ppk -1.19 9.646 0.117 -1.19 1.19 1.806 0.3967 mar.:
zl zu pdfe zbench zscore Pp Ppk -1.111 9.478 0.1334 -1.111 1.111 1.765 0.3702 abr.:
zl zu pdfe zbench zscore Pp Ppk -1.121 13.38 0.1312 -1.121 1.121 2.417 0.3736 may.:
zl zu pdfe zbench zscore Pp Ppk -0.5329 5.347 0.297 -0.5329 0.5329 0.9799 0.1776 jun.:
zl zu pdfe zbench zscore Pp Ppk -0.7622 2.959 0.2245 -0.7571 0.7622 0.6202 0.2541 jul.:
zl zu pdfe zbench zscore Pp Ppk -1.384 2.502 0.08933 -1.345 1.384 0.6477 0.4614
Si además definimos qué entendemos por defecto, podemos calcular el rendimiento (YIELD) y todas las medidas relacionadas para cuantificar capacidad en términos del número de defectos. Globalmente tenemos:
defectos=sum(datos$tpo.espera.min>usl)+sum(datos$tpo.espera.min<lsl)
opp=length(datos$tpo.espera.min)
pander(ss.ca.yield(defects = defectos, rework = 0, opportunities = opp))| Yield | FTY | RTY | DPU | DPMO |
|---|---|---|---|---|
| 0.8443 | 0.8443 | 0.8443 | 584 | 155733 |
Análisis de capacidad con ‘qcc’
Utilizando la librería ‘qcc’ realizamos el análisis de capacidad con todos los datos disponibles, considerando posibles diferencias entre los meses del curso:
cap <- qcc.groups(datos$tpo.espera.min, datos$mes)
q <- qcc(cap, type="xbar", nsigmas=3, plot=TRUE)
plot(q)
lsl=0;usl=60
target=30
process.capability(q, spec.limits=c(lsl,usl),target=target)
##
## Process Capability Analysis
##
## Call:
## process.capability(object = q, spec.limits = c(lsl, usl), target = target)
##
## Number of obs = 3750 Target = 30
## Center = 27.83 LSL = 0
## StdDev = 22.63 USL = 60
##
## Capability indices:
##
## Value 2.5% 97.5%
## Cp 0.4418 0.4318 0.4518
## Cp_l 0.4099 0.3980 0.4218
## Cp_u 0.4737 0.4610 0.4864
## Cp_k 0.4099 0.3958 0.4240
## Cpm 0.4398 0.4298 0.4498
##
## Exp<LSL 11% Obs<LSL 0%
## Exp>USL 7.8% Obs>USL 16%Separamos en particular el mes de septiembre y repetimos el análisis de capacidad con idénticos objetivos y límites de especificación, pero diferenciando por días (laborables):
datos.sep=tiemposespera%>%
select(fecha,mes,tpo.espera.min)%>%
filter(mes=="sept.")%>%
mutate(fecha=factor(fecha,levels=as.character(unique(fecha[mes=="sept."]))))
cap <- qcc.groups(datos.sep$tpo.espera.min, datos.sep$fecha)
q <- qcc(cap, type="xbar", nsigmas=3, plot=TRUE)
plot(q)
lsl=0;usl=60
target=30
process.capability(q, spec.limits=c(lsl,usl),target=target)
##
## Process Capability Analysis
##
## Call:
## process.capability(object = q, spec.limits = c(lsl, usl), target = target)
##
## Number of obs = 960 Target = 30
## Center = 66.3 LSL = 0
## StdDev = 27.58 USL = 60
##
## Capability indices:
##
## Value 2.5% 97.5%
## Cp 0.36260 0.34637 0.37882
## Cp_l 0.80133 0.76641 0.83624
## Cp_u -0.07613 -0.05821 -0.09406
## Cp_k -0.07613 -0.05477 -0.09749
## Cpm 0.21936 0.20682 0.23189
##
## Exp<LSL 0.81% Obs<LSL 0%
## Exp>USL 59% Obs>USL 55%Quitamos ahora los meses críticos, de junio a noviembre (ambos incluidos) y enero:
datos.p=datos %>%
filter(mes %in% c( "dic.", "feb.", "mar.", "abr.", "may.")) %>%
mutate(mes=factor(mes,levels=unique(mes)))
cap <- qcc.groups(datos.p$tpo.espera.min, datos.p$mes)
q <- qcc(cap, type="xbar", nsigmas=3, plot=TRUE)
plot(q)
lsl=0;usl=60
target=30
process.capability(q, spec.limits=c(lsl,usl),target=target)
##
## Process Capability Analysis
##
## Call:
## process.capability(object = q, spec.limits = c(lsl, usl), target = target)
##
## Number of obs = 767 Target = 30
## Center = 5.837 LSL = 0
## StdDev = 6.129 USL = 60
##
## Capability indices:
##
## Value 2.5% 97.5%
## Cp 1.6317 1.5500 1.7134
## Cp_l 0.3175 0.2936 0.3414
## Cp_u 2.9459 2.8206 3.0713
## Cp_k 0.3175 0.2890 0.3459
## Cpm 0.4012 0.3732 0.4291
##
## Exp<LSL 17% Obs<LSL 0%
## Exp>USL 0% Obs>USL 0.13%