Nothing
# Copyright (c) 2024 Apex Resource Management Solution Ltd. (ApexRMS). All rights reserved.
# MIT License
#' @include AAAClassDefinitions.R
NULL
setMethod(
f = "initialize", signature = "Scenario",
definition = function(.Object, ssimLibrary = NULL, project = NULL, name = NULL, id = NULL, sourceScenario = NULL, scenarios = NULL, folder = NULL) {
ProjectID <- NULL
ScenarioID <- NULL
Name <- NULL
# assume this is being called from scenario fn or getFromXProjScn(). ssimObject and pid are valid, id is valid if not null, and duplicate name problems have been sorted out.
.Object@breakpoints <- list()
.Object@parentId <- 0
x <- ssimLibrary
if (is.null(folder)){
folder <- 0
}
# For fast processing - quickly return without system calls if scenario exists
if (is.null(scenarios)) {
scenarios <- getScnSet(x)
}
allScenarios <- scenarios
if (!is.null(name)) {
cName <- name
scenarios <- subset(scenarios, Name == cName)
}
if (!is.null(id)) {
scenarios <- subset(scenarios, ScenarioID == id)
}
if (!is.null(project)) {
scenarios <- subset(scenarios, ProjectID == project)
}
findScn <- subset(scenarios, !is.na(ScenarioID))
if (nrow(findScn) > 1) {
stop("Something is wrong.")
}
# If found only one, open it.
if (nrow(findScn) == 1) {
if (!is.null(sourceScenario)) {
stop("Scenario ", name, " already exists. Delete the scenario before replacing it.")
}
if (findScn$IsResult == "Yes") {
scnNameList <- strsplit(findScn$Name, "[", fixed=TRUE)[[1]]
parentBit <- scnNameList[length(scnNameList)]
parent <- strsplit(parentBit, "]", fixed = TRUE)[[1]][1]
.Object@parentId <- as.numeric(parent)
}
pid <- as.numeric(findScn$ProjectID)
sid <- as.numeric(findScn$ScenarioID)
folderId <- addScenarioToFolder(x, pid, sid, folder)
# Go ahead and create the Scenario object without issuing system commands to make sure it is ok
.Object@session <- .session(x)
.Object@filepath <- .filepath(x)
.Object@datasheetNames <- .datasheets(x, scope = "all", refresh = TRUE)
.Object@scenarioId <- sid
.Object@projectId <- pid
.Object@folderId <- folderId
return(.Object)
}
# If given an id for a scenario that does not yet exist, complain
if (is.null(name)) {
stop(paste0("The library does not contain scenario id ", id, ". Please provide a name for the new scenario - the id will be assigned automatically by SyncroSim."))
}
# Now go ahead to handle odder cases
# Assume pid is valid, and name is defined, not duplicated, etc
# x can be either a project or a library - but need a project in order to create a new scenario
pid <- project
# Create a new scenario
if (is.null(sourceScenario)) {
tt <- command(list(create = NULL, scenario = NULL, lib = .filepath(x), name = name, pid = pid), .session(x))
} else {
sid <- sourceScenario
slib <- .filepath(x)
if (is(sourceScenario, "numeric")) {
if (!is.element(sourceScenario, allScenarios$ScenarioID)) {
stop("Source scenario id ", sourceScenario, " not found in SsimLibrary.")
}
}
if (is(sourceScenario, "character")) {
sourceOptions <- subset(allScenarios, Name == sourceScenario)
if (nrow(sourceOptions) == 0) {
stop(paste0("Source scenario name ", sourceScenario, " not found in SsimLibrary."))
}
if (nrow(sourceOptions) > 1) {
stop(paste0("There is more than one scenario called ", sourceScenario, " in the SsimLibrary. Please provide a sourceScenario id: ", paste(sourceOptions$scenarioId, collapse = ",")))
}
sid <- sourceOptions$ScenarioID
}
if (is(sourceScenario, "Scenario")) {
sid <- .scenarioId(sourceScenario)
slib <- .filepath(sourceScenario)
sourceScnName <- name(sourceScenario)
} else {
sourceScnName <- subset(allScenarios, ScenarioID == sid)$Name
}
if (name == "GetSourceCopyCopyCopy") {
copyName <- paste(sourceScnName, "- Copy")
if (!is.element(copyName, allScenarios$Name)) {
name <- copyName
} else {
done <- FALSE
count <- 0
while (!done) {
count <- count + 1
cName <- paste0(copyName, count)
if (!is.element(cName, allScenarios$Name)) {
name <- cName
done <- TRUE
}
}
}
}
tt <- command(list(copy = NULL, scenario = NULL, slib = slib, tlib = .filepath(x), name = name, sid = sid, pid = pid), .session(x))
}
id <- as.numeric(strsplit(tt, ": ")[[1]][2])
# Move Scenario into folder (if specified)
folderId <- addScenarioToFolder(x, as.numeric(pid), as.numeric(id), folder)
.Object@session <- .session(x)
.Object@filepath <- .filepath(x)
.Object@datasheetNames <- .datasheets(x, refresh = TRUE, scope = "all")
.Object@scenarioId <- as.numeric(id)
.Object@projectId <- as.numeric(pid)
.Object@folderId <- folderId
return(.Object)
}
)
#' Create or open Scenario(s)
#'
#' Create or open one or more \code{\link{Scenario}}s from a
#' \code{\link{SsimLibrary}}.
#'
#' @param ssimObject \code{\link{SsimLibrary}} or \code{\link{Project}} object,
#' or character (i.e. a filepath)
#' @param scenario character, integer, or vector of these. Names or ids of one or
#' more Scenarios. Note integer ids are slightly faster, but can only be
#' used to open existing Scenarios
#' @param sourceScenario character or integer. If not \code{NULL} (Default), new
#' Scenarios will be copies of the sourceScenario
#' @param folder \code{\link{Folder}} object, character, or integer. The Folder object,
#' name (must be unique), or Folder ID. If not \code{NULL} (Default), new
#' Scenarios will be moved into the specified folder
#' @param summary logical. If \code{TRUE} then loads and returns the Scenario(s) in a
#' named vector/dataframe with the scenarioId, name, description, owner,
#' dateModified, readOnly, parentID. Default is \code{TRUE} if \code{scenario=NULL},
#' \code{FALSE} otherwise
#' @param results logical. If \code{TRUE} only return result Scenarios. Default is
#' \code{FALSE}
#' @param forceElements logical. If \code{TRUE} then returns a single Scenario as a named
#' list; if \code{FALSE} (default), returns a single Scenario as a
#' \code{\link{Scenario}} object. Applies only when \code{summary=FALSE}
#' @param overwrite logical. If \code{TRUE} an existing Scenario will be overwritten.
#' Default is \code{FALSE}
#'
#' @return
#' A \code{Scenario} object representing a SyncroSim scenario, a list of Scenario
#' objects, or a data frame of Scenario names and descriptions. If \code{summary = FALSE},
#' returns one or more \code{\link{Scenario}} objects representing SyncroSim Scenarios.
#' If \code{summary = TRUE}, returns Scenario summary info.
#'
#' @details
#'
#' For each element of Scenario:
#' \itemize{
#' \item If element/Project/SsimObject uniquely identifies an existing
#' Scenario: Returns the existing Scenario.
#' \item If element/Project/SsimObject uniquely identifies more than one existing
#' Scenario: Error.
#' \item If element/Project/SsimObject do not identify an existing Scenario or
#' Project: Error.
#' \item If element/Project/SsimObject do not identify an existing Scenario and
#' element is numeric: Error - a name is required for new Scenarios.
#' SyncroSim will automatically assign an id when a Scenario is created.
#' \item If element/Project/SsimObject do not identify an existing Scenario and
#' do identify a Project, and element is a character string: Creates a
#' new Scenario named element in the Project. SyncroSim automatically
#' assigns an id. If sourceScenario is not \code{NULL} the new Scenario will be
#' a copy of sourceScenario.
#' }
#'
#' @examples
#' \dontrun{
#' # Set the file path and name of the new SsimLibrary
#' myLibraryName <- file.path(tempdir(),"testlib")
#'
#' # Set the SyncroSim Session, SsimLibrary, and Project
#' mySession <- session()
#' myLibrary <- ssimLibrary(name = myLibraryName, session = mySession)
#' myProject <- project(myLibrary, project = "My Project")
#'
#' # Create a new Scenario
#' myScenario <- scenario(myProject, scenario = "My Scenario")
#'
#'
#' # Create a new Scenario from an existing Scenario
#' myScenarioCopy <- scenario(myProject, scenario = "My Scenario Copy",
#' sourceScenario = myScenario)
#'
#' # Find all the Scenarios in a SsimLibrary
#' scenario(myLibrary)
#'
#' # Only return the results Scenarios for a SsimLibrary
#' scenario(myLibrary, results = TRUE)
#'
#' # Overwrite an existing Scenario
#' myNewScenario <- scenario(myProject, scenario = "My New Scenario",
#' overwrite = TRUE)
#' }
#'
#' @name scenario
#' @export
scenario <- function(ssimObject = NULL, scenario = NULL, sourceScenario = NULL, folder = NULL, summary = NULL, results = FALSE, forceElements = FALSE, overwrite = FALSE) {
if (is.character(ssimObject) && (ssimObject == SyncroSimNotFound(warn = FALSE))) {
return(SyncroSimNotFound())
}
if (is.null(ssimObject)) {
e <- ssimEnvironment()
ssimObject <- ssimLibrary(e$LibraryFilePath)
scenario <- as.integer(e$ScenarioId)
}
IsResult <- NULL
# if ssimObject is a scenario return the scenario
if (is.element(class(ssimObject), c("Scenario")) & is.null(scenario)) {
if (is.null(summary)) {
summary <- FALSE
}
if (!summary) {
convertObject <- TRUE
returnIds <- FALSE
} else {
convertObject <- FALSE
returnIds <- TRUE
}
} else {
# set summary default
if (is.null(summary)) {
if (is.null(scenario)) {
if (is.null(sourceScenario)) {
summary <- TRUE
} else {
summary <- FALSE
scenario <- "GetSourceCopyCopyCopy"
}
} else {
summary <- FALSE
}
}
convertObject <- FALSE
returnIds <- TRUE
}
xProjScn <- .getFromXProjScn(ssimObject, project = NULL, scenario = scenario, convertObject = convertObject, returnIds = returnIds, goal = "scenario", complainIfMissing = FALSE)
if (is(xProjScn, "Scenario")) {
if (!overwrite) {
return(xProjScn)
}
}
if (!is(xProjScn, "list")) {
stop("something is wrong")
}
ssimObject <- xProjScn$ssimObject
project <- xProjScn$project
scenario <- xProjScn$scenario
allScenarios <- xProjScn$scenarioSet
if (is.element("order", names(allScenarios))) {
scnSet <- subset(allScenarios, !is.na(order))
} else {
if (nrow(allScenarios) > 0) {
allScenarios$order <- seq(1, nrow(allScenarios))
}
scnSet <- allScenarios
}
if (results) {
scnSet <- subset(scnSet, !is.element(IsResult, c(NA, FALSE, "No")))
}
if (nrow(scnSet) == 0) {
if (summary) {
scnSet$exists <- NULL
scnSet$order <- NULL
return(scnSet)
} else {
stop("Error in scenario(): No scenarios to get or make.")
}
}
# if all projects exist and summary, simply return summary
if ((sum(is.na(scnSet$exists)) == 0) & summary) {
scnSet <- subset(scnSet, !is.na(order))
scnSet <- scnSet[order(scnSet$order), ]
scnSet[scnSet$IsReadOnly == "FALSE", "IsReadOnly"] <- "No"
scnSet[scnSet$IsReadOnly == "TRUE", "IsReadOnly"] <- "Yes"
scnSet$exists <- NULL
scnSet$order <- NULL
return(scnSet)
}
# Now assume scenario is defined
# distinguish existing scenarios from those that need to be made
areIds <- is.numeric(scenario)
# if scenarios need to be made, pass all scenarios in library
makeSum <- sum(!is.na(scnSet$order) & is.na(scnSet$exists))
libScns <- subset(allScenarios, !is.na(exists))
if (makeSum > 0) {
if (!is.null(sourceScenario) && (is(sourceScenario, "Scenario"))) {
libScns <- getScnSet(ssimObject) # get all scenarios for library, not just those from ssimObject
# check validity in new("Scenario",...)
}
} else {
if (!is.null(sourceScenario)) {
warning("sourceScenario was ignored because scenario already exists.")
}
}
# make scnenarios/scenario objects
scnsToMake <- subset(scnSet, !is.na(order))
if (overwrite) {
for (i in seq(length.out = nrow(scnsToMake))) {
if (is.na(scnsToMake$exists[i])) {
next
}
ret <- delete(ssimObject, scenario = scnsToMake$ScenarioID[i], force = TRUE)
cRow <- scnsToMake[i, ]
scnsToMake[i, ] <- NA
scnsToMake$Name[i] <- cRow$Name
scnsToMake$ProjectID[i] <- cRow$ProjectID
scnsToMake$order[i] <- cRow$order
}
libScns <- getScnSet(ssimObject)
}
if (summary | results) {
scnsToMake <- subset(scnsToMake, is.na(exists))
}
if (nrow(scnsToMake) == 0) {
fullScnSet <- fullScnSet[order(fullScnSet$order), ]
fullScnSet$exists <- NULL
fullScnSet$order <- NULL
return(fullScnSet)
}
if (results & (nrow(scnsToMake) > 0)) {
stop(paste0("Could not find these scenarios in the ssimObject. To create them, set results=F: ", paste(scnsToMake$Name, collapse = ",")))
}
scnsToMake <- scnsToMake[order(scnsToMake$order), ]
scnList <- list()
for (i in seq(length.out = nrow(scnsToMake))) {
cRow <- scnsToMake[i, ]
if (!is.na(cRow$exists)) {
scnList[[as.character(scnsToMake$ScenarioID[i])]] <- new("Scenario", ssimObject, project = cRow$ProjectID, id = cRow$ScenarioID, scenarios = cRow)
} else {
obj <- new("Scenario", ssimObject, project = cRow$ProjectID, name = cRow$Name, sourceScenario = sourceScenario, scenarios = libScns, folder = folder)
scnList[[as.character(.scenarioId(obj))]] <- obj
}
}
if (!summary) {
if ((length(scnList) == 1) & !forceElements) {
scnList <- scnList[[1]]
}
return(scnList)
}
scnSetOut <- getScnSet(ssimObject)
scnSetOut$exists <- NULL
idList <- data.frame(ScenarioID = as.numeric(names(scnList)), order = seq(1:length(scnList)))
scnSetOut <- merge(idList, scnSetOut, all.x = TRUE)
if (sum(is.na(scnSetOut$Name)) > 0) {
stop("Something is wrong with scenario()")
}
scnSetOut <- scnSetOut[order(scnSetOut$order), ]
scnSetOut$order <- NULL
return(scnSetOut)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.