Modelo

Problema 17.6-12 del Hillier y Lieberman, 10ma edición.

El Security & Trust Bank tiene 4 cajeros para atender a sus clientes, los cuales llegan según un proceso de Poisson con tasa media de 2 por minuto. Sin embargo, el negocio crece y la gerencia pronostica que esta tasa será de 3 por minuto dentro de un año. El tiempo de transacciones entre el cajero y el cliente tiene distribución exponencial con media de 1 minuto.

set.seed(12345678)
library(simmer)
lambda1 <- 2
lambda2 <- 3
mu <- 1

cliente <- trajectory() %>%
  seize("cajero", amount=1) %>%
  timeout(function() rexp(1, mu)) %>%
  release("cajero", amount=1)

env <- simmer() %>%
  add_resource("cajero", capacity=4, queue_size=Inf) %>%
  add_generator("cliente", cliente, function() rexp(1, lambda1)) %>% 
  run(until=480) # Jornada de 8 horas

Replicas

Para obtener intervalos de confianza para nuestras medidas de rendimiento replicamos la simulación un numero razonable de veces.

library(parallel)
envs <- mclapply(1:100, function(i) { # Si no usas parallel sustituir mclapply por lapply
  simmer() %>%
    add_resource("cajero", capacity=4, queue_size=Inf) %>%
    add_generator("cliente", cliente, function() rexp(1, lambda1)) %>% 
    run(until=480) %>%
    wrap()}) # Necesario si utilizas parallel

Políticas de Servicio

La gerencia ha establecido las siguientes políticas para lograr un nivel de servicio satisfactorio. El número promedio de clientes que esperan en la cola para iniciar su servicio no debe exceder de 1. Al menos 95% del tiempo, el número de clientes en la cola no debe exceder de 5. En el caso de al menos 95% de los clientes, el tiempo de espera para iniciar el servicio no debe exceder de 5 minutos.

  1. Determine si se cumplen estas políticas.
  2. Evalúe si se cumplirán estas políticas dentro de un año si no cambia el número de cajeros.
  3. Determine cuántos cajeros se necesitarán dentro de un año para cumplir por completo las políticas.

¿Se cumplen las políticas?

Para obtener los resultados de la simulación podemos recoger la monitorización básica de todas las réplicas tanto para las llegadas como para los recursos.

library(knitr)
envs.arrivals <- get_mon_arrivals(envs)
envs.resources <- get_mon_resources(envs)
kable(head(envs.arrivals))
name start_time end_time activity_time finished replication
cliente0 0.7922404 1.006589 0.2143485 TRUE 1
cliente2 0.9095217 1.342729 0.4332074 TRUE 1
cliente3 1.6275678 2.007296 0.3797283 TRUE 1
cliente1 0.8758075 2.330081 1.4542735 TRUE 1
cliente4 2.3022708 2.800019 0.4977481 TRUE 1
cliente6 3.9850300 3.995810 0.0107802 TRUE 1 
kable(head(envs.resources))
resource time server queue capacity queue_size system limit replication
cajero 0.7922404 1 0 4 Inf 1 Inf 1
cajero 0.8758075 2 0 4 Inf 2 Inf 1
cajero 0.9095217 3 0 4 Inf 3 Inf 1
cajero 1.0065889 2 0 4 Inf 2 Inf 1
cajero 1.3427291 1 0 4 Inf 1 Inf 1
cajero 1.6275678 2 0 4 Inf 2 Inf 1

Nos interesa entonces determinar los valores de nuestras medidas de rendimiento. Para calcular \(L\) y \(L_q\) para cada replica hacemos:

library(dplyr)

# Número promedio de clientes en el sistema
n_system <- function(time, system){
  sum(diff(time) * system[1:(length(time)-1)]) / time[length(time)]
}

# Número promedio de clientes en la cola
n_queue <- function(time, queue){
  sum(diff(time) * queue[1:(length(time)-1)]) / time[length(time)]
}

# Fracción del tiempo que hay n o menos en la cola
t_queue_le_n <- function(time, queue, n){
  sum(diff(time) * (queue[1:(length(time)-1)] <= n)) / time[length(time)]
}

envs.n <- envs.resources %>%
  group_by(replication) %>%
  summarise(L = n_system(time, system),
            Lq = n_queue(time, queue),
            "t(Lq<5)" = t_queue_le_n(time, queue, 5))

kable(head(envs.n))
replication L Lq t(Lq<5)
1 2.074689 0.1573721 0.9972341
2 2.072089 0.1345108 0.9991821
3 2.163728 0.1618810 0.9987754
4 2.247956 0.1860681 0.9943818
5 2.009966 0.1110618 0.9977792
6 1.987542 0.1231909 0.9969542

¿Cómo están distribuidos estos valores?

Construyamos un gráfico violin para tener una mejor idea de la distribución de los valores.

library(ggplot2)
library(reshape2)
long_n <- melt(envs.n[,2:3])
ggplot(long_n, aes(x = variable, y = value, col = variable)) + geom_violin() +
  ggtitle("Año actual: número de clientes") + xlab("") + ylab("# clientes")

Largo de la cola

L.interval <- quantile(envs.n$L, c(.05, .95))
Lq.interval <- quantile(envs.n$Lq, c(.05, .95))
tLq5.interval <- quantile(envs.n$`t(Lq<5)`, c(.05, .95))

  • El valor estimado de \(L\) es 2.18, y el 90% de las replicas devuelven valores entre 1.99 y 2.43.

  • El valor estimado de \(L_q\) es 0.18, y el 90% de las replicas devuelven valores entre 0.1 y 0.27

  • El valor estimado de la fracción del tiempo en que \(L_q \le 5\) es 99.6%, y el 90% de las replicas devuelven valores entre 98.82% y 99.97%

