R/methods.R

In choisy/gamar1: An interface to the agent-based modeling platform GAMA

#name <- function(x,...) UseMethod("name",x)

#model <- function(x,...) UseMethod("model",x)

#id <- function(x,...) UseMethod("id",x)

#seed <- function(x,...) UseMethod("seed",x)

#rates <- function(x,...) UseMethod("rates",x)

# This function returns the parameter values of an experiment in the form of
# list:
getexpval <- function(object) {
  tmp <- do.call(rbind,object$Parameters)
  parameters <- as.numeric(tmp[,"value"])
  names(parameters) <- tmp[,"name"]
  tmp <- do.call(rbind,object$Outputs)
  framerates <- as.integer(tmp[,"framerate"])
  names(framerates) <- tmp[,"name"]
  list(parameters=parameters,framerates=framerates,
       name=object$.attrs["experiment"],
       maxstep=object$.attrs["finalStep"],
       seed=object$.attrs["seed"],
       id=object$.attrs["id"],
       file=object$.attrs["sourcePath"])
}

# The "print" method the "experiment" class:
print.experiment <- function(object) {
  object <- getexpval(object[[1]])
  cat(paste0("\nExperiment '",object$name,"':\n"))
  cat("\n(1) Model parameters:\n")
  print(object$parameters)
  cat("\n(2) Outputs frame rates:\n")
  print(object$framerates)
  cat("\n(3) Experiment attributes:\n")
  cat(paste("final step:",object$maxstep,"\n"))
  cat(paste("head of seed:",head(object$seed),"\n"))
  cat(paste("id:",object$id,"\n"))
  cat(paste("source file:",object$file,"\n"))
  cat("\n")
  invisible(object)
}

rates <- function(object) {
  theparams <- unlist(getexpval(object[[1]]))
  theparams <- theparams[grep("framerates",names(theparams))]
  thenames <- sub("framerates.","",names(theparams))
  theparams <- as.numeric(theparams)
  names(theparams) <- thenames
  theparams
}

`rates<-` <- function(object,value) {
  stopifnot(length(object$Simulation$Outputs)==length(value))
  for(i in seq_along(value))
    object$Simulation$Outputs[[i]]["framerate"] <- as.character(value[i])
  object
}

coef.experiment <- function(object) {
  theparams <- unlist(getexpval(object[[1]]))
  theparams <- theparams[grep("parameters",names(theparams))]
  thenames <- sub("parameters.","",names(theparams))
  theparams <- as.numeric(theparams)
  names(theparams) <- thenames
  theparams
}

name <- function(object)
  unname(unlist(getexpval(object[[1]]))["name.experiment"])

model <- function(object)
  unname(unlist(getexpval(object[[1]]))["file.sourcePath"])

id <- function(object)
  as.numeric(unlist(getexpval(object[[1]]))["id.id"])

`id<-` <- function(object,value) {
  object$Simulation$.attrs["id"] <- as.character(value)
  object
}

seed.experiment <- function(object)
  as.numeric(unlist(getexpval(object[[1]]))["seed.seed"])

`seed<-` <- function(object,value) {
  object$Simulation$.attrs["seed"] <- as.character(value)
  object
}

## TO DO:
## (1) maxstep et `maxstep<-` or should we consider max.experiment instead?
## (2) `coef.experiment<-`


###################################

print.plan <- function(object) {
  object <- lapply(object,getexpval)
  slotnames <- c("parameters","framerates")
  object <- lapply(slotnames,function(slot)lapply(object,function(x)x[[slot]]))
  object <- lapply(object,function(x)do.call(rbind,x))
  names(object) <- slotnames
  object <- lapply(object,function(x)
    {rownames(x) <- paste0("experiment #",1:nrow(x));x})
  cat("\nModel parameters:\n")
  print(object$parameters)
  cat("\nOutputs frame rates:\n")
  print(object$framerates)
  cat("\n")
  invisible(object)
}