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

Pour cette partie, nous utilisons le code de Monsieur Arnaud Legrand (voir ci-dessous) :

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

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()
      }
    }
    
    #tps=t2-t1
    df <- data.frame(N=n,TIME = t2-t1, LAMBDA = lambda, LAW = typeservice, POLICY = policy, LABEL = as.factor(paste(typeservice, "(", x, ",", y, ")", sep = "")))
   return (df)
}    

Q1 : Nature des lois de service

# nombres d'échantillons
sample=1:100
#Dataframe avec chaque service (det,uni,gamma et exp)
df = data.frame(service1=Service(100,typeservice = "det",0,0),service2=Service(100,typeservice = "uni",0,2),service3=Service(100,typeservice = "gamma",.2,5),service4=Service(100,typeservice = "exp",1,0))

Loi deterministe :

#affichage pour chaque service (courbe):
ggplot(data=df)+ geom_point(aes(x=sample,y=service1),color="red") + ylab("time of service") + ggtitle("Loi Deterministe")

plot of chunk unnamed-chunk-3

#affichage sous forme de barre : 
ggplot(data=df, aes(x = sample, y=service1,color="red")) +
  geom_bar(data=df$services1,stat="identity", position="identity") +geom_point() +  geom_line() + xlab("sample") + ylab("time of service")+ ggtitle("Loi Deterministe")

plot of chunk unnamed-chunk-3

mean(df$service1)
## [1] 1

Pour la loi deterministe : On peut voir que pour chaque valeur nous avons un temps de service de 1. Il est constant.

Loi Uniforme :

ggplot(data=df)+ geom_point(aes(x=sample,y=service2),color="yellow") + ylab("time of service") + ggtitle("Loi Uniforme")

plot of chunk unnamed-chunk-4

ggplot(data=df, aes(x = sample, y=service2,color="red")) +
  geom_bar(data=df$services2,stat="identity", position="identity") +geom_point() +  geom_line() + xlab("sample") + ylab("time of service")+ ggtitle("Loi Uniforme")

plot of chunk unnamed-chunk-4

mean(df$service2)
## [1] 0.8907

Pour la loi uniforme : Nous pouvons voir des temps de service inconstant puisque les valeurs vont d’environ 0 jusqu’a 2. Cependant le temps moyen de service est proche de 1. Ce qui est normal puisque nous choisissons une valeur entre 0 et 2 (la moyenne est de 1 pour une lois uniforme).

Loi Gamma :

ggplot(data=df)+ geom_point(aes(x=sample,y=service3),color="green") + ylab("time of service") + ggtitle("Loi Gamma")

plot of chunk unnamed-chunk-5

ggplot(data=df, aes(x = sample, y=service3,color="red")) +
  geom_bar(data=df$services3,stat="identity", position="identity") +geom_point() +  geom_line() + xlab("sample") + ylab("time of service")+ ggtitle("Loi Gamma")

plot of chunk unnamed-chunk-5

mean(df$service3)
## [1] 0.6818

Les variation de temps de service deviennnent importantes.Ici nous avons pour valeur max quasiment 5.

Loi Exponentielle :

ggplot(data=df)+ geom_point(aes(x=sample,y=service4),color="blue") + ylab("time of service") + ggtitle("Loi Exponentielle")

plot of chunk unnamed-chunk-6

ggplot(data=df, aes(x = sample, y=service4,color="red")) +
  geom_bar(data=df$services4,stat="identity", position="identity") +geom_point() +  geom_line() + xlab("sample") + ylab("time of service")+ ggtitle("Loi Exponentielle")

plot of chunk unnamed-chunk-6

mean(df$service4)
## [1] 0.8411

Encore des variations mais moins important que pour la loi précédement.

Pour conclure, on peut voir que selon la loi choisi, les temps de services sont différents. La loi deterministe est constante. Les autres varient avce plus ou moins d’amplitude mais au finalement elle on toute une moyenne assez proche.

Q2 :Étude détaillée de la file M/M/1 − LIFO

r <- data.frame()


lambda = c(.2,.4,.6,.8)

# Loi exponentielle, mode non préemptif.
for (i in lambda) {
    r <- rbind(r, FileLIFO(10000, i,"exp",1,0, policy="npmtn"))
    
}
# Loi exponentielle, mode préemptif.

for (i in lambda)  {
    r <- rbind(r, FileLIFO(10000, i,"exp",1,0, policy="pmtn"))
    
}
# Loi exponentielle, mode préemptif restart.

for (i in lambda) {
    r <- rbind(r, FileLIFO(10000, i,"exp",1,0, policy="pmtn_restart"))
    
}
# Loi exponentielle mode préemptif reset

for (i in lambda)  {
    r <- rbind(r, FileLIFO(n=10000, i,"exp",1,0, policy="pmtn_reset"))
    
}


r2 <- ddply(r, c("LAMBDA", "POLICY"), summarize, TempsMoy = mean(TIME),variance = var(TIME), ecart = 2*sd(TIME)/sqrt(length(TIME)))


