Al servicio de urgencias de un hospital los pacientes llegan según un Proceso de Poisson de tasa 3 pacientes/hora. El médico que está en dicho servicio los atiende a razón de 4 pacientes/hora (tiempos exponenciales). ¿Contrataría o no a un segundo médico?
El primer sistema (S1) se trata de una cola M/M/1 con tasa de llegadas \(\lambda=3\) pac/h y tasa de servicios \(\mu=4\) pac/h. El segundo (S2) con un segundo médico, sería M/M/2. Definimos el entorno de colas para ambos sistemas y vamos respondiendo a las cuestiones comparándolos.
lambda=3;mu=4
env.mm1 <- NewInput.MM1(lambda = lambda, mu = mu,n=4)
s.mm1 <- QueueingModel(env.mm1)
env.mm2 <- NewInput.MMC(lambda = lambda, mu = mu, c = 2, n = 4)
s.mm2 <- QueueingModel(env.mm2)
# y pedimos un descriptivo rápido
sum.mm1=summary(s.mm1)
sum.mm2=summary(s.mm2)
sum.mm1;sum.mm2## lambda mu c k m RO P0 Lq Wq X L W Wqq Lqq
## 1 3 4 1 NA NA 0.75 0.25 2.25 0.75 3 3 1 1 4## lambda mu c k m RO P0 Lq Wq X L W
## 1 3 4 2 NA NA 0.375 0.4545455 0.1227273 0.04090909 3 0.8727273 0.2909091
## Wqq Lqq
## 1 0.2 1.6Para responder a esta pregunta se deben comparar las siguientes características en ambos sistemas:
Nos piden \(Pr(N=0)=p_0\), que según el descriptivo global, para el valor de \(P0\), vale 0.25 para S1 y 0.4545455 para S2. Es más probable tener urgencias vacías con dos doctores que con 1.
sum.mm1[[1]]$P0;sum.mm2[[1]]$P0## [1] 0.25## [1] 0.4545455# también lo podríamos calcular con Pn
s.mm1$Pn[1]## [1] 0.25s.mm2$Pn[1]## [1] 0.4545455# también lo podríamos calcular con Pn
s.mm1$Pn[4]## [1] 0.1054688s.mm2$Pn[4]## [1] 0.04794034El ratio de comparación entre las dos probabilidades para urgencias con 1 y 2 doctores es 2.2.
Respondemos con el tiempo medio de espera en el sistema, \(W\), que es 1 hora para S1 y 0.2909091h para S2; es decir, el tiempo de permanencia en urgencias se reduce en 42.5454545 minutos cuando hay dos doctores.
Nos preguntan por \(Wq\), que es 0.75 horas (45 minutos) en S1 y 0.0409091 horas (2.4545455 minutos) en S2.
Buscamos el número medio de pacientes en el sistema, \(L\), que es 3 pacientes para S1 y 0.8727273 pacientes para S2, que son claramente distintos y favorecen el sistema con 2 doctores.
Respondemos con \(Lq\), que es 2.25 para S1 y 0.1227273 para S2. La ocupación de la sala de espera se reduce sustancialmente cuando hay dos doctores.
Calculamos la \(Pr(T >1)\) con la función de distribución \(FW\)
1-s.mm1$FW(1)## [1] 0.36787941-s.mm2$FW(1)## [1] 0.0277883La probabilidad de que un paciente esté en urgencias más de una hora es 0.3679 cuando hay un doctor y 0.0278 cuando hay dos.
Calculamos la \(Pr(T_q >1)\) con la función de distribución \(FWq\)
1-s.mm1$FWq(1)## [1] 0.27590961-s.mm2$FWq(1)## [1] 0.001378216La probabilidad de que un paciente espere más de una hora a ser atendido es 0.2759 cuando hay un doctor y 0.0014 cuando hay 2.
Como conclusión, es más eficiente tener a dos doctores que a uno.
Aproximamos a continuación las cuestiones 1, 3 y 4 mediante simulación con las funciones cola.MM1(t, lambda, mu) y cola.MMs(t, lambda, mu,s) programadas en simmer y disponibles.
Simulamos.
lambda=3;mu=4
# tiempo de funcionamiento del sistema
t=500 # tiempo total simulado
nreplicas=500 # número de réplicas
s.mm1=mclapply(1:nreplicas, function(i){
cola.MM1(t, lambda,mu)%>%
wrap()},mc.set.seed=FALSE)
s.mm2=mclapply(1:nreplicas, function(i){
cola.MMs(t, lambda,mu,2)%>%
wrap()},mc.set.seed=FALSE)
# almacenamos análisis de recursos del sistema
sim.mm1<-as_tibble(get_mon_resources(s.mm1))
sim.mm2<-as_tibble(get_mon_resources(s.mm2))
head(sim.mm2)## # A tibble: 6 × 9
## resource time server queue capacity queue_size system limit replication
## <chr> <dbl> <int> <int> <dbl> <dbl> <int> <dbl> <int>
## 1 server 0.192 1 0 2 Inf 1 Inf 1
## 2 server 0.394 2 0 2 Inf 2 Inf 1
## 3 server 0.503 1 0 2 Inf 1 Inf 1
## 4 server 0.559 0 0 2 Inf 0 Inf 1
## 5 server 0.827 1 0 2 Inf 1 Inf 1
## 6 server 0.843 0 0 2 Inf 0 Inf 1Calculamos la probabilidad de que no haya pacientes en Urgencias, aproximando \(p_0\).
# tiempo con estado=0
p0.mm1=p0.mm2=vector()
for(i in 1:nreplicas){
# para la mm1
sim.sel=sim.mm1[sim.mm1$replication==i,]
estados=c(0,sim.sel$system)
periodos=diff(c(0,sim.sel$time,t))
estados.sim=data.frame(estados,periodos)
p0.mm1[i]=sum(estados.sim$periodos[estados.sim$estados==0])/t
# para la mm2
sim.sel=sim.mm2[sim.mm2$replication==i,]
estados=c(0,sim.sel$system)
periodos=diff(c(0,sim.sel$time,t))
estados.sim=data.frame(estados,periodos)
p0.mm2[i]=sum(estados.sim$periodos[estados.sim$estados==0])/t
}
p0.m1=mean(p0.mm1)*100
p0.error1=sd(p0.mm1)/sqrt(nreplicas)*100
p0.m2=mean(p0.mm2)*100
p0.error2=sd(p0.mm2)/sqrt(nreplicas)*100
# Ya obtenemos la estimación MC y su error
cat("\n Tiempo que ha estado vacío el servicio de urgencias en S1: ",round(p0.m1,2),"% (error=",round(p0.error1,2),"%).")##
## Tiempo que ha estado vacío el servicio de urgencias en S1: 25.02 % (error= 0.12 %).cat("\n Tiempo que ha estado vacío el servicio de urgencias en S2: ",round(p0.m2,2),"% (error=",round(p0.error2,2),"%).")##
## Tiempo que ha estado vacío el servicio de urgencias en S2: 45.51 % (error= 0.07 %).0.2494*24*30## [1] 179.568Estimamos el tiempo medio de permanencia en urgencias y también el tiempo de espera, a partir del data.frame que contiene los tiempos para cada uno de los pacientes que han pasado por urgencias.
# almacenamos análisis de llegadas al sistema
arr.mm1<-as_tibble(get_mon_arrivals(s.mm1))
arr.mm2<-as_tibble(get_mon_arrivals(s.mm2))
tpo.mm1=arr.mm1 %>%
group_by(replication) %>%
summarise(permanencia=mean(end_time-start_time),
espera=mean(end_time-start_time-activity_time))%>%
summarise(permanencia.m=mean(permanencia),permanencia.err=sd(permanencia)/sqrt(nreplicas),
espera.m=mean(espera),espera.err=sd(espera)/sqrt(nreplicas))
cat("\n Permanencia media en urgencias con 1 doctor:",round(tpo.mm1$permanencia.m,2),"h (",round(tpo.mm1$permanencia.err,4),")")##
## Permanencia media en urgencias con 1 doctor: 0.99 h ( 0.0082 )cat("\n Espera media en urgencias con 1 doctor:",round(tpo.mm1$espera.m,2),"h (",round(tpo.mm1$espera.err,4),")")##
## Espera media en urgencias con 1 doctor: 0.74 h ( 0.008 )tpo.mm2=arr.mm2 %>%
group_by(replication) %>%
summarise(permanencia=mean(end_time-start_time),
espera=mean(end_time-start_time-activity_time))%>%
summarise(permanencia.m=mean(permanencia),permanencia.err=sd(permanencia)/sqrt(nreplicas),
espera.m=mean(espera),espera.err=sd(espera)/sqrt(nreplicas))
cat("\n Permanencia media en urgencias con 2 doctores:",round(tpo.mm2$permanencia.m,2),"h (",round(tpo.mm2$permanencia.err,4),")")##
## Permanencia media en urgencias con 2 doctores: 0.29 h ( 5e-04 )cat("\n Espera media en urgencias con 2 doctores:",round(tpo.mm2$espera.m,2),"h (",round(tpo.mm2$espera.err,4),")")##
## Espera media en urgencias con 2 doctores: 0.04 h ( 3e-04 )Un pequeño autoservicio de lavado en el que el coche que entra no puede hacerlo hasta que el otro haya salido completamente, tiene una capacidad de aparcamiento de 10 coches, incluyendo el que está siendo lavado. La empresa ha estimado que los coches llegan según un proceso de Poisson con una media de 20 coches/hora, y el tiempo de lavado sigue una distribución exponencial de 12 minutos. La empresa abre durante 10 horas al día. ¿Cuál es la media de coches perdidos cada día debido a las limitaciones de espacio?
lambda=20;mu=60/12 # coches por hora
env.mm <- NewInput.MMCK(lambda = lambda, mu = mu,c=1,k=10)
s.mm <- QueueingModel(env.mm)## Warning in formals(fun): argument is not a function
## Warning in formals(fun): argument is not a function
## Warning in formals(fun): argument is not a function
## Warning in formals(fun): argument is not a function
## Warning in formals(fun): argument is not a function
## Warning in formals(fun): argument is not a function
## Warning in formals(fun): argument is not a function
## Warning in formals(fun): argument is not a function
## Warning in formals(fun): argument is not a function# y pedimos un descriptivo rápido
sum.mm=summary(s.mm)
sum.mm## lambda mu c k m RO P0 Lq Wq X L
## 1 20 5 1 10 NA 0.9999993 7.152559e-07 8.66667 1.733335 4.999996 9.666669
## W Wqq Lqq
## 1 1.933335 1.73334 8.666701# probabilidad de encontrar el autolavado lleno
s.mm$Qn[10]## [1] 0.7500007# número de coches que llegan en un día (10 horas de apertura)
lambda*10## [1] 200# Número de coches que acudirán al autolavado y lo encontrarán lleno
lambda*10*s.mm$Qn[10]## [1] 150.0001