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

Question 1 : Code de simulation Obenue

Résumé des modifications apportés au code initiale

Pour produire ce nouveau code nous, nous avons dû y apporter les modifications suivantes :

• Initilisation de remaining avec les temps de services
• Modification du mécanisme d’élection du nouveau processus à éxécuter
• Modification du mécanisme de mise à jour du remaining time caclqué sur le code de base

• 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))

}    

Question 2 : Etude détaillée des performances de ces politiques

Plan d’expérience

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 ).

Analyse

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)")

Performances

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

Conclusion

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

Question 3 : Etude de la distribution des temps de réponses

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)")

Conclusion

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.