SimulLIFO
Eric Michel FOTSING
Thursday, March 12, 2015
set.seed(80)
library(plyr)## Warning: package 'plyr' was built under R version 3.1.2library(ggplot2)## Warning: package 'ggplot2' was built under R version 3.1.2serviceTime = c()
sampleSize = 1000
Service <- function(n=1,typeservice,x,y) {
# genere un temps de service suivan
switch(typeservice,
det = rep(1,n),
uni = runif(n,x,y),
gamma = rgamma(n,shape=x,scale=y),
exp = rexp(n,x)
)
}
FileLIFO <- function(n,lambda,typeservice,x,y,policy) {
# simulates a M/GI/1 LIFO queue with different preemption policy
# parameters:
# n : total number of jobs
# lambda : arrival rate
# typeservice : service law (det uni gamma exp)
# x ,y : parameters of the service law
# policy: npmtn, pmtn, pmtn_restart, pmtn_reset
# return value:
# vector with response time of each task assuming the queue is initially empty
A <- rexp(n,lambda) # inter arrival
t1 <- cumsum(A) # arrival dates
t2 <- rep(NA,n) # completion dates
S <- Service(n,typeservice,x,y) # initial service times
#### Variables that define the state of the queue
t = 0 # current time
remaining = rep(NA,n) # how much work remains to do for each task
running = NA # index of the currently running task
waiting = c() # stack with tasks which have arrived and have not been completed yet
next_arrival = 1 # index of the next task to arrive
#### A few useful local functions
run_task = function() { # runs the last task of the waiting list
if(length(waiting)>0) {
running <<- waiting[length(waiting)]
remaining[running] <<- switch(policy,
npmtn = S[running],
pmtn = min(S[running],remaining[running],na.rm=T),
pmtn_restart = S[running],
pmtn_reset = Service(1,typeservice,x,y)
)
waiting <<- waiting[-length(waiting)]
}
}
push_task = function() { # insert the next_arrival-th task to the waiting list
# and run it if there is preemption
if(policy != "npmtn") {
if(!is.na(running)) {waiting <<- c(waiting,running)}
running <<- NA
}
waiting <<- c(waiting,next_arrival)
next_arrival <<- next_arrival+1
if(is.na(running)) { run_task() }
}
#### Main simulation loop
while(TRUE) {
# Look for next event
dt = NA
if(next_arrival <=n) { dt = min(dt,(t1[next_arrival]-t), na.rm=T) }
if(!is.na(running)) { dt = min(dt,remaining[running], na.rm=T) }
if(is.na(dt)) { break }
# Update state
t=t+dt
if(!is.na(running)) {
remaining[running] = remaining[running] - dt
if(remaining[running]<=0) {
t2[running] = t
running = NA
run_task()
}
}
if((next_arrival<=n) & (t==t1[next_arrival])) {
push_task()
}
}
t1
t2
# Une itération sur ce que l'on vient de calculer pour calculer l'évolution de la
# taille de la file d'attente au cours du temps.
t1[n+1] = t2[n]+1; # Un hack pour sortir de ma boucle
date = rep.int(0,2*n); # À initialiser absolument (performance + nom déjà utilisé) !
count = rep.int(0,2*n);
i1 = i2 = 1;
while(i1<=n & i2<=n) {
if(t1[i1]<t2[i2]) {
date[i1+i2] <- t1[i1];
count[i1+i2]<- count[i1+i2-1]+1;
i1 <- i1+1;
} else {
date[i1+i2] <- t2[i2];
count[i1+i2]<- count[i1+i2-1]-1;
i2 <- i2+1;
}
}
# Une deuxième itération pour avoir l'évolution du travail au cours du temps.
datework = rep.int(0,2*n);
work =rep.int(0,2*n);
i1 = i2 = 1;
while(i1<=n & i2 <=n) {
if(t1[i1]<t2[i2]) {
i = 2*(i1+i2-1);
datework[i] <- t1[i1];
if(work[i-1]>0) {
work[i] <- work[i-1] - (datework[i]-datework[i-1])
} else {
work[i] <- 0
}
if(work[i]<1e-15) { work[i]<-0 } # Fix floating point precision issue :(
datework[i+1] <- datework[i];
work[i+1] <- work[i] + S[i1];
i1 <- i1+1;
} else {
i = 2*(i1+i2-1);
datework[i] <- t2[i2];
work[i] <- work[i-1] - (datework[i]-datework[i-1]);
datework[i+1] <- datework[i];
work[i+1] <- work[i];
i2 <- i2+1;
}
}
df=data.frame(arrival=t1[1:n],completion=t2,service=S, response=t2 - t1[1:n])
#rajoutons à la sortie, l'écart-type du temps de service...
list(jobs=df, events = data.frame(date=date,count=count,lambda=lambda,label = policy),
workevolution = data.frame(date=datework,work=work,lambda=lambda,label = policy))
#t2 - t1
}Question 1 : Différences de nature entre les lois de service
Plan d’expérience
Nous allons comparer l’impact des différentes lois de services (det, unif, exp et gamma) sur le temps de reponses.
Ainsi, pour chacune des lois concernée et pour des valeurs de ( ) de 0.2 à 0.8 avec un pas de 0.2 on estime le temps de réponse moyen des clients sur des échantillons de taille ( N=10000 ).
Dans cette première question, nous comparons ces différentes lois suivant la même politique de services : non-préemtive
Gen_Experiment_By_LAW <- function(n, lambda_min, lambda_max, step, typeservice, x, y, policy) {
d <- data.frame()
for (lambda in seq(lambda_min, lambda_max, step)) {
response = FileLIFO(n, lambda, typeservice, x, y,policy)
d = rbind(d, data.frame(n = n, lambda = lambda, response = mean(response$jobs$response),
sd = sd(response$jobs$response), sd_S = mean(response$jobs$response)))
}
d$input_type = typeservice
d$input_p1 = x
d$input_p2 = y
d$label = as.factor(paste(typeservice, "(", x, ",", y, ")", sep = ""))
d
}
Gen_All_LAW_Experiments <- function(sample_size = 10000,lambda_min=0.2, lambda_max=0.8, step=0.2) {
resp_det <- Gen_Experiment_By_LAW(sample_size, lambda_min, lambda_max, step, "det", 0, 0,"npmtn")
resp_unif<- Gen_Experiment_By_LAW(sample_size, lambda_min, lambda_max, step, "uni", 0, 2,"npmtn")
resp_exp <- Gen_Experiment_By_LAW(sample_size, lambda_min, lambda_max, step, "exp", 1, 0,"npmtn")
resp_gamma <- Gen_Experiment_By_LAW(sample_size, lambda_min, lambda_max, step, "gamma", 4, 1/4,"npmtn")
rbind(resp_exp, resp_det,resp_unif, resp_gamma)
}
All_LAW_Experiments <- Gen_All_LAW_Experiments(sample_size = 10000,lambda_min=0.2, lambda_max=0.8, step=0.2)Analyse
Le graphique ci dessous nous montre comment évoluent le temps de réponse en fonction du taux d’arrivée et de la loi du temps de service:
ggplot(All_LAW_Experiments, scale = 0.5, aes(x = lambda, y = response, color = label, shape = label)) + geom_line() +
geom_point() + geom_errorbar(width = 0.02, aes(x=lambda, y=response,
ymin = response - 2 * sd/sqrt(n), ymax = response + 2 * sd/sqrt(n))) + geom_vline(xintercept = 1) +
geom_hline(yintercept = 1) + theme_bw() + xlab("Taux d'arrivés des clients") +
ylab("Temps de réponse") + ggtitle("Evolution du temps de response dans une file M/M/1 non préemptive")
Le premier constat est que l’intervalle de confiance s’agrandit avec le taux des arrivées.
Pour les taux d’arrivées faibles des temps de réponses très proches.
AVec la politique LIFO, la loi expontielle génère les plus longs temps de réponses. La loi déterministe qui est peu réaliste génère les meilleurs temps de réponses.
Question 2 : Etude détaillée de la file d’attente
Plan d’expérience
Nous allons comparer l’impact des différentes politiques (npmtn, pmtn, pmtn_restart et pmtn_reset) sur le temps de reponses.
Pour une étude plus complete, il aurrai été judicieux comparer ces politiques pour chacune des lois spécifiés en entrée.
Mais nous pensons que si nous limitons cette étude à une seule loi, nous aurons malgré tout une tendance proche de la réalité. Pour celas nous allonns mener notre étude détaillés univique avec des temps générés suivants la loi exponentielle
Ainsi, pour chacune des politique concernée et pour des valeurs de ( ) de 0.2 à 0.8 avec un pas de 0.2 on estime le temps de réponse moyen des clients sur des échantillons de taille ( N=10000 ).
Gen_Experiment_By_Policy <- function(n, lambda_min, lambda_max, step, typeservice, x, y, policy) {
d <- data.frame()
for (lambda in seq(lambda_min, lambda_max, step)) {
response = FileLIFO(n, lambda, typeservice, x, y,policy)
d = rbind(d, data.frame(n = n, lambda = lambda, response = mean(response$jobs$response),
sd = sd(response$jobs$response), sd_S = mean(response$jobs$response)))
}
d$input_type = typeservice
d$input_p1 = x
d$input_p2 = y
d$label = policy
d
}
Gen_All_Policies_Experiments <- function(sample_size = 10000,lambda_min=0.2, lambda_max=0.8, step=0.2,x, y=0, policy="exp") {
resp_npmtn <- Gen_Experiment_By_Policy(sample_size, lambda_min, lambda_max, step, policy, x, y,"npmtn")
resp_pmtn <- Gen_Experiment_By_Policy(sample_size, lambda_min, lambda_max, step, policy, x, y,"pmtn")
resp_pmtn_restart <- Gen_Experiment_By_Policy(sample_size, lambda_min, lambda_max, step, policy, x, y,"pmtn_restart")
resp_pmtn_reset <- Gen_Experiment_By_Policy(sample_size, lambda_min, lambda_max, step, policy, x, y,"pmtn_reset")
rbind(resp_npmtn, resp_pmtn,resp_pmtn_restart, resp_pmtn_reset)
}
All_Policies_Experiments_Exp <- Gen_All_Policies_Experiments(policy="exp",x=1/5)
All_Policies_Experiments_Gamma <- Gen_All_Policies_Experiments(policy="gamma",x=4, y=1/4)Analyse
Le graphique ci dessous nous montre comment évoluent le temps de réponse en fonction du taux d’arrivée pour chacune des politiques de service lorsque celle ci suit une loi exponentielle:
ggplot(All_Policies_Experiments_Exp, scale = 0.5, aes(x = lambda, y = response, color = label, shape = label)) + geom_line() +
geom_point() + geom_errorbar(width = 0.02, aes(x=lambda, y=response,
ymin = response - 2 * sd/sqrt(n), ymax = response + 2 * sd/sqrt(n))) + geom_vline(xintercept = 1) +
geom_hline(yintercept = 1) + theme_bw() + xlab("Taux d'arrivés des clients") +
ylab("Temps de réponse") + ggtitle("Evolution du temps de response dans une file M/M/1 (Loi Exp)")
Le graphique ci dessous nous montre comment évoluent le temps de réponse en fonction du taux d’arrivée pour chacune des politiques de service lorsque celle ci suit une loi gamma:
ggplot(All_Policies_Experiments_Gamma, scale = 0.5, aes(x = lambda, y = response, color = label, shape = label)) + geom_line() +
geom_point() + geom_errorbar(width = 0.02, aes(x=lambda, y=response,
ymin = response - 2 * sd/sqrt(n), ymax = response + 2 * sd/sqrt(n))) + geom_vline(xintercept = 1) +
geom_hline(yintercept = 1) + theme_bw() + xlab("Taux d'arrivés des clients") +
ylab("Temps de réponse") + ggtitle("Evolution du temps de response dans une file M/M/1 (Loi Gamma)")
Stabilité du système, performances, etc
Malgré la stabilité des intervalles de confiances, nous constatons une forte augmentation du temps de réponse lorsque le taux d’arrivé croit légèrement. Les politiques LIFO dans l’ensemble ne donnerons visiblement pas de systèmes stable.
Pour avoir une idée plus nette de l’instabilité du système, un tracé des courbes des évolutions du nombre de client en attentes et la courbes des évolutions des travail permettrait d’avoir une idéé plus précise de cette stabilité.
on regardait la taille de la file.
Gen_Work_Queue_Length <- function(n, lambda_min=0.2, lambda_max=0.8, step=0.2, typeservice="exp", x, y) {
d <- data.frame()
for (lambda in seq(lambda_min, lambda_max, step)) {
Qnpmtn = FileLIFO(n, lambda, typeservice, x, y,"npmtn")
Qpmtn = FileLIFO(n, lambda, typeservice, x, y,"pmtn")
Qpmtn_restart = FileLIFO(n, lambda, typeservice, x, y,"pmtn_restart")
Qpmtn_reset = FileLIFO(n, lambda, typeservice, x, y,"pmtn_reset")
d=rbind(d, rbind(Qnpmtn$events, Qpmtn$events,Qpmtn_restart$events, Qpmtn_reset$events))
}
d
}
df<-Gen_Work_Queue_Length(n=1000, lambda_min=0.2, lambda_max=1.6, step=0.4, typeservice="exp",1,0)
flen <- ggplot(data=df) + geom_step(aes(x=date,y=count,color=label)) +
xlab("Date") +
ylab("Taille file") + facet_grid(lambda~.)
ggtitle("Evolution de la taille de la file en LIFO M/M/1")## $title
## [1] "Evolution de la taille de la file en LIFO M/M/1"
##
## attr(,"class")
## [1] "labels"flen
Conclusion
Comme on le sentais déjà intuitivement,au fur et a mesure que le taux d’arrivé crois le système peut devenir totalement instable. Sur l’ensemble des loi, la politique de restart et de reset sont les plus mauvaise. Les deux autres politiques sont préférables.