Q1 : Politique SRPT (Shortest Remaining Processing Time First)

Vous modifierez le code précédent pour étudier les performances d’une file implémentant la politique SRPT (Shortest Remaining Processing Time First), c’est à dire qui exécute en priorité la tâche pour laquelle il reste le moins de travail à effectuer. Comme pour la politique LIFO, il existe plusieurs variantes à cette politique:

-SRPT_pmtn: qui s’assure qu’à chaque instant, elle traite la tâche pour la quelle il reste le moins de travail à effectuer. En conséquence, elle s’interromps à chaque fois qu’une nouvelle tâche arrive dans le système et éventuellement sélectionne cette tâche si son temps de service (sa quantité de travail) est plus petite que la quantité de travail restant de la tâche en cours d’exécution.

-SPT_pmtn: fonctionne comme la précédente mais base sa décision d’ordonnancement sur le temps de service de la tâche et pas sur la quantité de travail restant.

-SPT: fait la même chose que les précédentes mais ne s’interromps pas quand une nouvelle tâche entre dans le système. Cette stratégie non préemptive revient donc à exécuter systématiquement (et d’une seule traite) la tâche dont le temps de service est le plus petit au moment de la décision d’ordonnancement.

set.seed(10)
library(plyr)
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)
         )
}
SRPT <- function(n,lambda,typeservice,x,y,policy,ServTime) {
    # 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 <- ServTime# 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
       tab<-c()
       nbWaiting=length(waiting)
      if(nbWaiting>0) {
        if (policy=="spt_pmtn"|| policy=="spt"){ # Ces deux politiques se base sur la même chose : le temps de service (le plus petit)
          for (i in 1:nbWaiting){
            tab<-c(tab,S[waiting[i]]) #concaténe tab et le temps de service du iéme tache en attente 
          }
          running<<-waiting[which.min(tab)] #récupére la plus petit tache (en temps de service)
        }
        if (policy=="srpt_pmtn"){ #Dans le cas de SRPT préemptif, il faut se baser sur le temps de travail restant
          for (i in 1:nbWaiting){
            tab<-c(tab,min(S[waiting[i]],remaining[waiting[i]],na.rm=TRUE)) # min entre le temps de service et le temps travail restant 
          }
          running<<-waiting[which.min(tab)]
        }
        remaining[running] <<- switch(policy,
                                      srpt_pmtn = min(S[running],remaining[running],na.rm=T),
                                      spt = S[running],
                                      spt_pmtn = min(S[running],remaining[running],na.rm=T)
                                      )
        waiting <<- waiting[-(which.min(tab))]
      }
       
      }
    

    push_task = function() { # insert the next_arrival-th task to the waiting list
                             # and run it if there is preemption
   if(policy != "spt") { 
        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()
      }
    }
    
     df <- data.frame(N=n,TEMPS = (t2 - t1),ID=c(1:n), S=S,LAMBDA = lambda, LOI = typeservice, POLICY = policy, LABEL = as.factor(paste(typeservice, "(", x, ",", y, ")", sep = "")))
   return (df)
}

Q2 : Evaluation des stratégies et comparaison avec Fifo

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.

FileFIFO <- function(n,lambda,typeservice,x,y,ServTime) {
    # genere une trajectoire de temps de reponse pour une file M/GI/1 FIFO
    # parametres :
    #    n :  taille de la trajectoire
    #    lambda : debit d'arrivee
    #    typeservice : type de service (det uni gamma exp)
    #    x ,y : parametres de la loi de service
    #    ServTime : vecteur de temps de service
    # valeur de retour :
    #    vecteur de n valeurs successives du temps de
    #    réponse dans une M/GI/1 FIFO initialement vide
    
    # generation des arrivees et des temps de service
    A <- rexp(n,lambda)
    t1 <- cumsum(A)
    S <- ServTime
    
    # initialisation des structures (pour éviter une allocation dynamique et gagner du temps)
    t2 <- seq(0,0,length.out=n)

    # Par curiosité comptons également le nombre de fois où le système se vide
    sys_vide = 1
    
    # initialisation du premier terme
    t2[1] <- t1[1]+ S[1]
    
    # calcul de la trajectoire equation de recurrence de Lindley
    for (i in 2:n) {
        t2[i] <- S[i] + max(t1[i], t2[i-1])
        if(t1[i]>t2[i-1]) {
          sys_vide = sys_vide + 1
        }
    }
        
    df <- data.frame(N=n,TEMPS = (t2 - t1), ID=c(1:n) ,S=S, LAMBDA = lambda, LOI = typeservice, POLICY = "fifo", LABEL = as.factor(paste(typeservice, "(", x, ",", y, ")", sep = "")))
   return (df)
   }
#data frame resultat aux différent appel a SRPT
r <- data.frame()

#définition du temps de service pour l'ensemble des politiques
ServTime=Service(n=20000,"exp",1,0) 


#lambda à tester.
lambda_values = c(0.01,.15,.25,.35,.45,.55,.65,.75,.85)

# Loi exponentielle, FIFO.
for (i in lambda_values) {
    r <- rbind(r, FileFIFO(n=20000, i,"exp",1,0,ServTime))
}


