Caso 2 -Estocasticos
Corredor, Peña
22/5/2021
SOUTH WEST HEALTH CENTRE: IMPROVING PATIENT FLOW IN THE INTENSIVE CARE UNIT
Caso 2 - Procesos Estocasticos
Preguntas
1. Preprocesamiento de los datos: Análisis de los datos que se requiere previo a realizar el modelamiento.
- a. Realice un gráfico que presente la cantidad promedio de personas que llegan al Hospital Universitario según cada día de la semana y cada una de las jornadas (Mañana 6:00 am – 12:00, Tarde 12:00 – 6:00 pm, Noche 6:00 pm a 12:00, Madrugada 12:00 a 6:00 am). Utilice el gráfico para decidir si es razonable asumir que la llegada de los pacientes tiene un comportamiento similar a lo largo de los días de la semana.
# Pacientes por jornada el Lunes
#Mañana
LunesMañana <- Arribos %>% filter(Jornada=="Mañana",`Dia de la semana`=="lunes")
ContarLM<-count(LunesMañana)
ContarLM## n
## 1 29#Tarde
LunesTarde<- Arribos %>% filter(Jornada=="Tarde",`Dia de la semana`=="lunes")
ContarLT<-count(LunesTarde)
ContarLT## n
## 1 34#Noche
LunesNoche<- Arribos %>% filter(Jornada=="Noche",`Dia de la semana`=="lunes")
ContarLN<-count(LunesNoche)
ContarLN## n
## 1 37#Madrugada
LunesMadrugada<- Arribos %>% filter(Jornada=="Madrugada",`Dia de la semana`=="lunes")
ContarLD<-count(LunesMadrugada)
ContarLD## n
## 1 37TotalLunes<-ContarLM+ContarLT+ContarLN+ContarLD
TotalLunes## n
## 1 137# Pacientes por jornada el martes
#Mañana
MartesMañana <- Arribos %>% filter(Jornada=="Mañana",`Dia de la semana`=="martes")
ContarMM<-count(MartesMañana)
ContarMM## n
## 1 34#Tarde
MartesTarde<- Arribos %>% filter(Jornada=="Tarde",`Dia de la semana`=="martes")
ContarMT<-count(MartesTarde)
ContarMT## n
## 1 43#Noche
MartesNoche<- Arribos %>% filter(Jornada=="Noche",`Dia de la semana`=="martes")
ContarMN<-count(MartesNoche)
ContarMN## n
## 1 42#Madrugada
MartesMadrugada<- Arribos %>% filter(Jornada=="Madrugada",`Dia de la semana`=="martes")
ContarMD<-count(MartesMadrugada)
ContarMD## n
## 1 48TotalMartes<-ContarMM+ContarMT+ContarMN+ContarMD
TotalMartes## n
## 1 167# Pacientes por jornada el Miercoles
#Mañana
MiercolesMañana <- Arribos %>% filter(Jornada=="Mañana",`Dia de la semana`=="miércoles")
ContarIM<-count(MiercolesMañana)
ContarIM## n
## 1 44#Tarde
MiercolesTarde<- Arribos %>% filter(Jornada=="Tarde",`Dia de la semana`=="miércoles")
ContarIT<-count(MiercolesTarde)
ContarIT## n
## 1 40#Noche
MiercolesNoche<- Arribos %>% filter(Jornada=="Noche",`Dia de la semana`=="miércoles")
ContarIN<-count(MiercolesNoche)
ContarIN## n
## 1 40#Madrugada
MiercolesMadrugada<- Arribos %>% filter(Jornada=="Madrugada",`Dia de la semana`=="miércoles")
ContarID<-count(MiercolesMadrugada)
ContarID## n
## 1 43TotalMiercoles<-ContarIM+ContarIT+ContarIN+ContarID
TotalMiercoles## n
## 1 167# Pacientes por jornada el jueves
#Mañana
JuevesMañana <- Arribos %>% filter(Jornada=="Mañana",`Dia de la semana`=="jueves")
ContarJM<-count(JuevesMañana)
ContarJM## n
## 1 45#Tarde
JuevesTarde<- Arribos %>% filter(Jornada=="Tarde",`Dia de la semana`=="jueves")
ContarJT<-count(JuevesTarde)
ContarJT## n
## 1 39#Noche
JuevesNoche<- Arribos %>% filter(Jornada=="Noche",`Dia de la semana`=="jueves")
ContarJN<-count(JuevesNoche)
ContarJN## n
## 1 44#Madrugada
JuevesMadrugada<- Arribos %>% filter(Jornada=="Madrugada",`Dia de la semana`=="jueves")
ContarJD<-count(JuevesMadrugada)
ContarJD## n
## 1 35TotalJueves<-ContarJM+ContarJT+ContarJN+ContarJD
TotalJueves## n
## 1 163# Pacientes por jornada el viernes
#Mañana
ViernesMañana <- Arribos %>% filter(Jornada=="Mañana",`Dia de la semana`=="viernes")
ContarVM<-count(ViernesMañana)
ContarVM## n
## 1 42#Tarde
ViernesTarde<- Arribos %>% filter(Jornada=="Tarde",`Dia de la semana`=="viernes")
ContarVT<-count(ViernesTarde)
ContarVT## n
## 1 35#Noche
ViernesNoche<- Arribos %>% filter(Jornada=="Noche",`Dia de la semana`=="viernes")
ContarVN<-count(ViernesNoche)
ContarVN## n
## 1 47#Madrugada
ViernesMadrugada<- Arribos %>% filter(Jornada=="Madrugada",`Dia de la semana`=="viernes")
ContarVD<-count(ViernesMadrugada)
ContarVD## n
## 1 43TotalViernes<- ContarVM+ContarVT+ContarVN+ContarVD
TotalViernes## n
## 1 167# Pacientes por jornada el sábado
#Mañana
SabadoMañana <- Arribos %>% filter(Jornada=="Mañana",`Dia de la semana`=="sábado")
ContarSM<-count(SabadoMañana)
ContarSM## n
## 1 31#Tarde
SabadoTarde<- Arribos %>% filter(Jornada=="Tarde",`Dia de la semana`=="sábado")
ContarST<-count(SabadoTarde)
ContarST## n
## 1 30#Noche
SabadoNoche<- Arribos %>% filter(Jornada=="Noche",`Dia de la semana`=="sábado")
ContarSN<-count(SabadoNoche)
ContarSN## n
## 1 27#Madrugada
SabadoMadrugada<- Arribos %>% filter(Jornada=="Madrugada",`Dia de la semana`=="sábado")
ContarSD<-count(SabadoMadrugada)
ContarSD## n
## 1 41TotalSabado<-ContarSM+ContarST+ContarSN+ContarSD
TotalSabado## n
## 1 129# Pacientes por jornada el Domingo
#Mañana
DomingoMañana <- Arribos %>% filter(Jornada=="Mañana",`Dia de la semana`=="domingo")
ContarDM<-count(DomingoMañana)
ContarDM## n
## 1 41#Tarde
DomingoTarde<- Arribos %>% filter(Jornada=="Tarde",`Dia de la semana`=="domingo")
ContarDT<-count(DomingoTarde)
ContarDT## n
## 1 42#Noche
DomingoNoche<- Arribos %>% filter(Jornada=="Noche",`Dia de la semana`=="domingo")
ContarDN<-count(DomingoNoche)
ContarDN## n
## 1 42#Madrugada
DomingoMadrugada<- Arribos %>% filter(Jornada=="Madrugada",`Dia de la semana`=="domingo")
ContarDD<-count(DomingoMadrugada)
ContarDD## n
## 1 34TotalDomingo <-ContarDM+ContarDT+ContarDN+ContarDD
TotalDomingo## n
## 1 159
Figura 1. Cantidad Promedio De Pacientes
Figura 2. Cantidad de pacientes que arriban
- b. Realice una prueba de bondad de ajuste para probar si los tiempos entre llegadas se pueden modelar como una distribución exponencial. Hint: al restar dos fechas en Excel, el resultado se presenta en fracciones de días.
##
## Begin fitting distributions ---------------------------------------## * fitting normal distribution ... OK## * fitting Cauchy distribution ... OK## * fitting logistic distribution ... OK## * fitting beta distribution ... failed## * fitting exponential distribution ... OK## * fitting chi-square distribution ... failed## * fitting uniform distribution ... OK## * fitting gamma distribution ... failed## * fitting lognormal distribution ... failed## * fitting Weibull distribution ... failed## * fitting F-distribution ... failed## * fitting Student's t-distribution ... OK## * fitting Gompertz distribution ... OK## * fitting triangular distribution ... failed## End fitting distributions -----------------------------------------## logL AIC BIC Chisq(value) Chisq(p) AD(value) H(AD)
## Normal -315.07 634.14 644.13 706.65 0.00 46.03 rejected
## Cauchy -314.15 632.3 642.29 638.96 0.00 58.53 rejected
## Logistic -260.22 524.45 534.43 615.63 0.00 33.18 rejected
## Exponential 103.11 -204.22 -199.22 43.66 0.02 Inf rejected
## Uniform NULL NULL NULL Inf 0.00 Inf NULL
## Student -1119.71 2241.43 2246.42 2895.67 0.00 266.09 NULL
## Gompertz 103.88 -203.75 -193.76 42.69 0.02 Inf NULL
## KS(value) H(KS)
## Normal 0.15 rejected
## Cauchy 0.20 rejected
## Logistic 0.15 rejected
## Exponential 0.02 not rejected
## Uniform 0.20 rejected
## Student 0.50 rejected
## Gompertz 0.02 not rejected##
## Chosen continuous distribution is: Exponential (exp)
## Fitted parameters are:
## rate
## 2.987975## Goodness-of-fit statistics
## 1-mle-exp
## Kolmogorov-Smirnov statistic 0.01611993
## Cramer-von Mises statistic 0.06087069
## Anderson-Darling statistic Inf
##
## Goodness-of-fit criteria
## 1-mle-exp
## Akaike's Information Criterion -204.2188
## Bayesian Information Criterion -199.2249
- c. Realice una prueba de bondad de ajuste para probar si los tiempos de servicio se pueden modelar como una distribución exponencial.
H0: Las observaciones del mes de diciembre cumplen con la Propiedad de Markov.
H1: Las Observaciones del mes de diciembre no cumplen con la Propiedad de Markov.
#Tiempos de servicio para MSICU(icu)
fit.cont(Icu$TiempoServicio)##
## Begin fitting distributions ---------------------------------------## * fitting normal distribution ... OK## * fitting Cauchy distribution ... OK## * fitting logistic distribution ... OK## * fitting beta distribution ... failed## * fitting exponential distribution ... OK## * fitting chi-square distribution ... OK## * fitting uniform distribution ... OK## * fitting gamma distribution ... OK## * fitting lognormal distribution ... OK## * fitting Weibull distribution ... OK## * fitting F-distribution ... OK## * fitting Student's t-distribution ... OK## * fitting Gompertz distribution ... OK## * fitting triangular distribution ... failed## End fitting distributions -----------------------------------------## logL AIC BIC Chisq(value) Chisq(p) AD(value)
## Normal -3551.21 7106.42 7116.4 841.48 0.00 54.74
## Cauchy -3468.35 6940.7 6950.69 547.13 0.00 54.92
## Logistic -3463.18 6930.36 6940.34 696.89 0.00 36.71
## Exponential -3087.32 6176.63 6181.63 16.13 0.95 0.48
## Chi-square -3513.27 7028.53 7033.53 5052.44 0.00 120.30
## Uniform NULL NULL NULL Inf 0.00 Inf
## Gamma -3087.16 6178.32 6188.31 16.04 0.94 0.53
## Lognormal -3162.81 6329.62 6339.61 104.20 0.00 10.16
## Weibull -3087.28 6178.56 6188.55 16.15 0.93 0.50
## F -3473.75 6951.5 6961.49 779.68 0.00 168.49
## Student -4299.42 8600.84 8605.83 3032.66 0.00 769.37
## Gompertz -3087.44 6178.88 6188.87 16.44 0.92 0.54
## H(AD) KS(value) H(KS)
## Normal rejected 0.16 rejected
## Cauchy rejected 0.19 rejected
## Logistic rejected 0.16 rejected
## Exponential not rejected 0.02 not rejected
## Chi-square NULL 0.15 rejected
## Uniform NULL 0.21 rejected
## Gamma not rejected 0.02 not rejected
## Lognormal rejected 0.08 rejected
## Weibull not rejected 0.02 not rejected
## F NULL 0.29 rejected
## Student NULL 0.57 rejected
## Gompertz NULL 0.02 not rejected##
## Chosen continuous distribution is: Exponential (exp)
## Fitted parameters are:
## rate
## 0.1600291pruebabondadICU<-fitdist(Icu$TiempoServicio,"exp")
gofstat(pruebabondadICU)## Goodness-of-fit statistics
## 1-mle-exp
## Kolmogorov-Smirnov statistic 0.02135524
## Cramer-von Mises statistic 0.07509211
## Anderson-Darling statistic 0.48477555
##
## Goodness-of-fit criteria
## 1-mle-exp
## Akaike's Information Criterion 6176.631
## Bayesian Information Criterion 6181.625plot(pruebabondadICU,demp=TRUE)
#Tiempos de servicio Ward
fit.cont(Ward$TiempoServicio)##
## Begin fitting distributions ---------------------------------------## * fitting normal distribution ... OK## * fitting Cauchy distribution ... OK## * fitting logistic distribution ... OK## * fitting beta distribution ... failed## * fitting exponential distribution ... OK## * fitting chi-square distribution ... OK## * fitting uniform distribution ... OK## * fitting gamma distribution ... OK## * fitting lognormal distribution ... OK## * fitting Weibull distribution ... OK## * fitting F-distribution ... OK## * fitting Student's t-distribution ... OK## * fitting Gompertz distribution ... failed## * fitting triangular distribution ... failed## End fitting distributions -----------------------------------------## logL AIC BIC Chisq(value) Chisq(p) AD(value)
## Normal -1099.15 2202.3 2210.06 203.06 0.00 17.84
## Cauchy -1064.83 2133.65 2141.41 162.23 0.00 16.52
## Logistic -1065.34 2134.69 2142.45 163.53 0.00 11.51
## Exponential -940.26 1882.53 1886.41 21.18 0.17 0.41
## Chi-square -1040.59 2083.19 2087.07 363.04 0.00 28.31
## Uniform NULL NULL NULL Inf 0.00 Inf
## Gamma -939.95 1883.89 1891.66 20.90 0.14 0.37
## Lognormal -981.18 1966.36 1974.12 72.45 0.00 6.19
## Weibull -940.02 1884.04 1891.8 21.15 0.13 0.38
## F -1051.38 2106.76 2114.52 249.61 0.00 49.14
## Student -1312.8 2627.59 2631.47 928.45 0.00 238.67
## H(AD) KS(value) H(KS)
## Normal rejected 0.17 rejected
## Cauchy rejected 0.19 rejected
## Logistic rejected 0.16 rejected
## Exponential not rejected 0.03 not rejected
## Chi-square NULL 0.14 rejected
## Uniform NULL 0.22 rejected
## Gamma NA 0.04 not rejected
## Lognormal rejected 0.11 rejected
## Weibull not rejected 0.04 not rejected
## F NULL 0.29 rejected
## Student NULL 0.53 rejected##
## Chosen continuous distribution is: Exponential (exp)
## Fitted parameters are:
## rate
## 0.1966292pruebabondadWard<-fitdist(Ward$TiempoServicio,"exp")
gofstat(pruebabondadWard)## Goodness-of-fit statistics
## 1-mle-exp
## Kolmogorov-Smirnov statistic 0.03382901
## Cramer-von Mises statistic 0.06315013
## Anderson-Darling statistic 0.40622164
##
## Goodness-of-fit criteria
## 1-mle-exp
## Akaike's Information Criterion 1882.528
## Bayesian Information Criterion 1886.408plot(pruebabondadWard,demp=TRUE)
2. Modele este sistema como una red de Jackson. + a. Realice el diagrama de nodos.
probabilidadesTransicion<- matrix(c(0,0.27,0.21,0.52,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),byrow = TRUE,ncol = 5, nrow = 5)
Estaciones<-c('ICU','WARD','MUERTE','TRANSFERENCIA','SALIDA')
colnames(probabilidadesTransicion)<-c(Estaciones)
row.names(probabilidadesTransicion)<-c(Estaciones)
probabilidadesTransicion## ICU WARD MUERTE TRANSFERENCIA SALIDA
## ICU 0 0.27 0.21 0.52 0
## WARD 0 0.00 0.00 0.00 1
## MUERTE 0 0.00 0.00 0.00 0
## TRANSFERENCIA 0 0.00 0.00 0.00 0
## SALIDA 0 0.00 0.00 0.00 0plotmat(round(probabilidadesTransicion, 3) , pos = c(1,3,1), lwd = 0.9, box.lwd = -0.7, cex.txt = 0.6, box.size = 0.07, box.type = "circle", box.prop = -0.5, box.col = "seagreen3", arr.length = -0.2, arr.width = 0.2, self.cex = -1.5, self.shifty = -0.05, self.shiftx = 0.13, main = "Transition Diagram")
b. Explique detalladamente si considera conveniente modelar esta situación como una Red de Jackson explicando si se cumplen los supuestos requeridos.
c. Obtenga los indicadores de desempeño de cada nodo.
Con el fin de obtener los \(λ_{i}\) de cada nodo, se procede a resolver las ecuaciones de trafico a partir de la siguiente expresión:
\(λ_{i}=r_i+Σ_{t}^{k}λ_{t}*p_{ti}\)
Reemplazando, en la ecuacion se obtienen las siguientes expresiones para la tasa de llegada de pacientes a la ICU(1) y a Ward(2):
\(λ_{1}=r_1\) \(λ_{2}=λ_{1}*p_{12}\)
Despejando se obtienen los siguientes valores:
\(λ_{1}=2.988\) \(λ_{2}=0.807\)
# ICU, Se modela como un sistema M/M/K/N con K=N
EntradaICU<- NewInput.MMCC(lambda = 0.33,mu= 6.25, c=25, method = 0)
SalidaICU<- QueueingModel(EntradaICU)
summary(SalidaICU)## lambda mu c k m RO P0 Lq Wq X L W Wqq Lqq
## 1 0.33 6.25 25 25 NA 0.002112 0.9485697 0 0 0.33 0.0528 0.16 NA NAEntradaICU1<- NewInput.MMCK(lambda = 0.33, mu = 6.25, c = 25, k = 25)
SalidaICU1<- QueueingModel(EntradaICU)
summary(SalidaICU1)## lambda mu c k m RO P0 Lq Wq X L W Wqq Lqq
## 1 0.33 6.25 25 25 NA 0.002112 0.9485697 0 0 0.33 0.0528 0.16 NA NA#Ward, se modela como un sistema M/M/K/N
EntradaWARD<- NewInput.MMCC(lambda = 0.091,mu= 5.08, c=5, method = 0)
SalidaWARD<- QueueingModel(EntradaWARD)
summary(SalidaWARD)## lambda mu c k m RO P0 Lq Wq X L W Wqq
## 1 0.091 5.08 5 5 NA 0.003582677 0.9822461 0 0 0.091 0.01791339 0.1968504 NA
## Lqq
## 1 NA- d. Obtenga los indicadores de desempeño de la red.
#RedJackson<- NewInput.OJN(probabilidadesTransicion,EntradaICU,EntradaWARD)
#RedJackson2<- QueueingModel(RedJackson)- e. Analice los resultados de los indicadores identificando los nodos cuellos de botella y los tiempos de espera.
3. Modelamiento analítico vs. Simulación + a. Explique detalladamente si considera más adecuado resolver este caso usando modelamiento analítico o simulación. Contemple los supuestos, las ventajas y desventajas de cada alternativa.
4. Generación de escenarios: + a. Realice un gráfico que permita comprender cómo cambian los indicadores de desempeño y los costos del GM ward al incrementarse la cantidad de camas. Pruebe hasta 25 camas. ¿Cómo cambian los indicadores de la red?
- b. Realice un gráfico que permita comprender cómo cambian los indicadores de desempeño y los costos del MSICU al incrementarse el número de camas. Pruebe hasta 50 camas. ¿Cómo cambian los indicadores de la red?
5. Recomendaciones: + a. Genere recomendaciones basadas en los hallazgos previos que permitan mejorar el servicio dado por el Hospital Universitario