Implémentation de la politique SRPT (Shortest Remaining Processing Time First)

set.seed(10)
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
library(gridExtra)
## Warning: package 'gridExtra' was built under R version 3.1.2
## Loading required package: grid
                    # FONCTION DU TEMPS DE SERVICE
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)
         )
}

Question 1. Implémentation de la politique SRPT :

· Code pour la politique SRPT : 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. .

                #FONCTION IMPLEMENTANT LA POLITIQUE SRPT

FileSRPT <- function(n,lambda,typeservice,x,y,policy,Serv) {
    # 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: spt_pmtn, stp, srpt_pmtn
    #    Serv : Vector of service time
    # 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 <- Serv 
    
    #### 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
      r<-c()
      if(length(waiting)>0) {
        if (policy=="spt_pmtn"|| policy=="spt"){ # Dans le cas de ces deux politique, la décisions est prise uniquement du temps de SERVICE, on prend donc le plus petit temps de Service disponible dans le Waiting
          for (i in 1:length(waiting)){
            r<-c(r,S[waiting[i]])
          }
          running<<-waiting[which.min(r)]
        }
        if (policy=="srpt_pmtn"){ # Si nous sommes en SRPT préemptif alors nous nous basons sur le temps de travail restant(remaining).
          for (i in 1:length(waiting)){
            r<-c(r,min(S[waiting[i]],remaining[waiting[i]],na.rm=T))
          }
          running<<-waiting[which.min(r)]
        }
        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(r))]
      }
    }
   push_task = function() { # insert the next_arrival-th task to the waiting list
                             # and run it if there is preemption
      if(policy != "spt") { # Si non préemption on ne s'occupe pas de l'arrivé d'une new tache
        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)
   
    
}

Question 2. Comparons SRPT & 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,Serv) {
    # 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
    #    Serv : Vector with service time
    # 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 <- Serv
    
    # 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)
   }
#Création de la dataframe pour les résultats des appels de la fonction FileSRPT.
resulat <- data.frame()

#Création et définition du temps de service pour l'ensemble des politiques
tpsServ=Service(n=50000,"exp",1,0) 


#Création d'un vecteur contenant chaque valeur de lambda à tester.
lambda_values = c(0.01,0.09,.19,.29,.39,.49,.59,.69,.8)
i<-1
# Loi exponentielle, mode non préemptif en fonction du temps de service .
while (i<=length(lambda_values)) {
    resulat <- rbind(resulat, FileSRPT(n=50000, lambda_values[i],"exp",1,0, policy="spt_pmtn",tpsServ))
    i<-i+1
}
# Loi exponentielle, mode non préemptif.
i<-1
while (i<=length(lambda_values)) {
    resulat <- rbind(resulat, FileSRPT(n=50000, lambda_values[i],"exp",1,0, policy="spt",tpsServ))
    i<-i+1
}

# Loi exponentielle, mode préemptif en fonction de remaining restant.
i<-1
while (i<=length(lambda_values)) {
    resulat <- rbind(resulat, FileSRPT(n=50000, lambda_values[i],"exp",1,0, policy="srpt_pmtn",tpsServ))
    i<-i+1
}

# Loi exponentielle, FIFO.
i<-1
while (i<=length(lambda_values)) {
    resulat <- rbind(resulat, FileFIFO(n=50000, lambda_values[i],"exp",1,0,tpsServ))
    i<-i+1
}


# calcul final
resulat2 <- ddply(resulat, c("LAMBDA", "POLICY"), summarize, TempsMoyen = mean(TEMPS), 
    vari = var(TEMPS),ecart = 2*sd(TEMPS)/sqrt(length(TEMPS)))

# Tracer des différents type de services, avec une loi exponentielle, avec nos intervales de confiances.
ggplot(resulat2, 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 :")

Suite à cette expérience nous pouvons remarquer que le temps de service moyen pour la politique FIFO est toujours supérieur au temps de service moyen proposé par les politiques SRPT.

De plus, on peut voir une explosion du temps de service moyen pour la politique FIFO. Une augmentation forte est aussi constater pour la politique SPT c’est a dire celle qui n’est pas préemtive. Les deux politique SRPT préemtive se ressemble vraiment. Mais comme attendu la temps de service moyen de la SRPT_pmtn est le plus faible. Puisque nous nous basons sur le temps de travail restant et non pas sur le temps de service.

Question 3. Au niveau 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).

Essayons maintenant de voir l’influence du temps de Service généré sur le temps de traitement de la tache. Nous ne sommes pas arrivé à reformater les données, afin de pouvoir réaliser une légende correct.

Voici notre légende :

ROUGE : TEMPS DE SERVICE

