Simulation de la file - Politique SRPT

L’objectif est d’analyser l’importance de la distribution du temps de service sur le temps de réponse dans une file d’attente avec un ordonnancement SRPT. Le processus d’arrivée est un processus de Poisson de taux (débit), les clients ont un temps de service de moyenne 1 pris comme unité de temps de référence.

set.seed(10)
library(plyr)
library(ggplot2)

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) {
  
  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
  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
  next_arrival = 1    # index of the next task to arrive
  tab_cours = rep(0,n)
  nb_cours = 0
  nextjob =1
  srv = 1
    
  run_task = function() { # runs the task of the waiting list which will be the quickiest
    
    if(nb_cours>0) {
      for(i in 1:n){
        if(tab_cours[i] == 1){
          nextjob<<-i
          srv<<-i
          break
          }
        }
      if(nb_cours>1){
        j=nextjob
        for(i in j:n){          
          if(tab_cours[i] == 1){
            if((remaining[i] < remaining[nextjob])){
              nextjob<<-i
              }
            if(S[i]<S[srv]){
              srv<<-i
              }
            }
          }
        }

      running <<- switch(policy,
                         spt = nextjob,
                         srpt_pmtn = nextjob,
                         spt_pmtn = srv
                         )
      
      remaining[running] <<- S[running]
      tab_cours[running] <<- 0
      nb_cours <<- nb_cours -1
      }
    }
  
  push_task = function() { 
    if(policy != "spt") {
      if(!is.na(running)) {
        tab_cours[running] <<- 1
        
        nb_cours <<- nb_cours + 1}
      running <<- NA
      }
    tab_cours[next_arrival] <<- 1
    remaining[next_arrival] <<- S[next_arrival]
    next_arrival <<- next_arrival+1 
    nb_cours <<- nb_cours +1
    if(is.na(running)) { run_task() }
    }
  
  #### Main simulation loop
  while(TRUE) { 
   dt = NA
    dtnext = 10000
    dtrem = 10000
    if(next_arrival <=n) { dtnext = t1[next_arrival]-t}
    if(!is.na(running))  { dtrem = remaining[running] }
    dt = min (dtnext,dtrem)
    if(dt ==10000) { break }
    
    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()
      }
    }
    t2-t1
    #df <-data.frame(entree=t1,sortie=t2,diferentiel=t2-t1,servicelaw=typeservice,policy=policy,lambda=lambda)
    #df
}

#res <- data.frame()

#res <- rbind(res,FileSRPT(n=40,lambda=.3,"exp",1,0,"spt"))
#res

En essayant de travailler sur le squelette de code originellement fourni, nous avons vite été bloqués par la façon dont waiting identifiait les jobs en attente (les indices du job dans waiting et dans l’ordre d’arrivée différaient). Après beaucoup d’hésitations et d’essais, nous avons fini par travailler sur une base plus personnelle du code, mais sans doute moins optimale.

On vérifie ci-dessous le on fonctionnement du programme : (pour une version plus détaillée du résultat, décommentez les dernières lignes du programme.)

FileSRPT(n=100,lambda=.3,"exp",1,0,"spt")
##   [1] 0.49059480 0.41565452 0.08194206 0.92782966 1.56033876 1.02122125
##   [7] 0.25390722 0.47075579 1.84107614 2.32512984 3.13796386 3.13113532
##  [13] 0.88714529 0.15463309 0.07179000 0.32505819 0.19115046 0.52327136
##  [19] 0.18250376 0.49137915 1.34707816 3.52017413 1.39926832 0.36886710
##  [25] 2.14892635 0.54130439 0.97824992 1.64698165 1.73683481 1.24639113
##  [31] 1.27264541 0.84392105 0.54184372 0.79570464 0.36295898 0.47087964
##  [37] 0.95366052 0.09663135 0.16077256 3.11038693 5.52671299 0.46800458
##  [43] 1.98974379 0.15090678 1.53810652 1.65689497 1.95812069 0.77196984
##  [49] 0.20600117 1.34915529 3.93278298 1.25480632 1.60999943 1.68858786
##  [55] 0.15779178 0.49541866 0.45892758 0.66031430 4.12849045 6.11292942
##  [61] 2.00782530 0.38503276 0.78863015 0.40433856 0.31101944 2.58710933
##  [67] 1.31915425 1.68099387 2.32940978 4.18193670 1.29852684 0.17670139
##  [73] 0.13418932 1.22020916 1.93076746 1.14341786 5.35494120 5.51339443
##  [79] 1.17349222 1.28900808 0.07981438 1.96012710 4.38974851 0.16625371
##  [85] 0.85859746 0.16784565 1.01460165 0.17266414 0.66251239 2.01883389
##  [91] 2.21589865 2.62710641 2.01562272 0.48381646 2.28940280 0.63094497
##  [97] 1.04995031 2.17465737 1.07052489 0.62016711

Nous allons étudier la procédure avec les temps de service suivants :

stypes = rbind(
  data.frame(typeservice="det",x=0,y=0),
  data.frame(typeservice="uni",x=0,y=2),
  data.frame(typeservice="uni",x=.5,y=1.5),
  data.frame(typeservice="exp",x=1.0,y=0),
  data.frame(typeservice="gamma",x=4,y=1/4),
  data.frame(typeservice="gamma",x=.2,y=1/.2))
