set.seed(10)
library(plyr)
library(ggplot2)
library(reshape)
## 
## Attaching package: 'reshape'
## 
## The following objects are masked from 'package:plyr':
## 
##     rename, round_any
library(gridExtra)
## Loading required package: grid
# 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=80,lambda=0.5,typeservice=0.6,x,y,policy="SPT") {
  # 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: SRPT_pmtn, SPT_pmtn, SPT
  # 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<-rexp(n,typeservice)
  #     S <- Service(n,typeservice,x,y) # initial service times
  
  #### Variables that define the state of the queue
  t = 0               # time node of each event ocurring
  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
  
  select_task=function(temp=rep(0,n)){#choose a task appropriate to run
    running<<-switch(policy,
                     SRPT_pmtn=waiting[which.min(remaining)],#choose the shortest executing time
                     SPT_pmtn=waiting[which.min(temp)],
                     SPT=waiting[which.min(remaining)]
    )
  }
  
  #### A few useful local functions 
  run_task = function() { # runs the last task of the waiting list
    if(length(waiting)>0) {
      temp <- remaining
      if(policy == "SRPT_pmtn" & !is.na(running)){ 
        temp[running]<-S[running] #Replacing the current running member with its original service value
        temp[waiting(length(waiting))] <- S[waiting(length(waiting))] #add the new arrival into the temporary queue
      }
      if(!is.na(running) & policy != "SPT"){
        running <<- select_task(temp)
      }else if(is.na(running) & policy != "SPT"){
        running<<-waiting[length(waiting)]
      }else if(is.na(running)){
        running <<- select_task(temp)
      }
      if(is.na(running)){
          running<<-waiting[length(waiting)]
          }
      remaining[running]<<-min(S[running],remaining[running],na.rm=T) #always the shortest
      if(policy != "SPT"){
        waiting <<- waiting[-length(waiting)]        
      }
    }
  }
  
  #in fact, when this function is called, that means the next arrival will arrive before the current job finish, so we consider just one possibility in this case that mean that we should insert this job in the propriate place in the waiting queue and switch the handler if necessairy for SRPT_pmtn
  push_task = function() { # insert the next_arrival-th task to the waiting list
    # and run it
        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) }#temps passé pour la tâche courante
    if(!is.na(running))  { dt = min(dt,remaining[running], na.rm=T)   }# ici dt contains the shortest time between the inter_arrival and the remaining time of current job at the coming point of next arrival
    if(is.na(dt)) { break }
    
    # Update state
    t=t+dt #t indicates the ocurring time of an event i.e a new client arrives
    if(!is.na(running)) {
        remaining[running] = remaining[running] - dt #piece of time left for current job potentially interrupted by the new arrival
        if(remaining[running]<=0) { #if the next job arrives after the end of current job
          t2[running]<- t #then current job finished as it planed to
            running = NA #current job indice reset to null
            run_task() #finish this task
        if( policy == "SPT"){
              waiting <- waiting[-match(x=running,waiting)] #we remove the one who just finished
        }
          
        }      
    }
    if((next_arrival<=n) & (t==t1[next_arrival])) { #else we jump to the point when the next event happens i.e we talk about the next arrival because it'll arrive before the current finishes
          push_task() #so we have tp push it into the waiting queue

    }
  }
  
  t2-t1
} 

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

dc1<-FileSRPT(n=80,lambda=0.5,typeservice=0.6,policy="SRPT_pmtn")

dc2<-FileSRPT(n=80,lambda=0.5,typeservice=0.6,policy="SPT_pmtn")
# plot(dc2)
# dc3<-FileSRPT(n=80,lambda=0.5,typeservice=0.6,policy="SPT")
# plot(dc3)
# 
dd1<-data.frame(SRPT_pmtn=dc1,SPT_pmtn=dc2) #,SPT=dc3
dd1$id=1:length(dd1$SRPT_pmtn)
d <- melt(dd1,id=c("id"))
ggplot(data=d[d$variable %in% c("SRPT_pmtn","SPT_pmtn"),],
       aes(x=id,y=value, color=variable)) + 
  geom_line(size=1) + scale_color_brewer(palette="Set1") +  xlab("Job Id") +
  ylab("Response Time") + 
  ggtitle("Response time for debit: 0.5")

sprintf("Average response time for SRPT_pmtn is %s",round(mean(dc1),digit=3))
## [1] "Average response time for SRPT_pmtn is 4.786"
sprintf("Average response time for SRP_pmtn is %s",round(mean(dc2),digits=3))
## [1] "Average response time for SRP_pmtn is 4.531"
# sprintf("Average response time for SPT is %s",round(mean(dc3,na.rm =T),digits=3))

On n’a pas arrivé à réaliser le SPT car il nous manque toujours des valeurs dedant. Mais en comparant les trois graphes et les moyens, on peut bien constater que les performances de chacun est de SPT > SRPTpmtn > SRPpntn.

Q3 Vous étudierez également la distribution du temps de réponse et en particulier les valeurs extrêmes comme le temps de réponse maximum).

dc1<-FileSRPT(n=1000,lambda=0.5,typeservice=0.6,policy="SRPT_pmtn")

dc2<-FileSRPT(n=1000,lambda=0.5,typeservice=0.6,policy="SPT_pmtn")
# plot(dc2)
# dc3<-FileSRPT(n=1000,lambda=0.5,typeservice=0.6,policy="SPT")
sprintf("Maximun response time for SRPT_pmtn is %s, dont la variance: %s",round(max(dc1),digits=3),round(var(dc1),digits=3))
## [1] "Maximun response time for SRPT_pmtn is 118.425, dont la variance: 312.884"
sprintf("Maximun response time for SRP_pmtn is %s, dont la variance: %s",round(max(dc2),digits=3),round(var(dc2),digits=3))
## [1] "Maximun response time for SRP_pmtn is 220.391, dont la variance: 554.285"
# sprintf("Maximun response time for SPT is %s, dont la variance: %s",round(max(dc3,na.rm=T),digits=3),round(var(dc3,na.rm=T),digits=3))

En evaluant les trois max de ces lois différentes, on voit que SRPTpmtn se varie plus brutalement que SRPTpmtn celui que SPT. En fait la toisième est meilleur car de toute façon, un job en train d’exécution peut toujours finir son boulot quelque soit un nouveau job arrive. Cepandant, un job qui a une durée d’exécution plus longue que les autres qui arrivent pendant l’exécution d’un job peux être poussé arrière. SRP_pmtn garanti toujours ceux qui arrive avec une durée d’exécution plus légère donc un job qui vient de démarrer peut être poussé tout derrière jusqu’a la fin. SRPpmtn est un peux mieux que la première car lorsqu’un job est démarré, il a une probabilité plus importante d’avoir une durée retante que les nouvaux arrivals, donc un job qui a démarré puisse finir son exécution avec une durée plus courte que le cas précedant.