R/examples.R

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

#' Copies files of a given example to a given directory
#'
#' @param what character string of the name of the example we want to get.
#' @param to character string of the name of the directory we want to copy the
#' example's file.
#'
.examples <- function(what, to = NA) {
  # the following function inserts "_\\d" before the extension of a file to avoid
  # overwritting. "i" is the digit to use for the insertion and "x" is the
  # character string in which to do the insertion:
  insert <- function(i, x) sub("^(.*)(\\.gaml)$", paste0("\\1_", i,"\\2"), x)
  # the path to the examples:
  path <- system.file("examples", package = "gamar")
  # selecting the information of the example we are interested in:
  #  what <- subset(get("examples_files"), model == what)
  #  copy <- what$copy  # what to copy
  copy <- subset(get("examples_files"), model == what, copy)
  to0 <- to          # where to copy
  if (is.na(to)) {  # in case no directory is specified, we set to working dir.
  # (note here that we have to use is.na instead of missing because its value is
  # tested several times in this function).
    print_to <- "working directory"  # will be updated if the file/dir exists
    to <- getwd()
  } else {  # in case a directory is specified we create it if it does not exist
    print_to <- paste0("'./", to, copy, "'")
    if (!dir.exists(to)) dir.create(to, recursive = TRUE)
  }
  to_try <- paste0(to, copy)
  if (grepl("\\.gaml$", copy)) {  # in case we copy a file ---------------------
    if (file.exists(to_try)) {  # in case the file already exists
      i <- 1; while(file.exists(insert(i, to_try))) i <- i + 1  # look for "i"
      to <- insert(i, to_try)  # update "to"
      if (is.na(to0)) print_to <- paste0("'.", insert(i, copy), "'")  #| update...
      else print_to <- paste0("'./", to0, insert(i, copy), "'")       #| ... "print_to"
    }
    file.copy(paste0(path, copy), to)
    obj <- "File"
  } else {  # in case we copy a directory instead of a file --------------------
    if (dir.exists(to_try)) {  # in case the directory already exists
      i <- 1; while(dir.exists(paste0(to_try, "_", i))) i <- i + 1  # look for "i"
      tmp <- tempdir()                                      #| because we want
      file.copy(paste0(path, copy), tmp, recursive = TRUE)  #| the name of the
      name1 <- paste0(tmp, copy)                            #| copied directory
      name2 <- paste0(name1, "_", i)                        #| to be different
      file.rename(name1, name2)                             #| from the original
      file.copy(name2, to, recursive = TRUE)                #| name, we need to
      unlink(name2, recursive = TRUE)                       #| go through tmpdir
      if (is.na(to0)) print_to <- paste0("'.", paste0(copy, "_", i), "'")  #| update
      else print_to <- paste0("'./", to, copy, "_", i, "'")                #| "print_to"
    } else file.copy(paste0(path, copy), to, recursive = TRUE)
    obj <- "Directory"
  }
  message(paste0(obj, " '", sub("/" , "", copy), "' copied to ", print_to, "."))
}


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


#' Managing example model files
#'
#' Used without arguments this function prints the content of the library of
#' model examples. Used with arguments, it gets model example(s) from the
#' library to a directory of the user's choice.
#'
#' @inheritParams .examples
#'
#' @export
examples <- function(what, to) {
  # (1) first case: no argument values provided to the function, just show the
  # list of built-in examples:
  if (missing(what)) {
    examples_files <- get("examples_files")
    nc <- nchar(examples_files[, 1])  # the length of the white space before ":"
    whitesp <- sapply(max(nc) - nc,   # the vector of white spaces.
                      function(x)
                        paste0(paste(rep(" ", x), collapse = ""), " : "))
    cat(paste(apply(cbind(examples_files[, 1], whitesp, examples_files[, 2]), 1,
                    paste, collapse = ""), collapse = "\n"))  # the print out.
    # (2) second case: moving model files from examples directory:
  } else {  # this is basically a vectorized call of .examples
    if (missing(to)) to <- rep(NA, length(what))
    else if (length(to) < 2) to <- rep(to, length(what))
    for(i in seq_along(to)) .examples(what[i], to[i])
  }
}