R/experiment.R

In choisy/gamar3: Interface to the Agent-Based Modeling Platform GAMA

#' Lists all the experiments of a model
#'
#' @importFrom readtext readtext
.experiment1 <- function(file) {
  pattern <- "AaAaAaAaA"
  text <- readtext(file, verbosity = FALSE)$text
  text <- gsub("\n *experiment ", pattern, text)
  text <- strsplit(text, pattern)[[1]][-1]
  unname(sapply(text, function(x) gsub(" .*$", "", trimws(x))))
}


# ------------------------------------------------------------------------------


#' Retrieve a particular experiment from a model
#'
#' @importFrom XML xmlToList xmlParse
.experiment2 <- function(modelfile, experimentname) {
  on.exit(message(paste0("Experiment '", experimentname, "' from '", modelfile,
                         "' saved in '", outfile, "'.")))
  message(paste0("Loading experiment '", experimentname,
                 "' from file '", basename(modelfile), "'..."))
  outfile <- createmodelparameterfilename(experimentname, getwd())  # creates workgamar
  trycommand <- system(paste0("java -jar ", getOption("gamar.startjar"), " -Xms",
                              getOption("gamar.Xms"), " -Xmx",
                              getOption("gamar.Xmx"),
                              " -Djava.awt.headless=true org.eclipse.core.launcher.Main ",
                              "-application msi.gama.headless.id4 -xml ",
                              experimentname, " ", modelfile, " ", outfile, ">/dev/null"),
                       ignore.stdout = TRUE, ignore.stderr = TRUE)
  # removing the "workspace" directory that is created by the command above.
  unlink("workspace", TRUE, TRUE)
  if (trycommand > 0) return(-1)
  out <- xmlToList(xmlParse(outfile))
  structure(out$Simulation, class = "experiment")
}


# ------------------------------------------------------------------------------


#' @export
experiment <- function(modelfile, experimentname) {
# adding extension if there is not:
  extension <- ".gaml"
  if (!grepl(paste0(extension, "$"), modelfile))
    modelfile2 <- paste0(modelfile, extension)
# looking into the library if not present locally:
  if (!file.exists(modelfile2)) {
    examples_files <- get("examples_files")
    file <- subset(examples_files, model == modelfile, gaml)
    path <- paste0(system.file("examples", package = "gamar"), "/")
    file <- paste0(path, file)
    if(file.exists(file)) modelfile2 <- file # in case the model is defined by its name
    else modelfile2 <- paste0(path, grep(modelfile, examples_files$gaml, value = TRUE))
  }
  if (missing(experimentname)) .experiment1(modelfile2) # listing all the experiments
  else .experiment2(modelfile2, experimentname) # retrieving a particular experiment
}


# ------------------------------------------------------------------------------


#' @export
is.experiment <- function(object) {
  "experiment" %in% class(object)
}