set.seed(10)
library(plyr)
library(ggplot2)
library(reshape)
##
## Attaching package: 'reshape'
##
## The following objects are masked from 'package:plyr':
##
## rename, round_any
library(gridExtra)
## Loading required package: grid
# 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=80,lambda=0.5,typeservice=0.6,x,y,policy="SPT") {
# simulates a M/GI/1 srpt 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: SRPT_pmtn, SPT_pmtn, SPT
# 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<-rexp(n,typeservice)
# S <- Service(n,typeservice,x,y) # initial service times
#### Variables that define the state of the queue
t = 0 # time node of each event ocurring
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
select_task=function(temp=rep(0,n)){#choose a task appropriate to run
running<<-switch(policy,
SRPT_pmtn=waiting[which.min(remaining)],#choose the shortest executing time
SPT_pmtn=waiting[which.min(temp)],
SPT=waiting[which.min(remaining)]
)
}
#### A few useful local functions
run_task = function() { # runs the last task of the waiting list
if(length(waiting)>0) {
temp <- remaining
if(policy == "SRPT_pmtn" & !is.na(running)){
temp[running]<-S[running] #Replacing the current running member with its original service value
temp[waiting(length(waiting))] <- S[waiting(length(waiting))] #add the new arrival into the temporary queue
}
if(!is.na(running) & policy != "SPT"){
running <<- select_task(temp)
}else if(is.na(running) & policy != "SPT"){
running<<-waiting[length(waiting)]
}else if(is.na(running)){
running <<- select_task(temp)
}
if(is.na(running)){
running<<-waiting[length(waiting)]
}
remaining[running]<<-min(S[running],remaining[running],na.rm=T) #always the shortest
if(policy != "SPT"){
waiting <<- waiting[-length(waiting)]
}
}
}
#in fact, when this function is called, that means the next arrival will arrive before the current job finish, so we consider just one possibility in this case that mean that we should insert this job in the propriate place in the waiting queue and switch the handler if necessairy for SRPT_pmtn
push_task = function() { # insert the next_arrival-th task to the waiting list
# and run it
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) }#temps passé pour la tâche courante
if(!is.na(running)) { dt = min(dt,remaining[running], na.rm=T) }# ici dt contains the shortest time between the inter_arrival and the remaining time of current job at the coming point of next arrival
if(is.na(dt)) { break }
# Update state
t=t+dt #t indicates the ocurring time of an event i.e a new client arrives
if(!is.na(running)) {
remaining[running] = remaining[running] - dt #piece of time left for current job potentially interrupted by the new arrival
if(remaining[running]<=0) { #if the next job arrives after the end of current job
t2[running]<- t #then current job finished as it planed to
running = NA #current job indice reset to null
run_task() #finish this task
if( policy == "SPT"){
waiting <- waiting[-match(x=running,waiting)] #we remove the one who just finished
}
}
}
if((next_arrival<=n) & (t==t1[next_arrival])) { #else we jump to the point when the next event happens i.e we talk about the next arrival because it'll arrive before the current finishes
push_task() #so we have tp push it into the waiting queue
}
}
t2-t1
}
Q2 Vous évaluerez les performances (en terme de temps de réponse moyen) de ces différentes stratégies et les comparerez à celle de la politique FIFO.
dc1<-FileSRPT(n=80,lambda=0.5,typeservice=0.6,policy="SRPT_pmtn")
dc2<-FileSRPT(n=80,lambda=0.5,typeservice=0.6,policy="SPT_pmtn")
# plot(dc2)
# dc3<-FileSRPT(n=80,lambda=0.5,typeservice=0.6,policy="SPT")
# plot(dc3)
#
dd1<-data.frame(SRPT_pmtn=dc1,SPT_pmtn=dc2) #,SPT=dc3
dd1$id=1:length(dd1$SRPT_pmtn)
d <- melt(dd1,id=c("id"))
ggplot(data=d[d$variable %in% c("SRPT_pmtn","SPT_pmtn"),],
aes(x=id,y=value, color=variable)) +
geom_line(size=1) + scale_color_brewer(palette="Set1") + xlab("Job Id") +
ylab("Response Time") +
ggtitle("Response time for debit: 0.5")
sprintf("Average response time for SRPT_pmtn is %s",round(mean(dc1),digit=3))
## [1] "Average response time for SRPT_pmtn is 4.786"
sprintf("Average response time for SRP_pmtn is %s",round(mean(dc2),digits=3))
## [1] "Average response time for SRP_pmtn is 4.531"
# sprintf("Average response time for SPT is %s",round(mean(dc3,na.rm =T),digits=3))
On n’a pas arrivé à réaliser le SPT car il nous manque toujours des valeurs dedant. Mais en comparant les trois graphes et les moyens, on peut bien constater que les performances de chacun est de SPT > SRPTpmtn > SRPpntn.
Q3 Vous étudierez également la distribution du temps de réponse et en particulier les valeurs extrêmes comme le temps de réponse maximum).
dc1<-FileSRPT(n=1000,lambda=0.5,typeservice=0.6,policy="SRPT_pmtn")
dc2<-FileSRPT(n=1000,lambda=0.5,typeservice=0.6,policy="SPT_pmtn")
# plot(dc2)
# dc3<-FileSRPT(n=1000,lambda=0.5,typeservice=0.6,policy="SPT")
sprintf("Maximun response time for SRPT_pmtn is %s, dont la variance: %s",round(max(dc1),digits=3),round(var(dc1),digits=3))
## [1] "Maximun response time for SRPT_pmtn is 118.425, dont la variance: 312.884"
sprintf("Maximun response time for SRP_pmtn is %s, dont la variance: %s",round(max(dc2),digits=3),round(var(dc2),digits=3))
## [1] "Maximun response time for SRP_pmtn is 220.391, dont la variance: 554.285"
# sprintf("Maximun response time for SPT is %s, dont la variance: %s",round(max(dc3,na.rm=T),digits=3),round(var(dc3,na.rm=T),digits=3))
En evaluant les trois max de ces lois différentes, on voit que SRPTpmtn se varie plus brutalement que SRPTpmtn celui que SPT. En fait la toisième est meilleur car de toute façon, un job en train d’exécution peut toujours finir son boulot quelque soit un nouveau job arrive. Cepandant, un job qui a une durée d’exécution plus longue que les autres qui arrivent pendant l’exécution d’un job peux être poussé arrière. SRP_pmtn garanti toujours ceux qui arrive avec une durée d’exécution plus légère donc un job qui vient de démarrer peut être poussé tout derrière jusqu’a la fin. SRPpmtn est un peux mieux que la première car lorsqu’un job est démarré, il a une probabilité plus importante d’avoir une durée retante que les nouvaux arrivals, donc un job qui a démarré puisse finir son exécution avec une durée plus courte que le cas précedant.