R/GrapleR.R

Defines functions validate_json filePresent filesPresent getResultsDirName check_subdirectory check_graple validate_url .onAttach

Documented in check_graple check_subdirectory filePresent filesPresent getResultsDirName validate_json validate_url

.onAttach <- function(libname, pkgname) {
  packageStartupMessage("GRAPLEr has been developed with support from a supplement the PRAGMA award (NSF OCI-1234983) by
  Ken Subratie, Saumitra Aditya, Satish Mahesula, Renato J. Figueiredo, Cayelan C. Carey, Paul C. Hanson, and Vahid Daneshmand.
  For more information, please visit 'http://graple.org'.")
  #' Skip Self-signed SSL Certificate Error
  httr::set_config(httr::config(ssl_verifypeer = FALSE, ssl_verifyhost = FALSE))
}

#' Validates whether a given url exists
#'
#' @param url Submission URL
#' @return A boolean value indicating whether url exists
#' @export
#' @keywords internal
#' @importFrom httr http_error
#' @examples
#' validate_url('https://graple.acis.ufl.edu')
validate_url <- function(url){
  invalid_url = tryCatch({
    http_error(url)
  }, error = function(e) {
    invalid_url <- TRUE
  })
  return(!invalid_url)
}

#' Checks if the grapleObject is valid
#' by checking if the directories provided exist and valid
#' @param object A Graple Object
#' @return errors if any of the validation fails
#' @export
#' @keywords internal
#' @examples
#' \dontrun{
#' check_graple(grapleExp1)
#' }
check_graple <- function(object) {
  errors <- character()
  if(length(object@GWSURL) > 0)
  {
    valid_url <- validate_url(object@GWSURL)

    if (!valid_url) {
      msg <- paste("Invalid URL")
      errors <- c(errors, msg)
    }
  }

  if(length(object@ExpRootDir) > 0)
  {
    if(!dir.exists(object@ExpRootDir))
    {
      msg <- paste("Experiment root directory does not exist.")
      errors <- c(errors, msg)
    }
  }

  if(length(object@ResultsDir) > 0)
  {
    if(!dir.exists(object@ResultsDir))
    {
      msg <- paste("Results directory does not exist.")
      errors <- c(errors, msg)
    }
  }

  if(!check_subdirectory(object))
  {
    msg <- paste("Experiment root directory or result directory are a sub-directory of Result/Input.")
    errors <- c(errors, msg)
  }

  if (length(errors) == 0) TRUE else errors
}

#' Checks if the input/results directory is a sub-directory of
#' results/input directory
#' @param object A Graple Object
#' @return A boolean value indicating whether the directory
#' structure is valid
#' @export
#' @keywords internal
#' @examples
#' \dontrun{
#' check_subdirectory(grapleExp1)
#' }
check_subdirectory <- function(object){
  input_dir <- object@ExpRootDir
  results_dir <- object@ResultsDir
  valid_directories <- FALSE
  if(((length(input_dir) > 0 && length(results_dir) > 0) && (length(grep(input_dir,results_dir)) || length(grep(results_dir, input_dir)))>0))
    valid_directories <- FALSE
  else
    valid_directories <- TRUE
  return(valid_directories)
}

#' Gets the name for results directory
#' @param object A Graple Object
#' @return ExpName if provided, else the JobID
#' @export
#' @keywords internal
#' @examples
#' \dontrun{
#' getResultsDirName(grapleExp1)
#' }
getResultsDirName <- function(object){
  if(length(object@ExpName) > 0)
    return(object@ExpName)
  else if(length(object@JobID) > 0)
    return(object@JobID)
  else
    return('')
}

#' Checks if there are any files present in ExpRoot  Directory
#' @param object A Graple Object
#' @return A boolean value indicating whether files are present or not
#' @export
#' @keywords internal
#' @examples
#' \dontrun{
#' filesPresent(grapleExp1)
#' }
filesPresent <- function(object){
  if(length(list.files(path = object@ExpRootDir, recursive = FALSE, all.files = TRUE)) - 2 != length(list.dirs(path = object@ExpRootDir, recursive = FALSE))) # all.files = TRUE for Checking Hidden Files, -2 for Excluding . and ..
    return(TRUE)
  else
    return(FALSE)
}

#' checks if a given file exists in a directory
#' @param dirPath A Directory path
#' @param fileName File name
#' @return A boolean value indicating whether a file is present or not
#' @export
#' @keywords internal
#' @examples
#' filePresent('C:/ExpRoot/Exp1/mySim', 'met_hourly.csv')
filePresent <- function(dirPath, fileName){
  filesList <- list.files(path = dirPath, recursive = FALSE)
  if(fileName %in% filesList)
    return(TRUE)
  else
    return(FALSE)
}

#' Checks if a json file is valid according to GRAPLEr constraints
#' @param jsonFilePath JSON File path
#' @return A boolean value indicating whether the json file is valid
#' @export
#' @keywords internal
#' @importFrom jsonlite fromJSON
#' @examples
#' \dontrun{
#' validate_json('C:/ExpRoot/Exp3/job_desc.json')
#' }
validate_json <- function(jsonFilePath)
{
  valid_JSON <- TRUE
  distribution_type <- ''
  distribution_types <- list('uniform', 'binomial', 'normal', 'poisson')

  jsonFile <- fromJSON(jsonFilePath, simplifyVector = FALSE)

  num_iterations <- jsonFile$num_iterations

  if(is.null(num_iterations))
    distribution_type <- 'linear'
  else
    distribution_type <- 'non-linear'

  if(is.null(jsonFile$ExpFiles))
    return(list(valid_JSON, distribution_type))

  if(distribution_type == 'linear')  {
    steps = 1
    for (expFile in 1:length(jsonFile$ExpFiles)) {
      for (vb in 1:length(jsonFile$ExpFiles[[expFile]]$variables[[1]])) {
        distribution = jsonFile$ExpFiles[[expFile]]$variables[[1]][[vb]]$distribution
        if(is.null(distribution) || distribution != 'linear'){
          valid_JSON <- FALSE
          break
        }
        else if (distribution == 'linear'){
          var_steps = jsonFile$ExpFiles[[expFile]]$variables[[1]][[vb]]$steps
          if(is.null(steps)){
            valid_JSON <- FALSE
            break
          }
          else{
            steps = steps * (var_steps + 1)
          }
        }
      }
    }
    if(steps >= 100000)
      valid_JSON <- FALSE
  }
  else if(distribution_type == 'non-linear'){
    for (expFile in 1:length(jsonFile$ExpFiles)) {
      for (vb in 1:length(jsonFile$ExpFiles[[expFile]]$variables[[1]])) {
        distribution = jsonFile$ExpFiles[[expFile]]$variables[[1]][[vb]]$distribution
        if(is.null(distribution) || !(distribution %in% distribution_types)){
          valid_JSON <- FALSE
          break
        }
      }
    }
  }
  else
  {
    valid_JSON <- FALSE
  }
  return(list(valid_JSON, distribution_type))
}

#' An S4 class to represent a graple object.
#'
#' @slot GWSURL            A SubmissionURL for the experiment having a default value of https://graple.acis.ufl.edu
#' @slot ExpRootDir        Experiment Root Directory path
#' @slot ResultsDir        Directory path for storing the results
#' @slot JobID             Unique identifier for the experiment
#' @slot Email             Email address to send notifications
#' @slot APIKey            API Key to authenticate a user
#' @slot SimsPerJob        A number indicating the number of simulations bundled into a worker job
#' @slot StatusCode        Integer value indicating the status of an operation
#' @slot StatusMsg         A brief text message indicating the status of an operation
#' @slot ExpName           A name for the experiment
#' @slot TempDir           Temporary Directory path for temporary storage of files
#' @slot Retention         A user provided request to the GRAPLEr cluster on duration for which experiment results should be retained
#' @slot Client_Version_ID The version of GRAPLEr package being used
#' @importFrom methods new
#' @exportClass Graple
Graple <- setClass("Graple", slots = c(GWSURL = "character", ExpRootDir="character", ResultsDir="character", JobID="character", Email="character",
                                       APIKey="character", SimsPerJob="numeric", StatusCode="numeric", StatusMsg="character", ExpName="character", TempDir="character",
                                       Retention ="numeric", Client_Version_ID="character"), prototype = list(GWSURL="https://graple.acis.ufl.edu", Email='', APIKey="0",
                                       SimsPerJob=5, TempDir=tempdir(), Retention = 10, Client_Version_ID = toString(packageVersion("GRAPLEr"))), validity = check_graple)

#' Set the Temporary Directory to given directory path for the Graple Object
#' @param grapleObject A Graple Object
#' @param path Path to a directory to be set as Temporary directory for the experiment
#' @return The status message is updated on Graple object and the Graple object is returned
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' setTempDir(grapleObject, 'C:/TempDir')
#' }
setGeneric(name="setTempDir",
           def=function(grapleObject,path)
           {
             standardGeneric("setTempDir")
           }
)

#' Sets the submission URL in the Graple object
#' @param grapleObject A Graple Object
#' @param url A Submission URL
#' @return The Graple object with updated submissionURL
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' setSubmissionURL(grapleObject, 'https://graple.acis.ufl.edu')
#' }
setGeneric(name="setSubmissionURL",
           def=function(grapleObject,url)
           {
             standardGeneric("setSubmissionURL")
           }
)

#' Sets the name of the experiment in the Graple object
#' @param grapleObject A Graple Object
#' @param expName A Graple Object
#' @return The status message is updated on Graple object and the Graple object is returned
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' setExpName(grapleObject, 'SweepExperiment')
#' }
setGeneric(name="setExpName",
           def=function(grapleObject,expName)
           {
             standardGeneric("setExpName")
           }
)

#' Set the Experiment root directory in the Graple object
#' @param grapleObject A Graple Object
#' @param path Directory path for the experiment root directory
#' @return The status message is updated on Graple object and the Graple object is returned
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' setExperimentDir(grapleObject, 'C:/ExpRoot/Exp1')
#' }
setGeneric(name="setExperimentDir",
           def=function(grapleObject,path)
           {
             standardGeneric("setExperimentDir")
           }
)

#' Sets the results directory for the experiment in the Graple object
#' @param grapleObject A Graple Object
#' @param path Directory path for the results to be downloaded
#' @return The status message is updated on Graple object and the Graple object is returned
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' setResultsDir(grapleObject, 'C:/ExpRoot/Results/Exp1')
#' }
setGeneric(name="setResultsDir",
           def=function(grapleObject,path)
           {
             standardGeneric("setResultsDir")
           }
)

#' Sets the API key in the grapleObject
#' @param grapleObject A Graple Object
#' @param path Path to the a text file containing the security key
#' @return The status message is updated on Graple object and the Graple object is returned
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' setAPIKey(grapleObject, 'C:/ExpRoot/KeyFiles/myKey.txt')
#' }
setGeneric(name="setAPIKey",
           def=function(grapleObject,path)
           {
             standardGeneric("setAPIKey")
           }
)

#' Checks if the graple service is up and running on the submission URL provided
#' @param grapleObject A Graple Object
#' @return The status message is updated on Graple object and the Graple object is returned
#' @importFrom httr GET
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleCheckService(grapleObject)
#' }
setGeneric(name="GrapleCheckService",
           def=function(grapleObject)
           {
             standardGeneric("GrapleCheckService")
           }
)

#' Used to run a batch experiment with mutiple simulations in the root directory
#' also, an optional filter can be run on the results generated
#' @param grapleObject A Graple Object
#' @param filterName An optional post-process filter name
#' @return The status message is updated on Graple object and the Graple object is returned
#' @importFrom httr upload_file POST
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleRunExperiment(grapleObject, 'ExtractVariables')
#' }
setGeneric(name="GrapleRunExperiment",
           def=function(grapleObject, filterName)
           {
             standardGeneric("GrapleRunExperiment")
           }
)

#' Checks the status of an experiment
#' @param grapleObject A Graple Object
#' @return The status message is updated on Graple object and the Graple object is returned
#' @importFrom httr GET
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleCheckExperimentCompletion(grapleObject)
#' }
setGeneric(name="GrapleCheckExperimentCompletion",
           def=function(grapleObject)
           {
             standardGeneric("GrapleCheckExperimentCompletion")
           }
)

#' Downloads the results to the results directory path with exp name/job id as the directory name
#' @param grapleObject A Graple Object
#' @return The status message is updated on Graple object and the Graple object is returned
#' @importFrom httr GET
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleGetExperimentResults(grapleObject)
#' }
setGeneric(name="GrapleGetExperimentResults",
           def=function(grapleObject)
           {
             standardGeneric("GrapleGetExperimentResults")
           }
)

#' Used to run a sweep experiment with a json file providing job description
#' also, an optional filter can be run on the results generated
#' @param grapleObject A Graple Object
#' @param filterName An optional post-process filter name
#' @return The status message is updated on Graple object and the Graple object is returned
#' @importFrom httr upload_file POST
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleRunSweepExperiment(grapleObject)
#' GrapleRunSweepExperiment(grapleObject, 'ExtractVariables')
#' }
setGeneric(name="GrapleRunSweepExperiment",
           def=function(grapleObject, filterName)
           {
             standardGeneric("GrapleRunSweepExperiment")
           }
)

#' A method to abort an experiment
#' @param grapleObject A Graple Object
#' @return A text message with the status of the operation
#' @importFrom httr GET
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleEndExperiment(grapleObject)
#' }
setGeneric(name="GrapleEndExperiment",
           def=function(grapleObject)
           {
             standardGeneric("GrapleEndExperiment")
           }
)

#' Checks if the GRAPLEr pacakge being used is compatible with GWS Service being used
#' @param grapleObject A Graple Object
#' @return A status msg indicating whether Web service and GRAPLEr are compatible
#' and the Graple object is returned
#' @importFrom httr GET
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleChkVersionCompatibility(grapleObject)
#' }
setGeneric(name="GrapleChkVersionCompatibility",
           def=function(grapleObject)
           {
             standardGeneric("GrapleChkVersionCompatibility")
           }
)

#' Provides a list of post processing operations/ filters available
#' @param grapleObject A Graple Object
#' @return Adds the list of filters to StatusMsg and returns the Graple object
#' @importFrom httr GET
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleListPostProcessFilters(grapleObject)
#' }
setGeneric(name="GrapleListPostProcessFilters",
           def=function(grapleObject)
           {
             standardGeneric("GrapleListPostProcessFilters")
           }
)

#' Set the Temporary Directory to given directory path for the Graple Object
#' @param grapleObject A Graple Object
#' @param path Path to a directory to be set as Temporary directory for the experiment
#' @return The status message is updated on Graple object and the Graple object is returned
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' setTempDir(grapleExp1, 'C:/TempDir')
#' }
setMethod(f="setTempDir",
          signature="Graple",
          definition=function(grapleObject,path)
          {
            if(dir.exists(path)){
              grapleObject@TempDir <- path
              grapleObject@StatusCode <- 1
              grapleObject@StatusMsg <- "Temporary directory set to directory provided"
            }
            else{
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "Temporary directory provided does not exist"
            }
            return(grapleObject)
          }
)

#' Sets the submission URL in the Graple object
#' @param grapleObject A Graple Object
#' @param url A Submission URL
#' @return The Graple object with updated submissionURL
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' setSubmissionURL(grapleExp1, 'https://graple.acis.ufl.edu')
#' }
setMethod(f="setSubmissionURL",
          signature="Graple",
          definition=function(grapleObject,url)
          {
            grapleObject@GWSURL <- url
            return(grapleObject)
          }
)

#' Sets the name of the experiment in the Graple object
#' @param grapleObject A Graple Object
#' @param expName A Graple Object
#' @return The status message is updated on Graple object and the Graple object is returned
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' setExpName(grapleObject, 'SweepExperiment')
#' }
setMethod(f="setExpName",
          signature="Graple",
          definition=function(grapleObject,expName)
          {
            if(length(expName) > 0)
            {
              grapleObject@ExpName <- expName
              grapleObject@StatusCode <- 1
              grapleObject@StatusMsg <- "Experiment name set to the name provided"
            }
            else
            {
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "Invalid Experiment Name"
            }
            return(grapleObject)
          }
)

#' Set the Experiment root directory in the Graple object
#' @param grapleObject A Graple Object
#' @param path Directory path for the experiment root directory
#' @return The status message is updated on Graple object and the Graple object is returned
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' setExperimentDir(grapleObject, 'C:/ExpRoot/Exp1')
#' }
setMethod(f="setExperimentDir",
          signature="Graple",
          definition=function(grapleObject,path)
          {
            if(length(path) > 0)
            {
              grapleObject@ExpRootDir <- path
              if(!dir.exists(grapleObject@ExpRootDir))
              {
                grapleObject@ExpRootDir <- character(0)
                grapleObject@StatusCode <- -1
                grapleObject@StatusMsg <- "Experiment root directory provided does not exist"
              }
              else if(length(grapleObject@ResultsDir) > 0 && !check_subdirectory(grapleObject))
              {
                grapleObject@ExpRootDir <- character(0)
                grapleObject@StatusCode <- -1
                grapleObject@StatusMsg <- "Exp Root Dir/Result directory is a sub-directory of Result/Input"
              }
              else
              {
                grapleObject@StatusCode <- 1
                grapleObject@StatusMsg <- "Experiment root directory has been set to directory provided"
              }
            }
            return(grapleObject)
          }
)

#' Sets the results directory for the experiment in the Graple object
#' @param grapleObject A Graple Object
#' @param path Directory path for the results to be downloaded
#' @return The status message is updated on Graple object and the Graple object is returned
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' setResultsDir(grapleObject, 'C:/ExpRoot/Results/Exp1')
#' }
setMethod(f="setResultsDir",
          signature="Graple",
          definition=function(grapleObject,path)
          {
            if(length(path) > 0)
            {
              grapleObject@ResultsDir <- path
              if(!dir.exists(grapleObject@ResultsDir))
              {
                grapleObject@StatusCode <- -1
                grapleObject@StatusMsg <- "Results directory provided does not exist"
              }
              else if(length(grapleObject@ExpRootDir) > 0 && !check_subdirectory(grapleObject))
              {
                grapleObject@StatusCode <- -1
                grapleObject@StatusMsg <- "Exp Root Dir/Result directory is a sub-directory of Result/Input"
              }
              else
              {
                grapleObject@ResultsDir <- path
                grapleObject@StatusCode <- 1
                grapleObject@StatusMsg <- "Experiment results directory has been set to directory provided"
              }
            }
            return(grapleObject)
          }
)

#' Sets the API key in the grapleObject
#' @param grapleObject A Graple Object
#' @param path Path to the a text file containing the API key
#' @return The status message is updated on Graple object and the Graple object is returned
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' setAPIKey(grapleExp1, 'C:/ExpRoot/KeyFiles/myKey.txt')
#' }
setMethod(f="setAPIKey",
          signature="Graple",
          definition=function(grapleObject,path)
          {
            if(length(path) > 0)
            {
              if(!file.exists(path))
              {
                grapleObject@StatusCode <- -1
                grapleObject@StatusMsg <- "File provided does not exist"
              }
              else
              {
                grapleObject@APIKey <- readLines(path)
                grapleObject@StatusCode <- 1
                grapleObject@StatusMsg <- "API Key has been successfully set"
              }
            }
            return(grapleObject)
          }
)

#' Checks if the graple service is up and running on the submission URL provided
#' @param grapleObject A Graple Object
#' @return The status message is updated on Graple object and the Graple object is returned
#' @importFrom httr GET
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleCheckService(grapleExp1)
#' }
setMethod(f="GrapleCheckService",
          signature="Graple",
          definition=function(grapleObject)
          {
            qurl<-paste(grapleObject@GWSURL, "service_status", sep="/")
            status<- GET(qurl)
            grapleObject@StatusCode <- 1
            grapleObject@StatusMsg <- paste(content(status)$status,content(status)$time)
            return(grapleObject)
          }
)

#' Used to run a batch experiment with mutiple simulations in the root directory
#' also, an optional filter can be run on the results generated
#' @param grapleObject A Graple Object
#' @param filterName An optional post-process filter name
#' @return The status message is updated on Graple object and the Graple object is returned
#' @importFrom httr upload_file POST
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleRunExperiment(grapleExp1, 'ExtractVariables')
#' }
setMethod(f="GrapleRunExperiment",
          signature="Graple",
          definition=function(grapleObject, filterName)
          {
            if(length(grapleObject@ExpRootDir)<=0 || !dir.exists(grapleObject@ExpRootDir)){
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "Experiment root directory provided does not exist"
            }
            else if(filesPresent(grapleObject)){
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "Experiment root directory should contain only directories (no files) for this experiment. Check for any files/hidden files there."
            }
            else if(!missing(filterName) && !dir.exists(paste(grapleObject@ExpRootDir, "FilterParams", sep="/"))){
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "Experiment Root Directory should consist of FilterParams Directory"
            }
            else if(!missing(filterName) && dir.exists(paste(grapleObject@ExpRootDir, "FilterParams", sep="/")) && !filePresent(paste(grapleObject@ExpRootDir, "FilterParams", sep = "/"), "FilterParams.json")){
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "The Filter Params directory does not contain FilterParams.json"
            }
            else
            {
              if(length(grapleObject@TempDir)<=0 || !dir.exists(grapleObject@TempDir)){
                grapleObject@TempDir <- tempdir()
              }
              td<-getwd()
              setwd(grapleObject@TempDir)
              if(file.exists("sim.tar.gz")) file.remove("sim.tar.gz")
              tarfile = file.path(getwd(), "sim.tar.gz")
              setwd(grapleObject@ExpRootDir)
              tar(tarfile, ".", compression="gz", compression_level = 6, tar="internal")
              qurl <- paste(grapleObject@GWSURL, "GrapleRun", sep="/")
              if(!missing(filterName))
                postresp <- POST(qurl, body = list(retention = grapleObject@Retention, expname = getResultsDirName(grapleObject), email = grapleObject@Email, apikey = grapleObject@APIKey, simsperjob = grapleObject@SimsPerJob, filter = filterName, files = upload_file(tarfile)), encode = "multipart")
              else
                postresp <- POST(qurl, body = list(retention = grapleObject@Retention, expname = getResultsDirName(grapleObject), email = grapleObject@Email, apikey = grapleObject@APIKey, simsperjob = grapleObject@SimsPerJob, files = upload_file(tarfile)), encode = "multipart")
              response <- content(postresp)

              grapleObject@JobID <- ''
              grapleObject@StatusCode <- -1
              if(nchar(response$errors) > 0) {
                grapleObject@StatusMsg <- response$errors
              } else if(nchar(response$uid) == 40) {
                grapleObject@JobID <- toString(response$uid)
                grapleObject@StatusCode <- 1
                grapleObject@StatusMsg <- paste("The simulation was submitted successfully. JobID: ", grapleObject@JobID, sep = '')
              } else {
                grapleObject@StatusMsg <- "Unknown error"
              }
              if(nchar(response$warnings) > 0)
                  grapleObject@StatusMsg <- paste(grapleObject@StatusMsg, "\nWARNING:", response$warnings)

              if (file.exists(tarfile)) file.remove(tarfile)
              setwd(td)

            }
            return (grapleObject)
          }
)

#' Checks the status of an experiment
#' @param grapleObject A Graple Object
#' @return The status message is updated on Graple object and the Graple object is returned
#' @importFrom httr GET
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleCheckExperimentCompletion(grapleExp1)
#' }


setMethod(f="GrapleCheckExperimentCompletion",
          signature="Graple",
          definition=function(grapleObject)
          {
            qurl <- paste(grapleObject@GWSURL, "GrapleRunStatus", grapleObject@JobID, sep="/")
            grapleObject@StatusCode <- -1
            status <- content(GET(qurl, query = list(apikey = grapleObject@APIKey)))

            if(nchar(status$errors) > 0)
              grapleObject@StatusMsg <- status$errors
            else {
              grapleObject@StatusCode <- 1
              grapleObject@StatusMsg <- status$curr_status
            }
            return (grapleObject)
          }
)

#' Downloads the results to the results directory path with exp name/job id as the directory name
#' @param grapleObject A Graple Object
#' @return The status message is updated on Graple object and the Graple object is returned
#' @importFrom httr GET
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleGetExperimentResults(grapleExp1)
#' }
setMethod(f="GrapleGetExperimentResults",
          signature="Graple",
          definition=function(grapleObject)
          {
            if(length(grapleObject@ResultsDir)<=0 || !dir.exists(grapleObject@ResultsDir))
            {
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "Results directory provided does not exist."
            }
            else if(length(grapleObject@JobID) <= 0)
            {
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "No JobID, Experiment Job ID not provided."
            }
            else if(getResultsDirName(grapleObject) %in% list.files(grapleObject@ResultsDir))
            {
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- paste("A directory with the same name as ExpName/JobID found in results directory. Please remove it and try again.", sep ="")
            }
            else{
              if(length(grapleObject@TempDir)<=0 || !dir.exists(grapleObject@TempDir)){
                grapleObject@TempDir <- tempdir()
              }
              td<-getwd()
              qurl<-paste(grapleObject@GWSURL, "GrapleRunResults", grapleObject@JobID, sep="/")
              grapleObject@StatusCode <- -1
              getresp <- GET(qurl, query = list(apikey = grapleObject@APIKey))
               status <- fromJSON(content(getresp, "text", encoding = "UTF-8"))
              if(nchar(status$errors) > 0)
                  grapleObject@StatusMsg <- status$errors
              else if(status$status == "success"){
                qurl <- paste(grapleObject@GWSURL, status$output_url, sep="")
                resultfile <- file.path(grapleObject@TempDir, "results.tar.gz")
                GET(qurl, write_disk(resultfile, overwrite=TRUE))
                setwd(grapleObject@TempDir)
                resultPath <- paste(grapleObject@ResultsDir, getResultsDirName(grapleObject), sep="/")
                dir.create(resultPath)
                file.copy("results.tar.gz", resultPath)
                file.remove("results.tar.gz")
                setwd(resultPath)
                untar("results.tar.gz")
                file.remove("results.tar.gz")
                setwd(td)
                grapleObject@StatusCode <- 1
                grapleObject@StatusMsg <- paste('The results have been downloaded to: ', resultPath, sep ="")
              }
            }
            return(grapleObject)
          }
)

#' Used to run a sweep experiment with a json file providing job description
#' also, an optional filter can be run on the results generated
#' @param grapleObject A Graple Object
#' @param filterName An optional post-process filter name
#' @return The status message is updated on Graple object and the Graple object is returned
#' @importFrom httr upload_file POST
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleRunSweepExperiment(grapleExp1)
#' GrapleRunSweepExperiment(grapleExp1, 'ExtractVariables')
#' }
setMethod(f="GrapleRunSweepExperiment",
          signature="Graple",
          definition=function(grapleObject, filterName)
          {
            if(length(grapleObject@ExpRootDir)<=0 || !dir.exists(grapleObject@ExpRootDir)){
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "Experiment root directory provided does not exist"
            }
            else if(!filePresent(grapleObject@ExpRootDir, "job_desc.json")){
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "A job description file should be present with name job_desc.json in the ExpRootDir"
            }
            else if(!as.logical(validate_json(paste(grapleObject@ExpRootDir, "job_desc.json", sep="/"))[1])){
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "Invalid job_desc file"
            }
            else if(length(list.dirs(path = grapleObject@ExpRootDir, recursive = FALSE)) > 0 && missing(filterName)){
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "Experiment root directory should not contain any directories for this experiment"
            }
            else if(length(list.dirs(path = grapleObject@ExpRootDir, recursive = FALSE)) > 1 && !missing(filterName)){
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "Experiment root directory should contain only files and FilterParams Directory"
            }
            else if(length(list.dirs(path = grapleObject@ExpRootDir, recursive = FALSE)) == 1 && !missing(filterName) && list.dirs(path = grapleObject@ExpRootDir, recursive = FALSE, full.names = FALSE)[1] != "FilterParams"){
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- "Experiment root directory should contain directory with name FilterParams"
            }
            else{
              if(length(grapleObject@TempDir)<=0 || !dir.exists(grapleObject@TempDir)){
                grapleObject@TempDir <- tempdir()
              }
              td<-getwd()
              setwd(grapleObject@TempDir)
              if(file.exists("sweepexp.tar.gz")) file.remove("sweepexp.tar.gz")
              tarfile = file.path(getwd(), "sweepexp.tar.gz")
              setwd(grapleObject@ExpRootDir)
              tar(tarfile, ".", compression="gz", compression_level = 6, tar="internal")
              distribution_type <- validate_json(paste(grapleObject@ExpRootDir, "job_desc.json", sep="/"))[2]
              if(distribution_type == 'non-linear')
                qurl <- paste(grapleObject@GWSURL, "GrapleRunMetSample", sep="/")
              else
                qurl <- paste(grapleObject@GWSURL, "GrapleRunLinearSweep", sep="/")
              grapleObject@JobID <- ''
              grapleObject@StatusCode <- -1
              if(!missing(filterName))
                subresp <- POST(qurl, body = list(retention = grapleObject@Retention, expname = getResultsDirName(grapleObject), email = grapleObject@Email, apikey = grapleObject@APIKey, simsperjob = grapleObject@SimsPerJob, filter = filterName, files = upload_file(tarfile)), encode = "multipart")
              else
                subresp <- POST(qurl, body = list(retention = grapleObject@Retention, expname = getResultsDirName(grapleObject), email = grapleObject@Email, apikey = grapleObject@APIKey, simsperjob = grapleObject@SimsPerJob, files = upload_file(tarfile)), encode = "multipart")
              response <- content(subresp)

              if(nchar(response$errors) > 0) {
                grapleObject@StatusMsg <- response$errors
              } else if(nchar(response$uid) == 40) {
                grapleObject@JobID <- toString(response$uid)
                grapleObject@StatusCode <- 1
                grapleObject@StatusMsg <- paste("The simulation was submitted successfully. JobID: ", grapleObject@JobID, sep = '')
              } else {
                grapleObject@StatusMsg <- "Unknown error"
              }
              if(nchar(response$warnings) > 0)
                  grapleObject@StatusMsg <- paste(grapleObject@StatusMsg, "\nWARNING:", response$warnings)

              if (file.exists(tarfile)) file.remove(tarfile)
              setwd(td)
            }
            return (grapleObject)
          }
)

#' A method to abort an experiment
#' @param grapleObject A Graple Object
#' @return A text message with the status of the operation
#' @importFrom httr GET
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleEndExperiment(grapleExp1)
#' }
setMethod(f="GrapleEndExperiment",
          signature="Graple",
          definition=function(grapleObject)
          {
            qurl <- paste(grapleObject@GWSURL, "GrapleEnd", grapleObject@JobID, sep="/")
            status<- GET(qurl, query = list(apikey = grapleObject@APIKey))
            return (fromJSON(content(status, "text")))
          }
)

#' Checks if the GRAPLEr pacakge being used is compatible with GWS Service being used
#' @param grapleObject A Graple Object
#' @return A status msg indicating whether Web service and GRAPLEr are compatible
#' and the Graple object is returned
#' @importFrom httr GET
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleChkVersionCompatibility(grapleExp1)
#' }
setMethod(f="GrapleChkVersionCompatibility",
          signature="Graple",
          definition=function(grapleObject)
          {
            if(!length(grapleObject@Client_Version_ID) > 0){
              grapleObject@Client_Version_ID <- packageVersion("GRAPLEr")
            }
            qurl <- paste(grapleObject@GWSURL, "GrapleGetVersion", sep="/")
            status <- GET(qurl)
            compatibleGRAPLEVersions <- fromJSON(content(status, "text"))
            if(grapleObject@Client_Version_ID %in% compatibleGRAPLEVersions){
              grapleObject@StatusCode <- 1
              grapleObject@StatusMsg <- 'GRAPLE Web Service and GRAPLEr are compatible.'
            }
            else{
              grapleObject@StatusCode <- -1
              grapleObject@StatusMsg <- paste('GRAPLE Web Service and GRAPLEr are not compatible. Compatible versions are: ', compatibleGRAPLEVersions, sep="")
            }
            return(grapleObject)
          }
)

#' Provides a list of post processing operations/ filters available
#' @param grapleObject A Graple Object
#' @return Adds the list of filters to StatusMsg and returns the Graple object
#' @importFrom httr GET
#' @export
#' @examples
#' \dontrun{
#' grapleObject <- Graple(ExpRootDir="C:/InputDirectory", ResultsDir="C:/ResultsDirectory", TempDir = tempdir())
#' GrapleListPostProcessFilters(grapleExp1)
#' }
setMethod(f="GrapleListPostProcessFilters",
          signature="Graple",
          definition=function(grapleObject)
          {
            qurl <- paste(grapleObject@GWSURL, "GrapleListFilters", sep="/")
            status <- GET(qurl)
            grapleObject@StatusCode <- 1
            grapleObject@StatusMsg <- paste('Available post-process filters: ', toString(fromJSON(content(status, "text"))), sep = "")
            return(grapleObject)
          }
)
GRAPLE/GRAPLEr documentation built on Oct. 7, 2020, 4:12 p.m.