shinyloadtest v0.2 proto

load-test.R

library(parallel)
library(processx)

# config
t.test  <- 120
n.processes <- 12
t.update <- 10

# storage

tasks <- list()
active <- vector()
t.start <- Sys.time()
t.print <- Sys.time()
c <- 1



# keep n.processes running through the duration t.test
while (difftime(Sys.time(), t.start, units = "secs")  < t.test) {

  if (difftime(Sys.time(), t.print, units = "secs") > t.update) {
    print(paste0("Connections Active: ", sum(active)))
    print(paste0("Time Remaining: ", t.test - difftime(Sys.time(),t.start, units = "secs")) )
    t.print <- Sys.time()
  }

  if (sum(active) < n.processes) {
    cmd <- paste0("RScript -e \"devtools::load_all('~/Desktop/Sandbox/shinyloadtest'); options(target.url = '", url, "'); options(connection.id = '", c,"'); source('", testFile, "')\"")
    tasks[[c]] <- processx::process$new(commandline = cmd, stdout = "|")
    active[c] <- 1
    c <- c + 1
  }

  # check for results
  for (i in seq_along(tasks)) {
    if (active[i] > 0) {
      p <- tasks[[i]]
      if (!p$is_alive()) {
        active[i] <- 0
        tasks[[i]] <- new.env() # forces processx to close connection
      }
    }
  }

}

# check remaining tasks
while (sum(active) > 0) {
  # check for results
  for (i in seq_along(tasks)) {
    if (active[i] > 0) {
      p <- tasks[[i]]
      if (!p$is_alive()) {
        active[i] <- 0
        tasks[[i]] <- new.env() # forces processx to close connection
      }
    }
  }
}

dirs <- list.dirs(recursive = FALSE, full.names = FALSE)
timing_dir <- dirs[grepl(pattern = "-timing", fixed = TRUE, dirs)]
files <- list.files(timing_dir)
data <- list()
for (i in seq_along(files)) {
  data[[i]] <- readRDS(file.path(timing_dir, files[i]))
}

successes <- do.call(rbind, data)

list(successes = successes, failures = c - length(unique(successes$connection)))