ggplot(data=r2, aes(x = LAMBDA, y = TempsMoy, ymin = TempsMoy - ecart, ymax = TempsMoy + ecart, color =POLICY)) + geom_point() +  geom_line()+geom_errorbar() + geom_vline(xintercept = 1) + xlab("débit") + ylab("Average service time ") + labs(name = "Policy", colour = "Policy")+ ylim(0,6)+ggtitle("Étude détaillée de la file M/M/1 − LIFO ")
## Warning: Removed 2 rows containing missing values (geom_point).
## Warning: Removed 2 rows containing missing values (geom_path).
## Warning: erreur de conversion de 'Étude détaillée de la file M/M/1 − LIFO ' dans 'mbcsToSbcs' : le point est substitué pour <e2>
## Warning: erreur de conversion de 'Étude détaillée de la file M/M/1 − LIFO ' dans 'mbcsToSbcs' : le point est substitué pour <88>
## Warning: erreur de conversion de 'Étude détaillée de la file M/M/1 − LIFO ' dans 'mbcsToSbcs' : le point est substitué pour <92>
## Warning: erreur de conversion de 'Étude détaillée de la file M/M/1 − LIFO ' dans 'mbcsToSbcs' : le point est substitué pour <e2>
## Warning: erreur de conversion de 'Étude détaillée de la file M/M/1 − LIFO ' dans 'mbcsToSbcs' : le point est substitué pour <88>
## Warning: erreur de conversion de 'Étude détaillée de la file M/M/1 − LIFO ' dans 'mbcsToSbcs' : le point est substitué pour <92>
## Warning: erreur de conversion de 'Étude détaillée de la file M/M/1 − LIFO ' dans 'mbcsToSbcs' : le point est substitué pour <e2>
## Warning: erreur de conversion de 'Étude détaillée de la file M/M/1 − LIFO ' dans 'mbcsToSbcs' : le point est substitué pour <88>
## Warning: erreur de conversion de 'Étude détaillée de la file M/M/1 − LIFO ' dans 'mbcsToSbcs' : le point est substitué pour <92>

plot of chunk unnamed-chunk-7 On peut voir sur le graphique ci-dessus que les types de service sans péemption, avec préemption et avec préemption reset ont une evolution plutot régulière (elles suivent à peu prés une droite). Cependant, les évolutions ne sont pas les mêmes, il y en a une qui se dermarque : la bleue (préemption avec restart). Cette aumgentation est proche de l’exponentielle. Si nous regardons de plus prés la courbe orange (sans préemption), on remarque qu’elle semble etre la plus efficace car elle fourni pour chaque valeur un temps de service minimal.

Q3 :Étude de la file M/GI/1−LIFO

Dans cette partie, il faut étuider le comportement du temps moyen en fonction du débit (lambda) pour chaque mode et lois:

Avec le mode PRÉEMTIF RESET :

r <- data.frame()


lambda = c(.1,.2,.3,.4,.5,.6,.7,.8,.9)

# Loi deterministe
for (i in lambda) {
    r <- rbind(r, FileLIFO(n=10000, i,"det",0,0, policy="pmtn_reset"))
}

# Loi uniforme
for (i in lambda) {
    r <- rbind(r, FileLIFO(n=10000, i,"uni",0,2, policy="pmtn_reset"))
}

# Loi gamma
for (i in lambda){
    r <- rbind(r, FileLIFO(n=10000, i,"gamma",4,.25, policy="pmtn_reset"))
}


# Loi exponentielle
for (i in lambda) {
    r <- rbind(r, FileLIFO(n=10000, i,"exp",1,0, policy="pmtn_reset"))
}



r2 <- ddply(r, c("LAMBDA", "LABEL"), summarize, TempsMoy = mean(TIME),variance = var(TIME), ecart = 2*sd(TIME)/sqrt(length(TIME)))



ggplot(data=r2, aes(x = LAMBDA, y = TempsMoy, ymin = TempsMoy - ecart, ymax = TempsMoy + ecart, color =LABEL)) + geom_point() +  geom_line()+geom_errorbar() + geom_vline(xintercept = 1) + xlab("débit") + ylab("Average service time ") + labs(name = "Law", colour = "Law")+ggtitle("Avec un mode Préemptif reset")+ ylim(0,20)
## Warning: Removed 7 rows containing missing values (geom_point).
## Warning: Removed 7 rows containing missing values (geom_path).

plot of chunk unnamed-chunk-8

On peut donc maintenant voir que la courbe de gamme propose un temps moyen de service trés bon (casi constant). La lois expo va augmenter régulièrement mais garde un temps de service moyen correct comparé au reste. Nous pouvons voir aussi que les courbes déterministe, gamma et uniforme augmente rapidement vers un lambda de .6

Avec le mode PRÉEMTIF RESTART :

r <- data.frame()


lambda = c(.1,.2,.3,.4,.5,.6,.7,.8,.9)