BLEU : t2-t1 (temps traitement)

#Création de la dataframe pour les résultats des appels de la fonction FileSRPT.
resulat <- data.frame()

#Création et définition du temps de service pour l'ensemble des politiques
tpsServ=Service(n=100,"exp",1,0) 


#Création d'un vecteur contenant chaque valeur de lambda à tester.
lambda_values = c(0.01,0.09,.19,.29,.39,.49,.59,.69,.8)
i<-1
# Loi exponentielle, mode non préemptif en fonction du temps de service .
while (i<=length(lambda_values)) {
    resulat <- FileSRPT(n=100, lambda_values[i],"exp",1,0, policy="spt_pmtn",tpsServ)
    i<-i+1
}
p<-ggplot(resulat) +
  geom_bar(aes(x = factor(ID), y = TEMPS),stat="identity", position="identity",fill="red") + 
  geom_bar(aes(x = factor(ID), y = S),stat="identity", position="identity",fill="blue",alpha=.8) + 
  xlab("job ID") + 
  ylab("Duration")  +
  ggtitle("Response and service, SPT_PMTN")


mean(resulat$TEMPS)
## [1] 1.42126
resulat <- data.frame()

# Loi exponentielle, mode non préemptif.
i<-1
while (i<=length(lambda_values)) {
    resulat <- FileSRPT(n=100, lambda_values[i],"exp",1,0, policy="spt",tpsServ)
    i<-i+1
}
p1<-ggplot(resulat) +
  geom_bar(aes(x = factor(ID), y = TEMPS),stat="identity", position="identity",fill="red") + 
  geom_bar(aes(x = factor(ID), y = S),stat="identity", position="identity",fill="blue") + 
  xlab("job ID") + 
  ylab("Duration")  +
  ggtitle("Response and service, SPT")
mean(resulat$TEMPS)
## [1] 1.854532
resulat <- data.frame()
# Loi exponentielle, mode préemptif en fonction de remaining restant.
i<-1
while (i<=length(lambda_values)) {
    resulat <-  FileSRPT(n=100, lambda_values[i],"exp",1,0, policy="srpt_pmtn",tpsServ)
    i<-i+1
}
p2<-ggplot(resulat) +
  geom_bar(aes(x = factor(ID), y = TEMPS),stat="identity", position="identity",fill="red") + 
  geom_bar(aes(x = factor(ID), y = S),stat="identity", position="identity",fill="blue") + 
  xlab("job ID") + 
  ylab("Duration")  +
  ggtitle("Response and service SRPT_PMTN")
mean(resulat$TEMPS)
## [1] 1.391852
resulat <- data.frame()
# Loi exponentielle, FIFO.
i<-1
while (i<=length(lambda_values)) {
    resulat <- FileFIFO(n=100, lambda_values[i],"exp",1,0,tpsServ)
    i<-i+1
}
p3<-ggplot(resulat) +
  geom_bar(aes(x = factor(ID), y = TEMPS),stat="identity", position="identity",fill="red") + 
  geom_bar(aes(x = factor(ID), y = S),stat="identity", position="identity",fill="blue") + 
  xlab("job ID") + 
  ylab("Duration")  +
  ggtitle("Response and service FIFO")
mean(resulat$TEMPS)
## [1] 1.994561
resulat <- data.frame()

Allez tracons tout cela

grid.arrange(p,p1,p2,p3,ncol=2)

Voici notre légende :

ROUGE : TEMPS DE SERVICE

BLEU : t2-t1 (temps traitement)

Bon bon bon, étudions de plus pres.

On peut voir déja que pour la politique FIFO, rien de particulier en dire le temps de service n’as pas l’air d’impacter sur le temps de traitement. La variabilité n’est pas du tout important ici!

Or pour les 3 autres, le temps de traitement est directement impacté par le temps de service comme nous pouvions nous en douter, puisque cette politique est basé la dessus.

SPT_PMTN : OULA ! on peut ici voir une variabilité qui est triple par rapport au deux précedement. Cependant cela n’arrive que pour une valeur, donc la moyenne reste très faible.

SRPT_PMTN : Encore ici la variabilité est important, moins que SPT PMTN mais quand meme significative, on peut voir notamement que ces deux mode avec préemption on vraiment le meme comportement.

SPT : Elle est très similaire à FIFO au niveau de la variabilité, ce qui est plutot logique car elle est sans préemption. On remarque d’une manière général que plus le temps de service est important plus le temps de traitement l’ai aussi.

On peut voir que malgres les variabilités plus ou moins importante que la valeur moyenne des temps de traitement est environ pareil pour les politiques SRPT. Mais cette valeur explose pour FIFO.