DM2 - Évaluation de Performances
Luc Libralesso - Olivier Soldano
26 mars 2015
Question 1. Code du simulateur
On reprend le simulateur du DM1 en ajoutant les modifications nécessaires. Celles-ci sont expliquées par des commentaires dans le code.
set.seed(42)
library(plyr)
library(ggplot2)
Service <- function(n=1,typeservice,x,y) {
# genere un temps de service
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
# data frame with values :
# - inter : interarrival time
# - arr : arrival date
# - dep : leave time
# - serv : service time
# - tps : time spent in the system
# - att : tps-serv (ideally 0 for each value)
####### HACK #######
drop <- 200
n <- n+drop
####################
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
# MODIF : WE ASSIGN INITIALLY REMAINING TO S
remaining = S
##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) {
# MODIF : IF FIFO, WE GET THE FIRST INSTEAD OF THE LAST ELEMENT
if ( policy == 'fifo' )
running <<- waiting[1]
# MODIF : IF WE HAVE S(R)?PT PMTN
else if ( policy == 'srpt_pmtn')
running <<- waiting[which.min(remaining[waiting])]
else if ( policy == 'spt_pmtn')
running <<- waiting[which.min(S[waiting])]
else if ( policy == 'spt')
running <<- waiting[which.min(S[waiting])]
else
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),
# MODIF : ADD SPT policies
srpt_pmtn = min(S[running],remaining[running],na.rm=T),
spt_pmtn = min(S[running],remaining[running],na.rm=T),
spt = S[running],
fifo = S[running]
)
# MODIF : DELETE RUNNING ELEMENT
## waiting <<- waiting[-length(waiting)]
waiting <<- waiting[-which(waiting == running)]
}
}
push_task = function() { # insert the next_arrival-th task to the waiting list
# and run it if there is preemption
if(policy != "npmtn" && policy != "spt" && policy != "fifo" ) {
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()
}
}
# modifs : on retourne l'information d'arrivée, de départ
# t2-t1
res <- data.frame()
###### HACK #######
#for ( i in 1:n ){
for ( i in drop:n ){
###################
#res=rbind(res,c(A[i], t1[i],t2[i],S[i], t2[i]-t1[i], t2[i]-t1[i]-S[i]))
res=rbind(res, t2[i]-t1[i])
}
#colnames(res)<-c("inter", "arr","dep", "serv", "tps", "att")
colnames(res)<-c("tps")
return(res)
} test du simulateur
FileLIFO(5,0.4,'det',0,0,'srpt_pmtn')## tps
## 1 1.000000
## 2 1.000000
## 3 1.675889
## 4 2.054829
## 5 1.942783
## 6 1.689103FileLIFO(5,0.4,'det',0,0,'spt_pmtn')## tps
## 1 2.352825
## 2 2.408450
## 3 3.567853
## 4 1.000000
## 5 1.000000
## 6 1.000000FileLIFO(5,0.4,'det',0,0,'spt')## tps
## 1 1.931685
## 2 1.000000
## 3 1.000000
## 4 1.000000
## 5 1.000000
## 6 1.704594Fifo :
FileLIFO(5,0.4,'det',0,0,'fifo')## tps
## 1 1.00000
## 2 1.09692
## 3 1.00000
## 4 1.00000
## 5 1.00000
## 6 1.00000Question 2. Évaluation du temps de réponse moyen
Reprenons le code pour générer les courbes de temps de réponse moyen du TP précédent :
N <- 2000
confidence <- 0.975Fonctions qui renvoient le résultat de la simulation :
cst <- function(n, lambda,x,y, policy){
res <- FileLIFO(n,lambda,"det",0,0,policy)
return(res["tps"])
}
uni <- function(n,lambda,x,y,policy){
res <- FileLIFO(n,lambda,"uni",x,y,policy)
return(res["tps"])
}
expo <- function(n,lambda,x,y,policy){
res <- FileLIFO(n,lambda,"exp",1,0,policy)
return(res["tps"])
}
gamma1 <- function(n,lambda,x,y,policy){
res <- FileLIFO(n,lambda,"gamma",2,0.5,policy)
return(res["tps"])
}
gamma2 <- function(n,lambda,x,y,policy){
res <- FileLIFO(n,lambda,"gamma",4,.25,policy)
return(res["tps"])
}Maintenant les fonctions de génération de données nécessaires à l’affichage :
generate_data_lambda <- function(f, n, lambda, x, y){
l <- c("srpt_pmtn","spt_pmtn","spt","fifo")
res <- f(n,lambda,x,y,l[1])
res$policy <- l[1]
l <- l[-1]
for ( i in l ){
tmp <- f(n,lambda,x,y,i)
tmp$policy<-i
res<-rbind(res,tmp)
}
res$lambda<-lambda
return(res)
}
generate_data <- function(f, n, x, y, lambdas=c(0.2, 0.4, 0.6, 0.8, 0.9)){
res <- generate_data_lambda(f,n,lambdas[1],x,y)
for ( i in lambdas[-1] )
res<-rbind(res,generate_data_lambda(f,n,i,x,y))
return(res)
}La fonction d’affichage :
draw_data <- function(data,n,log=F, title="temps passé dans le système"){
data <- ddply(data, c("lambda","policy"), summarise,
mean=mean(tps),
sd=sd(tps)
)
data$diff <- qnorm(confidence)*data$sd/sqrt(n)
# draw graphs
g <-ggplot(data, aes(x=lambda, y=mean, color=policy))+geom_line()
if ( log )
g <- g + scale_y_log10()
# draw confidence intervals
g <- g + geom_errorbar(width=0.01, aes(x=lambda, y=mean, ymin=mean-diff, ymax=mean+diff))
g <- g + ggtitle(title)
g
}Par la suite, nous nous intéresserons principalement à la loi exponentielle pour les temps de service car c’est celle qui a la variance la plus importante (voir TP précédent).
data <- generate_data(expo, N, 0, 2)
draw_data(data,N, log=F, title="temps moyen passé dans le système pour une loi de service exponentielle")
On remarque sur ce courbeque la courbe fifo est largement au-dessus des autres. Cela vient du fait qu’on s’intéresse au temps d’attente moyen dans la file. Or, lorsqu’on à une grande tâche qui est exécutée, plusieurs autres attendront, ce qui fera monter d’avantage le temps moyen passé dans la file tandis que si la tâche longue est mise en attente, toutes les autres tâches rapides à exécuter seront exécutées rapidement et feront d’avantage baisser la moyenne de temps d’attente dans la file.
Intuitivement, pour avoir un meilleur temps de réponse moyen, il faut faire passer à chaque évènement la tâche qui a le temps restant le moins important. Cela se confirme sur notre expérience car nous avons la politique srpt_pmtn qui à l’air d’être la plus efficace suivant le critère de temps moyen passé dans le système. Car à chaque évènement, elle applique cette méthode. On note que spt_pmtn regarde seulement le temps de service ce qui est une bonne apporoximation du temps restant, mais n’est pas parfait. Et spt n’est pas préemptive, donc elle s’éloigne encore d’avantage de ce principe car si une grosse tâche commence à s’exécuter et que plein de petites autres arrivent, le temps moyen sera moins bon qu’en préemptif.
Question 3. Distribution du temps de réponse
Intéressons nous au temps de réponse maximal :
Réalisons la nouvelle fonction d’affichage :
draw_data2 <- function(data,n,log=F, title="temps passé dans le système"){
data <- ddply(data, c("lambda","policy"), summarise,
maxi=max(tps),
sd=sd(tps)
)
data$diff <- qnorm(confidence)*data$sd/sqrt(n)
# draw graphs
g <-ggplot(data, aes(x=lambda, y=maxi, color=policy))+geom_line()
if ( log )
g <- g + scale_y_log10()
# draw confidence intervals
g <- g + geom_errorbar(width=0.01, aes(x=lambda, y=maxi, ymin=maxi-diff, ymax=maxi+diff))
g <- g + ggtitle(title)
g
}data <- generate_data(expo, N, 0, 2)
draw_data2(data,N, log=F, title="temps maxi passé dans le système pour une loi de service exponentielle")
Ici, on constate que la politique fifo possède la valeur maximale la plus faible parmi les politiques. Cela rejoint nos réflexions précédentes car la politique fifo ne met pas en attente de tâche parce qu’elle est longue à s’exécuter. Cela impacte la moyenne du temps d’attente, mais permet à chaque tâche d’être exécutée relativement rapidement.
distribution du temps de réponse
Représentons la distribution du temps de réponse par un nuage de points :
draw_data3 <- function(data,n,log=F, title="temps passé dans le système"){
# draw graphs
g <-ggplot(data, aes(x=lambda, y=tps))+geom_point(alpha=1/10, size=5)
if ( log )
g <- g + scale_y_log10()
g <- g + ggtitle(title)
g <- g + facet_grid(policy~.)
g
}data <- generate_data(expo, N, 0, 2)
draw_data3(data,N, log=F, title="temps passé dans le système pour une loi de service exponentielle")
On remarque la même chose qu’en ne gardant que le temps maxi passé dans la file. La politique fifo n’a que très peu de grands temps d’attente tandis que les autres en ont.
Conclusion
Dans ce DM, nous nous sommes intéressés à l’évaluation de performance de file FIFO et de files de type SPT. Nous notons que les files SPT ont un meilleur temps de réponse moyen, mais au sacrifice d’un temps d’attente beaucoup plus important pour certaines tâches (les grandes tâches).
Nous en concluons que le choix d’une telle politique repose sur un compromis : Préférons-nous traiter un maximum de tâches avec certaines qui ne seront potentiellement jamais traitées ou souhaitons nous garder une certaine équité en terme d’accès à la ressource ? Si nous préférons l’équité, nous opterons d’avantage pour une politique de type FIFO, sinon, nous opterons plutôt pour une politique de type SPT.