# Loi exponentielle, mode non préemptif en fonction du temps de service .
for (i in lambda_values) {
    r <- rbind(r, SRPT(n=20000, i,"exp",1,0, policy="spt_pmtn",ServTime))
}

# Loi exponentielle, mode non préemptif.
for (i in lambda_values) {
    r <- rbind(r, SRPT(n=20000, i,"exp",1,0, policy="spt",ServTime))
}

# Loi exponentielle, mode préemptif en fonction de remaining restant.
for (i in lambda_values){
    r <- rbind(r, SRPT(n=20000, i,"exp",1,0, policy="srpt_pmtn",ServTime))
}





rf <- ddply(r, c("LAMBDA", "POLICY"), summarize, TempsMoyen = mean(TEMPS), 
    vari = var(TEMPS),ecart = 2*sd(TEMPS)/sqrt(length(TEMPS)))

ggplot(rf, aes(x = LAMBDA, y = TempsMoyen , ymin = TempsMoyen - ecart, ymax = TempsMoyen + ecart, color =POLICY)) + geom_point() +  geom_line()+geom_errorbar() + geom_vline(xintercept = 1)+geom_vline(yintercept = 0) + xlab("Lambda") + ylab("Temps de service moyen ") +labs(name = "Type :", colour = " Type :")

plot of chunk unnamed-chunk-4

Aprés cette simulation, on peut tout d’abord remarquer que la courbe rouge (FIFO) a son temps de service moyen toujours au autres (SRPT)

La politique SPT commence à augmenter avant les autres politiques. la politique SRPT_pmtn est un peu plus faible au niveau du temps de service moyen car on se base sur le temps de travail restant.

Q3 : Etude de la distribution du temps de réponse

Vous étudierez également la distribution du temps de réponse et en particulier les valeurs extrêmes comme le temps de réponse maximum).

On va etudier le temps de traitement et le temps de service

Avec FileFifo :

r <- data.frame()
lambda_values = c(0.01,.15,.25,.35,.45,.55,.65,.75,.85)
TimeServ=Service(n=150,"exp",1,0) 

for (i in lambda_values){
    r <- FileFIFO(n=150, i,"exp",1,0,TimeServ)
}
ggplot(r) +
  geom_bar(aes(x = factor(ID), y = TEMPS),stat="identity", position="identity",fill="blue") + 
  geom_bar(aes(x = factor(ID), y = S),stat="identity", position="identity",fill="yellow") + 
  xlab("job ID") + 
  ylab("duréé")  +
  ggtitle("temps de service et traitement avec FIFO")

plot of chunk unnamed-chunk-5

Avec spt_pmtn :

r <- data.frame()


TimeServ=Service(n=150,"exp",1,0) 



lambda_values = c(0.01,.15,.25,.35,.45,.55,.65,.75,.85)

for (i in lambda_values) {
    r <- SRPT(n=150, i,"exp",1,0, policy="spt_pmtn",TimeServ)
}

ggplot(r) +
  geom_bar(aes(x = factor(ID), y = TEMPS),stat="identity", position="identity",fill="blue") + 
  geom_bar(aes(x = factor(ID), y = S),stat="identity", position="identity",fill="yellow",alpha=.8) + 
  xlab("job ID") + 
  ylab("durée")  +
  ggtitle("temps de service et traitement avec SPT_pmtn")

plot of chunk unnamed-chunk-6

Avec SRPT_PMTN :

r <- data.frame()

TimeServ=Service(n=150,"exp",1,0) 

lambda_values = c(0.01,.15,.25,.35,.45,.55,.65,.75,.85)

for (i in lambda_values) {
    r <- SRPT(n=150, i,"exp",1,0, policy="srpt_pmtn",TimeServ)
}

ggplot(r) +
  geom_bar(aes(x = factor(ID), y = TEMPS),stat="identity", position="identity",fill="blue") + 
  geom_bar(aes(x = factor(ID), y = S),stat="identity", position="identity",fill="yellow",alpha=.8) + 
  xlab("job ID") + 
  ylab("durée")  +
  ggtitle("temps de service et traitement avec SRPT_PMTN")

plot of chunk unnamed-chunk-7

avec SPT :

r <- data.frame()

TimeServ=Service(n=150,"exp",1,0) 

lambda_values = c(0.01,.15,.25,.35,.45,.55,.65,.75,.85)

for (i in lambda_values) {
    r <- SRPT(n=150, i,"exp",1,0, policy="spt",TimeServ)
}

ggplot(r) +
  geom_bar(aes(x = factor(ID), y = TEMPS),stat="identity", position="identity",fill="blue") + 
  geom_bar(aes(x = factor(ID), y = S),stat="identity", position="identity",fill="yellow",alpha=.8) + 
  xlab("job ID") + 
  ylab("durée")  +
  ggtitle("temps de service et traitement avec SPT")

plot of chunk unnamed-chunk-8

En bleu, c’est le temps de service et en jaune c’est le temps de traitement (t2-t1) On remarque que le temps de service n’affecte pas le temps de traitement pour FIFO Par contre pour les 3 autres politiques, le temps de traitement est affecté par le temps de service car cette politique est basé dessus.