Claramente el largo promedio de la cola es menor que 1, y en promedio más del 99.5% del tiempo la cola tiene 5 personas o menos.

Tiempo en la cola

El tiempo en la cola está dado por el tiempo que cada persona espera en el sistema end_time - start_time menos el tiempo que dura el servicio activity_time.

# Tiempo promedio en el sistema
w <- function(start_time, end_time){
  mean(end_time - start_time)
}

# Tiempo promedio en la cola
wq <- function(start_time, end_time, activity_time){
  mean(end_time - start_time - activity_time)
}

# Tiempo promedio en la cola
n_queue_le_t <- function(start_time, end_time, activity_time){
  mean((end_time - start_time - activity_time) < 5)
}

envs.w <- envs.arrivals %>%
  filter(finished == TRUE) %>% # Considerar solamente los que han salido del sistema
  group_by(replication) %>%
  summarise(W = w(start_time, end_time),
            Wq = wq(start_time, end_time, activity_time),
            max_Wq =  max(end_time - start_time - activity_time),
            "n(Wq < 5)" = n_queue_le_t(start_time, end_time, activity_time))

kable(head(envs.w))
replication W Wq max_Wq n(Wq < 5)
1 1.079617 0.0818926 2.069323 1
2 1.055133 0.0685355 2.385499 1
3 1.108642 0.0829439 2.217194 1
4 1.126283 0.0931014 2.993761 1
5 1.030745 0.0570644 1.721083 1
6 1.017678 0.0631283 1.723844 1 
W.interval <- quantile(envs.w$W, c(.05, .95))
Wq.interval <- quantile(envs.w$Wq, c(.05, .95))
long_w <- melt(envs.w[,2:4])
## No id variables; using all as measure variables
ggplot(long_w, aes(x = variable, y = value, col = variable)) + geom_violin() +
  ggtitle("Año actual: tiempos de espera") + xlab("") + ylab("tiempo (min)")

En este caso se calcula el tiempo promedio de servicio solamente para verificar.

  • El valor estimado de \(W\) es 1.09 min, y el 90% de las replicas devuelven valores entre 1.02 y 1.17.

  • El valor estimado de \(W_q\) es 0.09 min, y el 90% de las replicas devuelven valores entre 0.05 y 0.14

La fracción de personas que esperan 5 minutos o menos es 100 %, ya que muy pocos clientes esperan más de 5 min. El mayor tiempo de espera encontrado en todas las replicas es 4.83 min. El tiempo promedio de espera en la cola es de 5.4 segundos, muy por debajo de 1 minuto.

¿Se cumplirán las políticas el próximo año?

Si llega un solo cliente más por minuto, ¿qué pasaría?, veamos:

envs2 <- mclapply(1:100, function(i) { # Si no usas parallel sustituir mclapply por lapply
  simmer() %>%
    add_resource("cajero", capacity=4, queue_size=Inf) %>%
    add_generator("cliente", cliente, function() rexp(1, lambda2)) %>% 
    run(until=480) %>%
    wrap()})

envs2.arrivals <- get_mon_arrivals(envs2)
envs2.resources <- get_mon_resources(envs2)

envs2.n <- envs2.resources %>%
  group_by(replication) %>%
  summarise(L = n_system(time, system),
            Lq = n_queue(time, queue),
            "t(Lq<5)" = t_queue_le_n(time, queue, 5))

envs2.w <- envs2.arrivals %>%
  filter(finished == TRUE) %>% # Considerar solamente los que han salido del sistema
  group_by(replication) %>%
  summarise(W = w(start_time, end_time),
            Wq = wq(start_time, end_time, activity_time),
            max_Wq =  max(end_time - start_time - activity_time),
            "n(Wq < 5)" = n_queue_le_t(start_time, end_time, activity_time))
long2_n <- melt(envs2.n[,2:3])
## No id variables; using all as measure variables
ggplot(long2_n, aes(x = variable, y = value, col = variable)) + geom_violin() +
  ggtitle("Próximo año: número de clientes") + xlab("") + ylab("# clientes")

L2.interval <- quantile(envs2.n$L, c(.05, .95))
Lq2.interval <- quantile(envs2.n$Lq, c(.05, .95))
tLq52.interval <- quantile(envs2.n$`t(Lq<5)`, c(.05, .95))

El largo promedio de la cola es mayor que 1, y en promedio alrededor del 91% del tiempo la cola tiene 5 personas o menos. No se cumple ninguna de las políticas respecto al largo de la cola.

long2_w <- melt(envs2.w[,2:4])
## No id variables; using all as measure variables
ggplot(long2_w, aes(x = variable, y = value, col = variable)) + geom_violin() +
  ggtitle("Próximo año: tiempos de espera") + xlab("") + ylab("tiempo (min)")

W2.interval <- quantile(envs2.w$W, c(.05, .95))
Wq2.interval <- quantile(envs2.w$Wq, c(.05, .95))

La fracción de personas en promedio que esperan 5 minutos o menos es 99.68 %. El mayor tiempo de espera encontrado en todas las replicas es 11.34 min. Sin embargo, el tiempo promedio de espera en la cola es de 30 segundos, aún por debajo de 1 minuto. Se siguen cumpliendo las políticas respecto al tiempo de espera en la cola.

Número de cajeros necesario para que se cumplan las políticas

Tarea para el martes.