stypes$label = as.factor(paste(stypes$typeservice,"(",stypes$x,",",stypes$y,")",sep=""))
df = data.frame();
for (stype in stypes$label) {
  d = stypes[stypes$label==stype,]
  df=rbind(df,data.frame(law=stype, 
                         service=Service(40000,typeservice = as.character(d$typeservice), x=d$x, y=d$y)))
}

create <- function(n=500,lambdas = c(0.2,0.4,0.6,0.8),typeservice="exp",x=1,y=NA,
                   policies = c("spt_pmtn","spt","srpt_pmtn")) {
  d <- data.frame()
  for (policy in policies) {
    for (lambda in lambdas) {
#      print(paste(policy,lambda,sep=" ")) # ça, c'est juste pour suivre l'avancement
      r = FileSRPT(n=n, lambda=lambda, typeservice=typeservice, x=x, y=y, policy)
      d = rbind(d,data.frame(lambda=lambda, policy=policy, resp_m = mean(r), 
                             resp_ci = 2*sd(r)/sqrt(length(r))))
    }
  }
  
  d$input_type = typeservice
  d$input_p1 = x
  d$input_p2 = y
  d$label = as.factor(paste(typeservice,"(",x,",",y,")",sep=""))
  d
}

system.time(df <- create())
##    user  system elapsed 
##   5.574   0.020   5.630

J’ai utilisé un échantillon relativement bas car ma machine est peu puissante, toutefois il est bien sûr possible d’un prendre un plus grand.

p = ggplot(df,aes(x=lambda, y=resp_m, color=policy, shape=policy)) + 
  geom_line() + 
  geom_point() + 
  geom_errorbar(aes(x=lambda, ymin=resp_m-resp_ci, ymax=resp_m+resp_ci),
                width = .02) +
  scale_color_brewer(palette="Dark2")+
  labs(title= "Evolution du temps de réponse") + 
  xlab("Fréquence d'arrivée") +
  ylab("Unités de temps") +  xlim(0,1) +
  geom_vline(xintercept = 1) + geom_hline(yintercept = 1) + theme_bw()
p

On voit peu de différences sur le petit échantillon choisi entre spt_pmtn et srpt_pmtn. Pour rappel, ces deux modes se différencient de spt car ils s’arrêtent lorsqu’une nouvelle tâche entre dans le système. Visiblement, ces arrêts ralentissent énormément le travail de calcul. Plus la fréquence d’arrivée est haute, plus cela est visible. Dans la plupart des cas, spt s’apparente au mode FIFO, car il ne s’arrête pas pour prendre en compte les tâches nouvellement arrivées. Les courbes ébauchées semblent indiquer que srpt_pmtn et spt_pmtn ont une croissance similaire, même si leurs réactions peuvent différer à l’arrivée d’une nouvelle tâche (srpt_pmtn favorisera une tâche plus longue mais presque finie à une tâche courte juste arrivée, mais spt_pmtn s’arrêtera pour finir le plus vite possible les tâhces courtes.)

Essayons maintenant d’étudier ces courbes pour divers temps de service…

system.time(df <- rbind(df, create(typeservice="det"),
                  create(typeservice="uni",x=0,y=2),
                  create(typeservice="uni",x=.5,y=1.5),
                  create(typeservice="gamma",x=4,y=1/4),
                  create(typeservice="gamma",x=.2,y=1/.2)))
##    user  system elapsed 
##  35.548   0.012  35.747
p = ggplot(df,aes(x=lambda, y=resp_m, color=policy, shape=policy)) + 
  geom_line() + 
  geom_point() + 
  geom_errorbar(aes(x=lambda, ymin=resp_m-resp_ci, ymax=resp_m+resp_ci),
                width = .02) +
  scale_color_brewer(palette="Dark2")+
  labs(title= "Evolution du temps de réponse") + 
  xlab("Fréquence d'arrivée") +
  ylab("Unités de temps") +  xlim(0,1) + ylim(0, 6) +
  geom_vline(xintercept = 1) + geom_hline(yintercept = 1) + theme_bw() +
  facet_wrap(~label)
p
## Warning: Removed 4 rows containing missing values (geom_path).
## Warning: Removed 3 rows containing missing values (geom_path).
## Warning: Removed 4 rows containing missing values (geom_path).
## Warning: Removed 3 rows containing missing values (geom_path).
## Warning: Removed 4 rows containing missing values (geom_path).
## Warning: Removed 6 rows containing missing values (geom_path).
## Warning: Removed 4 rows containing missing values (geom_point).
## Warning: Removed 3 rows containing missing values (geom_point).
## Warning: Removed 4 rows containing missing values (geom_point).
## Warning: Removed 3 rows containing missing values (geom_point).
## Warning: Removed 4 rows containing missing values (geom_point).
## Warning: Removed 6 rows containing missing values (geom_point).
## Warning: Removed 4 rows containing missing values (geom_path).
## Warning: Removed 4 rows containing missing values (geom_path).
## Warning: Removed 4 rows containing missing values (geom_path).
## Warning: Removed 4 rows containing missing values (geom_path).
## Warning: Removed 4 rows containing missing values (geom_path).
## Warning: Removed 8 rows containing missing values (geom_path).

On obtient ici des courbes très étranges semblant vraisemblablement indiquer que notre code comporte des erreurs. De manière générale, spt est bien plus efficace que les modes qui s’arrêtent à l’arrivée d’une nouvelle tâche, mais nous ne saurions être plus précis au vu des courbes obtenues.