# Loi deterministe
for (i in lambda) {
    r <- rbind(r, FileLIFO(n=10000, i,"det",0,0, policy="pmtn_restart"))
}

# Loi uniforme
for (i in lambda) {
    r <- rbind(r, FileLIFO(n=10000, i,"uni",0,2, policy="pmtn_restart"))
}

# Loi gamma
for (i in lambda){
    r <- rbind(r, FileLIFO(n=10000, i,"gamma",4,.25, policy="pmtn_restart"))
}


# Loi exponentielle
for (i in lambda) {
    r <- rbind(r, FileLIFO(n=10000, i,"exp",1,0, policy="pmtn_restart"))
}



r2 <- ddply(r, c("LAMBDA", "LABEL"), summarize, TempsMoy = mean(TIME),variance = var(TIME), ecart = 2*sd(TIME)/sqrt(length(TIME)))



ggplot(data=r2, aes(x = LAMBDA, y = TempsMoy, ymin = TempsMoy - ecart, ymax = TempsMoy + ecart, color =LABEL)) + geom_point() +  geom_line()+geom_errorbar() + geom_vline(xintercept = 1) + xlab("débit") + ylab("Average service time ") + labs(name = "Law", colour = "Law")+ggtitle("Avec un mode Préemptif restart")

plot of chunk unnamed-chunk-9 Le temps de service moyen augmente fortement pour l’ensemble des lois. La lois déterministe met plus de temps que les autres lois pour augmenter, contrairement à la lois gamma. Ce mode n’est pas terrible pour un lambda au dessus de 0.5.

Avec le mode PRÉEMTIF REPRISE :

r <- data.frame()


lambda = c(.1,.2,.3,.4,.5,.6,.7,.8,.9)

# Loi deterministe
for (i in lambda) {
    r <- rbind(r, FileLIFO(n=10000, i,"det",0,0, policy="pmtn"))
}

# Loi uniforme
for (i in lambda) {
    r <- rbind(r, FileLIFO(n=10000, i,"uni",0,2, policy="pmtn"))
}

# Loi gamma
for (i in lambda){
    r <- rbind(r, FileLIFO(n=10000, i,"gamma",4,.25, policy="pmtn"))
}


# Loi exponentielle
for (i in lambda) {
    r <- rbind(r, FileLIFO(n=10000, i,"exp",1,0, policy="pmtn"))
}



r2 <- ddply(r, c("LAMBDA", "LABEL"), summarize, TempsMoy = mean(TIME),variance = var(TIME), ecart = 2*sd(TIME)/sqrt(length(TIME)))



ggplot(data=r2, aes(x = LAMBDA, y = TempsMoy, ymin = TempsMoy - ecart, ymax = TempsMoy + ecart, color =LABEL)) + geom_point() +  geom_line()+geom_errorbar() + geom_vline(xintercept = 1) + xlab("débit") + ylab("Average service time ") + labs(name = "Law", colour = "Law")+ggtitle("Avec un mode Préemptif reprise")

plot of chunk unnamed-chunk-10 Nous pouvons voir que les évolutions se font de la meme facon, en effet les courbes augmente de la meme facon ici (pas de forte exploision)

Avec le mode NON-PREEMPTIF :

r <- data.frame()


lambda = c(.1,.2,.3,.4,.5,.6,.7,.8,.9)

# Loi deterministe
for (i in lambda) {
    r <- rbind(r, FileLIFO(n=10000, i,"det",0,0, policy="npmtn"))
}

# Loi uniforme
for (i in lambda) {
    r <- rbind(r, FileLIFO(n=10000, i,"uni",0,2, policy="npmtn"))
}

# Loi gamma
for (i in lambda){
    r <- rbind(r, FileLIFO(n=10000, i,"gamma",4,.25, policy="npmtn"))
}


# Loi exponentielle
for (i in lambda) {
    r <- rbind(r, FileLIFO(n=10000, i,"exp",1,0, policy="npmtn"))
}



r2 <- ddply(r, c("LAMBDA", "LABEL"), summarize, TempsMoy = mean(TIME),variance = var(TIME), ecart = 2*sd(TIME)/sqrt(length(TIME)))



ggplot(data=r2, aes(x = LAMBDA, y = TempsMoy, ymin = TempsMoy - ecart, ymax = TempsMoy + ecart, color =LABEL)) + geom_point() +  geom_line()+geom_errorbar() + geom_vline(xintercept = 1) + xlab("débit") + ylab("Average service time ") + labs(name = "Law", colour = "Law")+ggtitle("Avec un mode non Préemptif ")

plot of chunk unnamed-chunk-11

On remarque que c’est la loi exponentiel qui augmente en premier. On peut ajouter à cela que la lois déterministe à celle qui à le temps de réponse qui augmente le moins rapidement.La lois gamma et la lois uniforme pourraient presque se superposer.

Conclusion : Les statistiques, c’est comme les bikinis, ça montre des choses intéressantes mais ça cache l’essentiel.