Le but de cet exercice est étudier les politiques d’ordonancements basé sur les temps restant : SRPT (Shortest Remaining Processing Time First). Ce exercices Comporte trois parties : 1. Completer le code de simulation fournies lors du DM N° 1 sur les politiques LIFO, pour obenir le code de simulation SRPT . 2. Evaluer les performances de ces différentes politiques 3. Evaluer la distibution du temps de réponses de ces différentes politiques
Pour produire ce nouveau code nous, nous avons dû y apporter les modifications suivantes :
Modification du mécanisme de muppression du processus élu de la waiting list
Modification de l’algorithme de sélection de la technique d’insertion d’une nouvel tâche dans la waiting list
Ce qui nous permet au final d’avoir le code ci dessous :
set.seed(26)
library(plyr)
## Warning: package 'plyr' was built under R version 3.1.2
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 3.1.2
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)
)
}
FileSRPT <- 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
# ERIC MICHEL FOTSING : Initilisation de remaining work to do avec les temps de services # how much work remains to do for each task
remaining = S
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) {
# ERIC MICHEL FOTSING : Election du nouveau processus à éxécuter
running <<- switch(policy,
srpt_pmtn = waiting[which.min(remaining[waiting])],
spt_pmtn = waiting[which.min(S[waiting])],
spt = waiting[which.min(S[waiting])],
fifo = waiting[1]
)
# ERIC MICHEL FOTSING : Mise à jour du remaining time caclqué sur le code de base
remaining[running] <<- switch(policy,
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]
)
# ERIC MICHEL FOTSING : Suppression du processus élu de la waiting list
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
# ERIC MICHEL FOTSING : Préemtion du processeur uniquement si policy=srpt_pmtn ou policy=spt_pmtn
if(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()
}
}
# 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;
}
}
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=paste("lamda:",lambda),label = policy))
}
Nous allons comparer l’impact des différentes politiques (srpt_pmtn, spt_pmtn, spt et fifo) 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 ).
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)")
Malgré la stabilité des intervalles de confiances, nous constatons une forte augmentation du temps de réponse lorsque le taux d’arrivé croit. Comparé aux politiques SRPT qui donnent des performances assez proches, la politique FIFO donne comme vous pouvez le constater des temps de réponses assez grands
Le graphique ci dessous donne une idée de l’évolution de la taille de la file d’attende selon les différentes politiques
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)) {
Qsrpt_pmtn= FileSRPT(n, lambda, typeservice, x, y,"srpt_pmtn")
Qspt_pmtn = FileSRPT(n, lambda, typeservice, x, y,"spt_pmtn")
Qspt = FileSRPT(n, lambda, typeservice, x, y,"spt")
Qfifo = FileSRPT(n, lambda, typeservice, x, y,"fifo")
d=rbind(d, rbind(Qsrpt_pmtn$events, Qspt_pmtn$events,Qspt$events, Qfifo$events))
}
d
}
df<-Gen_Work_Queue_Length(n=10000, lambda_min=0.2, lambda_max=0.8, step=0.2, typeservice="exp",1/5,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
Nous constatons u travers de ces expérimentations que les lois dites SRPT offre de meilleurs performances que la loi fifo. Dans les politiques SRPT, la politique SPT (sans préemption) est celle qui donne des performances légérèment supérieures
A la question 1, nous avons constitué un dataframe comportant les différentes valeur pour mener à bien la comparairons des temps de réponses extrêmes. il fait donc, juste réprésenter ces valeurs extrêmes sur un graphique:
ggplot(All_Policies_Experiments_Exp, scale = 0.5, aes(x = lambda, y=response_max, color = label, shape = label)) + geom_line() +
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)")
L’étude des valeurs extrêmes, nous permet de constater avec beaucoup de surprise que la loi fifo étale mieux le temps de réponse maximum que les autres politiques dites SRPT. Même si nous avons constaté à la question précédente que les politiques SRPT offraient de meilleurs performances au niveau global.