R/plan-methods.R

#' @export
#`fname<-.plan` <- function(x, value) {
`f<-` <- function(x, value) {
  for(i in seq_along(x)) fname(x[i]) <- value
  #  if (substring(value, 1, 1) != "/") value <- paste0(getwd(), "/", value)
  #  x["sourcePath"] <- value
  x
}


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


#' @export
fname.plan <- function(object) {
  fname(object[1])
}


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


#' @export
names.plan <- function(object) {
  names(unclass(object))
}


#' @export
`names<-.plan` <- function(x, value) {
  x <- unclass(x)
  names(x) <- value
  for(i in seq_along(value)) x[[i]]["experiment"] <- value[i]
  structure(x, class = c("plan", "experiment"))
}


#' @export
print.plan <- function(plan) {
  plan2 <- lapply(unclass(plan), flatten)
  the_file <- plan2[[1]]["sourcePath"]
  sel <- which(!(names(plan2[[1]]) %in% c("experiment", "sourcePath")))
  plan2 <- lapply(plan2, function(x) as_numeric(x[sel]))
  print(do.call(rbind, plan2))
  cat(paste("\nModel's file:", the_file))
  invisible(plan)
}


#' @export
run.plan <- function(x, hpc = 1, output) {
  files <- startexperimentplan(x, hpc, output)
  lapply(files, readxmlfile)
}


#' @export
`[.plan` <- function(x, value) {
  out <- unclass(x)[value]
  if(length(out) > 1) return(structure(out, class = c("plan", "experiment")))
  else {
    out <- unlist(out, recursive = FALSE)
    tmp <- sub("^.*\\.", "", names(out))
    names(out) <- sub("^attrs$", ".attrs", tmp)
    return(structure(out, class = "experiment"))
  }
}
choisy/gamar3 documentation built on May 28, 2019, 7:17 p.m.