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 M/GI/1 avec un ordonnancement LIFO. 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.

Simulation de la file LIFO

Tout d’abord le code d’une file LIFO, ce code nous a été donné par Monsieur Arnaud Legrand. plutot que de retourner t1-t2, comme le code est à l’origine, nous avons choisi de stocker dans une data frame le résultat, afin de récupérer à la fois t2-t1, lambda, la loi utilisé.

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

FileLIFO <- 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
    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
      if(length(waiting)>0) {
        running <<- waiting[length(waiting)]
        remaining[running] <<- switch(policy,
                                      npmtn = S[running],
                                      pmtn = min(S[running],remaining[running],na.rm=T),
                                      pmtn_restart = S[running],
                                      pmtn_reset = Service(1,typeservice,x,y)
                                      )
        waiting <<- waiting[-length(waiting)]
      }
    }

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

Question 1. Nature des lois de service :

· Illustrer les différences de natures entre les différentes lois de temps de service.

Pour cela nous allons apporter quelques modification à la fonction Service c’est pour cela que nous l’avons renommé. On y ajoutera une dataframe avec les données utiles pour répondre à la question.

ServiceTest <- function(n,typeservice,x,y) {
# genere un temps de service
  switch(typeservice,
         det = {df <- data.frame(N=n,TYPE = typeservice, X=x, Y=y, REP=rep(1,n),id=c(1:n))},
         uni = {df <- data.frame(N=n,TYPE = typeservice, X=x, Y=y, REP=runif(n,x,y),id=c(1:n))},
         gamma = {df <- data.frame(N=n,TYPE = typeservice, X=x, Y=y, REP=rgamma(n,shape=x,scale=y),id=c(1:n))},
         exp = {df <- data.frame(N=n,TYPE = typeservice, X=x, Y=y, REP=rexp(n,x), id=c(1:n))}
         )
   return (df)
}
lambda_values = c("det","uni","gamma","exp")
res=data.frame()
i<-1

res <- rbind(res,ServiceTest(100,"det",0,0)) # initial service times
res <-rbind(res,ServiceTest(100,"uni",0,2)) # initial service times
res <-rbind(res,ServiceTest(100,"gamma",.2,5)) # initial service times
res <-rbind(res,ServiceTest(100,"exp",1,0)) # initial service times

res2 <- ddply(res, c("TYPE", "REP"),summarize, type=TYPE,rep=REP, n=N, id=id)

ggplot(res2, aes(x = factor(id), y=rep,color =TYPE)) +
  geom_bar(data=res2,stat="identity", position="identity") +geom_point() +  geom_line() + xlab("n ID") + ylab("Temps de Service") 
## geom_path: Each group consist of only one observation. Do you need to adjust the group aesthetic?

plot of chunk unnamed-chunk-3 Bon, ce n’est pas trop lisible mais ca permet de donner une vue générale, en effet nous voyon notamment que la loie gamma n’est pas vraiment régulière il y a de fort changement elle fourni des temps avoisinant 0 et jusqu’a 6. On voit aussi que la loi deterministe fourni un temps de service constant de 1 ici. Au niveau de la loi exponentielle elle est similaire à la loi gamma mais avec en ecart type moins important. De meme pour la loi uniforme.

Regardons de plus pres chaque loi

LOI DETERMINISTE :

res<-data.frame()
res <- rbind(res,ServiceTest(100,"det",0,0)) # initial service times
res2 <- ddply(res, c("TYPE", "REP"),summarize, type=TYPE,rep=REP, n=N, id=id)
ggplot(res2, aes(x = factor(id), y=rep,color =TYPE)) +
  geom_bar(data=res2,stat="identity", position="identity") +geom_point() +  geom_line() + xlab("n ID") + ylab("Temps de Service") 
## geom_path: Each group consist of only one observation. Do you need to adjust the group aesthetic?

plot of chunk unnamed-chunk-4

mean(res2$rep)
## [1] 1

On peut voir que pour chaque valeur nous avons un temps de service de 1. Comme nous l’avions dit précedemment. Le temps de service est bien de 1.

LOI UNIFORME :

res<-data.frame()
res <-rbind(res,ServiceTest(100,"uni",0,2)) # initial service times
res2 <- ddply(res, c("TYPE", "REP"),summarize, type=TYPE,rep=REP, n=N, id=id)
ggplot(res2, aes(x = factor(id), y=rep,color =TYPE)) +
  geom_bar(data=res2,stat="identity", position="identity") +geom_point() +  geom_line() + xlab("n ID") + ylab("Temps de Service")
## geom_path: Each group consist of only one observation. Do you need to adjust the group aesthetic?