Started work on exercise 9.

This commit is contained in:
Filipe Rodrigues 2023-12-15 17:04:44 +00:00
parent 501ad1aaa5
commit 0d783e9dfb
4 changed files with 57 additions and 29 deletions

View File

@ -2,26 +2,27 @@
# estimates average delay in system
require(ggplot2)
library(scales)
require(extraDistr)
rescheduleDepartures <- function(ServiceRate, Departures, TimePrevious, Time, thisServer, numJobsBefore, numJobsAfter) {
rescheduleDepartures <- function(service_rate, Departures, TimePrevious, Time, thisServer, numJobsBefore, numJobsAfter) {
for (i in seq_len(nrow(Departures))) {
ElapsedTime <- Time - TimePrevious[thisServer]
if (Departures[i, 4] == thisServer) {
PreviousServicedUnits <- Departures[i, 3]
LastServicedUnits <- ElapsedTime * ServiceRate / numJobsBefore
LastServicedUnits <- ElapsedTime * service_rate / numJobsBefore
RemainingServiceUnits <- PreviousServicedUnits - LastServicedUnits
Departures[i, 3] <- RemainingServiceUnits
Departures[i, 1] <- Time + RemainingServiceUnits * numJobsAfter / ServiceRate
Departures[i, 1] <- Time + RemainingServiceUnits * numJobsAfter / service_rate
}
}
TimePrevious[thisServer] <- Time
}
calc_avg_delay_random <- function(numServers, ArrivalRate, ServiceRate, StoppingCondition) {
calc_avg_delay_random <- function(numServers, arrival_rate, service_rate, StoppingCondition) {
# Random task assignment policy
Time <- 0
nextArrivalTime <- rexp(1, rate = ArrivalRate)
nextArrivalTime <- rexp(1, rate = arrival_rate)
# Departures is a matrix of departure events where each row is an event and each
# event includes (i) departure time, (ii) arrival time, (iii) service time, and
# (iv) server number
@ -37,15 +38,15 @@ calc_avg_delay_random <- function(numServers, ArrivalRate, ServiceRate, Stopping
Time <- min(c(nextArrivalTime, nextDepartureTime))
nextEventType <- which.min(c(nextArrivalTime, nextDepartureTime))
if (nextEventType == 1) {
nextArrivalTime <- Time + rexp(1, ArrivalRate)
nextArrivalTime <- Time + rexp(1, arrival_rate)
thisServer <- rdunif(1, 1, numServers)
numJobsServer[thisServer] <- numJobsServer[thisServer] + 1
numJobs <- numJobsServer[thisServer]
if (!all(is.na(Departures))) {
rescheduleDepartures(ServiceRate, Departures, TimePrevious, Time, thisServer, numJobs - 1, numJobs)
rescheduleDepartures(service_rate, Departures, TimePrevious, Time, thisServer, numJobs - 1, numJobs)
}
ServiceUnits <- rexp(1, rate = ServiceRate)
DepartureTime <- Time + ServiceUnits * numJobs / ServiceRate
ServiceUnits <- rexp(1, rate = service_rate)
DepartureTime <- Time + ServiceUnits * numJobs / service_rate
Departures <- rbind(Departures, c(DepartureTime, Time, ServiceUnits, thisServer))
} else {
thisDeparture <- Departures[1, ]
@ -57,23 +58,23 @@ calc_avg_delay_random <- function(numServers, ArrivalRate, ServiceRate, Stopping
NumSysCompleted <- NumSysCompleted + 1
Departures <- Departures[-1, , drop = FALSE]
if (!all(is.na(Departures))) {
rescheduleDepartures(ServiceRate, Departures, TimePrevious, Time, thisServer, numJobs + 1, numJobs)
rescheduleDepartures(service_rate, Departures, TimePrevious, Time, thisServer, numJobs + 1, numJobs)
}
}
}
AvgDelay <- AccumDelay / NumSysCompleted
ro <- ArrivalRate / (numServers * ServiceRate)
TrueAvgDelay <- (numServers / ArrivalRate) * (ro / (1 - ro))
ro <- arrival_rate / (numServers * service_rate)
TrueAvgDelay <- (numServers / arrival_rate) * (ro / (1 - ro))
list(avg_delay = AvgDelay, wq = TrueAvgDelay)
}
calc_avg_delay_jsq <- function(numServers, ArrivalRate, ServiceRate, StoppingCondition) {
calc_avg_delay_jsq <- function(numServers, arrival_rate, service_rate, StoppingCondition) {
# JSQ task assignment policy
Time <- 0
nextArrivalTime <- rexp(1, rate = ArrivalRate)
nextArrivalTime <- rexp(1, rate = arrival_rate)
# Departures is a matrix of departure events where each row is an event and each
# event includes (i) departure time, (ii) arrival time, (iii) service time, and
# (iv) server number
@ -89,17 +90,17 @@ calc_avg_delay_jsq <- function(numServers, ArrivalRate, ServiceRate, StoppingCon
Time <- min(c(nextArrivalTime, nextDepartureTime))
nextEventType <- which.min(c(nextArrivalTime, nextDepartureTime))
if (nextEventType == 1) {
nextArrivalTime <- Time + rexp(1, ArrivalRate)
nextArrivalTime <- Time + rexp(1, arrival_rate)
minServers <- which(numJobsServer == min(numJobsServer))
thisServerIndex <- rdunif(1, 1, length(minServers))
thisServer <- minServers[thisServerIndex]
numJobsServer[thisServer] <- numJobsServer[thisServer] + 1
numJobs <- numJobsServer[thisServer]
if (!all(is.na(Departures))) {
rescheduleDepartures(ServiceRate, Departures, TimePrevious, Time, thisServer, numJobs - 1, numJobs)
rescheduleDepartures(service_rate, Departures, TimePrevious, Time, thisServer, numJobs - 1, numJobs)
}
ServiceUnits <- rexp(1, rate = ServiceRate)
DepartureTime <- Time + ServiceUnits * numJobs / ServiceRate
ServiceUnits <- rexp(1, rate = service_rate)
DepartureTime <- Time + ServiceUnits * numJobs / service_rate
Departures <- rbind(Departures, c(DepartureTime, Time, ServiceUnits, thisServer))
} else {
thisDeparture <- Departures[1, ]
@ -111,7 +112,7 @@ calc_avg_delay_jsq <- function(numServers, ArrivalRate, ServiceRate, StoppingCon
NumSysCompleted <- NumSysCompleted + 1
Departures <- Departures[-1, , drop = FALSE]
if (!all(is.na(Departures))) {
rescheduleDepartures(ServiceRate, Departures, TimePrevious, Time, thisServer, numJobs + 1, numJobs)
rescheduleDepartures(service_rate, Departures, TimePrevious, Time, thisServer, numJobs + 1, numJobs)
}
}
}
@ -122,20 +123,21 @@ calc_avg_delay_jsq <- function(numServers, ArrivalRate, ServiceRate, StoppingCon
set.seed(0)
service_rates <- seq(1, 5, 0.1)
ρ_all <- seq(0.1, 1.5, by = 0.1)
avg_delays_random <- list()
avg_delays_random_theoretical <- list()
avg_delays_jsq <- list()
for (service_rate in service_rates) {
cat(sprintf("Service Rate: %.2f\n", service_rate))
for (ρ in ρ_all) {
cat(sprintf("ρ: %.2f\n", ρ))
numServers <- 2
ArrivalRate <- 1.5
StoppingCondition <- 1000
arrival_rate <- 1.5
service_rate <- arrival_rate / ρ
StoppingCondition <- 100000
stats_random <- calc_avg_delay_random(numServers, ArrivalRate, service_rate, StoppingCondition)
stats_jsq <- calc_avg_delay_jsq(numServers, ArrivalRate, service_rate, StoppingCondition)
stats_random <- calc_avg_delay_random(numServers, arrival_rate, service_rate, StoppingCondition)
stats_jsq <- calc_avg_delay_jsq(numServers, arrival_rate, service_rate, StoppingCondition)
avg_delays_random[[length(avg_delays_random) + 1]] <- stats_random$avg_delay
avg_delays_random_theoretical[[length(avg_delays_random_theoretical) + 1]] <- stats_random$wq
@ -143,7 +145,7 @@ for (service_rate in service_rates) {
}
data <- data.frame(
x = service_rates,
x = ρ_all,
avg_delays_random = unlist(avg_delays_random),
avg_delays_random_theoretical = unlist(avg_delays_random_theoretical),
avg_delays_jsq = unlist(avg_delays_jsq)
@ -153,7 +155,7 @@ plot <- ggplot(data) +
geom_line(aes(.data$x, .data$avg_delays_random, color = "Avg. Delay (Random)")) +
geom_line(aes(.data$x, .data$avg_delays_random_theoretical, color = "Avg. Delay (Theoretical random)")) +
geom_line(aes(.data$x, .data$avg_delays_jsq, color = "Avg. Delay (JSQ)")) +
xlab("Service rate") +
xlab("ρ") +
ylab("Avg delay")
ggsave(plot, file = "output/9.svg", device = "png")
ggsave(plot, file = "output/9.svg", device = "svg")

10
typst/exercises/9.typ Normal file
View File

@ -0,0 +1,10 @@
#import "/typst/util.typ" as util: indent_par, code_figure
#indent_par[We have run the simulator for a range of $ρ [0.1, 1.5]$, with an interval of $0.1$ and obtained the following graph in figure 14:]
#figure(
image("/output/9.svg", width: 100%),
caption: [Results]
)
#indent_par[For stables values of the system ($ρ < 1.0$), both policies are very comparable. However, when the system becomes unstable ($ρ >= 1.0$), the *JSQ* policy outperforms the random policy.]

View File

@ -75,3 +75,8 @@
=== 8. Exercise 8
#include "exercises/8.typ"
== E. Server farms
=== 9. Exercise 9
#include "exercises/9.typ"

View File

@ -18,6 +18,7 @@ default:
- rule: ex8_a
- rule: ex8_b
- rule: ex8_c
- rule: ex9
rules:
# Typst
@ -241,3 +242,13 @@ rules:
exec:
- - Rscript
- code/8c.R
# Exercise 9
ex9:
out:
- output/9.svg
deps:
- code/9.R
exec:
- - Rscript
- code/9.R