Split out BaseScenario; fixed samples+tests; may not need explicit St…

…artFrom. BaseScenario grabs the RunParam_ls rather than the Datastore/ModelState_ls
VisionEval · Apr 28, 2023 · 21cc904 · 21cc904
1 parent 7aac8ff
commit 21cc904
Show file tree

Hide file tree

Showing 6 changed files with 156 additions and 110 deletions.
diff --git a/sources/framework/VEModel/R/models.R b/sources/framework/VEModel/R/models.R
@@ -582,26 +582,10 @@ ve.model.initstages <- function( modelStages, updateCheck=TRUE ) {
     # Also fix up scenario Elements (adding to base stage...)
     startFromNames <- unlist(sapply(modelStages,function(s) s$StartFrom))
     if ( length(startFromNames) > 0 ) {
-      startFromNames <- startFromNames[ nzchar(startFromNames) ]
+      startFromNames <- unique(startFromNames[ nzchar(startFromNames) ])
     }
     stageNames <- names(modelStages)
-    scenarios <- self$scenarios()
     reportable <- ! stageNames %in% startFromNames # default reportable to stages that are not ancestors (will include scenarios)
-    if ( length(scenarios$stages()) > 0 ) {
-      reportable <- reportable | sapply( stageNames, function(n) scenarios$reportable(n) ) # Add scenario StartFrom back in
-      sapply(
-        modelStages[reportable],
-        function(s) {
-          if ( ! s$IsScenario ) { # reportable stage is not associated with Scenarios
-            # Probably the StartFrom stage / Base scenario
-            elementNames <- names(scenarios$Elements) # may be NULL
-            s$ScenarioElements <- rep("0",length(elementNames))
-            names(s$ScenarioElements) <- elementNames
-          }
-          NULL
-        }
-      )
-    }
     for ( r in seq_along(stageNames) ) {
       stage <- modelStages[[r]]
       if ( ! isTRUE(stage$Reportable) ) {

diff --git a/sources/framework/VEModel/R/scenarios.R b/sources/framework/VEModel/R/scenarios.R
@@ -28,7 +28,7 @@ ve.scenario.init <- function( baseModel=NULL, reloadFile=FALSE ) {
 # Then build whatever model stages are defined there
 ve.scenario.load <- function(reloadFile=FALSE) {
 
-  if ( ! reloadFile && ! ( is.list(self$modelStages) || length(self$modelStages)==0 ) ) {
+  if ( ! reloadFile && is.list(self$modelStages) && length(self$modelStages)>0 ) {
     writeLog("Skipping scenario initialization due to existing modelStages and not reloading",Level="info")
     return(NULL) # do not reload model stages
   }
@@ -40,28 +40,57 @@ ve.scenario.load <- function(reloadFile=FALSE) {
 
   # Layer in the base run parameters as basis for scenarios
 
+  # Set up the BaseScenario
+  # The BaseScenario is where to look for default inputs for the scenarios defined here, if that is
+  #   different from where the StartFrom stage gets its inputs. It does not need to be defined
+  #   unless the default scenario lacks the necessary inputs
+  # The BaseScenario can be defined as one of the explicit scenario ModelStages in this scenario set
+  # It is also used as the baseline scenario if categories and scenario elements are defined, and
+  #   it will later be set up with "0" categories and marked Reportable if it is not already.
+
+  if ( ! "BaseScenario" %in% names(self$loadedParam_ls) ) {
+    if ( "InputPath" %in% names(self$loadedParam_ls) && grepl("^#",self$loadedParam_ls$InputPath[1]) ) {
+      baseScenarioName <- sub("^#","",self$loadedParam_ls$InputPath[1])
+      self$loadedParam_ls[["InputPath"]] <- NULL # Remove the input path
+    } else baseScenarioName <- NULL
+  } else baseScenarioName <- self$loadedParam_ls$BaseScenario
+
+  self$baseScenario <- if ( ! is.null(baseScenarioName) ) {
+    if ( baseScenarioName %in% names(self$baseModel$modelStages) ) {
+      self$baseModel$modelStages[[ baseScenarioName ]]
+    }
+  } else NULL # No base scenario defined
+
   # If StartFrom is defined in the scenario RunParam_ls, use the parameters from that stage as the
   # basis for the current scenarios. Otherwise, just load the parameters from the base model,
   # expecting to fill in the required missing ones here.
-  if ( "StartFrom" %in% names(self$loadedParam_ls) ) {
-    writeLog("Getting scenario base parameters from StartFrom",Level="info")
-    startFrom <- self$baseModel$modelStages[[ self$loadedParam_ls$StartFrom ]]
-    baseParam_ls <- startFrom$loadedParam_ls
-    # Drop keys that we will force stages here to define
-    baseParam_ls <- baseParam_ls[ - which( names(baseParam_ls) %in% c("Scenario","Description","ModelStages") ) ]
+  # Usually, StartFrom will be the base year stage in the base model. Don't StartFrom the future
+  # year, since that will unpleasantly also include its Datastore.
+  if ( !is.null( self$baseScenario ) ) {
+    writeLog(paste("Getting scenario base parameters from BaseScenario=",self$baseScenario$Name),Level="info")
+    baseParam_ls <- self$baseScenario$loadedParam_ls
+  } else if ( "StartFrom" %in% names(self$loadedParam_ls) ) {
+    writeLog(paste("Getting scenario base parameters from StartFrom=",self$loadedParam_ls$StartFrom),Level="info")
+    self$startFrom <- self$baseModel$modelStages[[ self$loadedParam_ls$StartFrom ]]
+    baseParam_ls <- self$startFrom$loadedParam_ls
   } else {
+    self$startFrom <- NULL
     writeLog("Getting scenario base parameters from BaseModel",Level="info")
     baseParam_ls <- self$baseModel$loadedParam_ls
   }
+  # Drop keys that we will force stages here to define
+  baseParam_ls <- baseParam_ls[ - which( names(baseParam_ls) %in% c("Scenario","Description","ModelStages") ) ]
 
   # Now add the loaded scenario parameters (scenarioParams, but possibly others)
   modelParam_ls <- visioneval::mergeParameters(baseParam_ls,self$loadedParam_ls)
 
   # Load different types of scenarios and build ModelStages for them
   writeLog("Loading model Scenarios",Level="info")
 
-  # Explicit ModelStages are defined first (available to use as StartFrom for Category stages)
-  # These will use the top-level StartFrom for the scenarios
+  # Explicit ModelStages are defined first (available to use as StartFrom for Categories
+  # These can pre-build certain input combinations...
+  # These will use the top-level StartFrom
+  # One of them can be designated the BaseScenario
   if ( "ModelStages" %in% names(self$loadedParam_ls) ) {
     writeLog(paste("Parsing explicit Scenarios from",self$scenarioDir),Level="info")
     modelStages <- lapply(names(self$loadedParam_ls$ModelStages), # Use pre-defined structures
@@ -79,10 +108,30 @@ ve.scenario.load <- function(reloadFile=FALSE) {
         )
       }
     )
-    names(modelStages) <- names(self$loadedParam_ls$ModelStages) # so we can look up the category StartFrom
+    names(modelStages) <- names(self$loadedParam_ls$ModelStages)
   } else modelStages <- list()
   self$modelStages <- modelStages
 
+  # Use the baseScenario's InputPath and failing that, the StartFrom InputPath.
+  # If neither of those is present, inherit whatever InputPath exists in the Base Model
+  # Both of those may get culled out later - we're not worrying about path duplications, just the order
+  # Later on, we'll also add category and scenario elements to the BaseScenario if those have been constructed.
+  if ( ! is.null(self$baseScenario) ) {
+    baseInputPath <- self$baseScenario$loadedParam_ls$InputPath
+    inputSource <- "scenarios BaseScenario"
+  } else if ( ! is.null(self$startFrom) ) {
+    baseInputPath <- self$startFrom$loadedParam_ls$InputPath
+    inputSource <- "scenarios StartFrom"
+  } else {
+    baseInputPath <- NULL
+    inputSource <- NULL
+  }
+
+  if ( is.character(baseInputPath) ) {
+    # Override whatever InputPath may have been loaded
+    self$loadedParam_ls <- visioneval::addRunParameter(self$loadedParam_ls,Source=inputSource,InputPath=baseInputPath)
+  }
+
   # Trigger for combination scenarios is presence of ScenarioElements
   # Must be in the scenario's visioneval.cnf (not inherited)
   if ( "ScenarioElements" %in% names(self$loadedParam_ls) ) {
@@ -284,7 +333,7 @@ ve.scenario.load <- function(reloadFile=FALSE) {
 
     # Convert Category-Level construction to ModelStage objects
     # Remove Scenario/Description inherited from "StartFrom" model run parameters
-    modelParam_ls <- modelParam_ls[ ! names(modelParam_ls) %in% c("Scenario","Description","ScenarioElements") ]
+    modelParam_ls <- modelParam_ls[ ! names(modelParam_ls) %in% c("Scenario","Description","ScenarioCategories","ScenarioElements") ]
     # Construct model stages
     categoryStages <- lapply(scenarioList,
       function(stage) {
@@ -300,44 +349,57 @@ ve.scenario.load <- function(reloadFile=FALSE) {
         )
       }
     )
-    self$modelStages <- c( self$modelStages, categoryStages ) # preserve local StartFrom, if any
+    self$modelStages <- c( self$modelStages, categoryStages )
+
+    # Finally, return to the BaseScenario and give it the zero-level for each ScenarioElement
+    if ( length(categoryStages) > 0 && !is.null(self$baseScenario) ) {
+      elementNames <- names(self$Elements) # may be NULL
+      self$baseScenario$ScenarioElements <- rep("0",length(elementNames))
+      names(self$baseScenario$ScenarioElements) <- elementNames
+      self$baseScenario$Reportable <- TRUE # Base Scenario must be reportable
+    }
+    # Also set the overall StartFrom stage to Reportable (if it was defined)
+    if ( !is.null(self$startFrom) ) self$startFrom$Reportable <- TRUE
+
   } else {
+    # This is probably too confusing, so we're requiring scenarios to be explicitly designated.
     # If still no stage definitions in the configuration, try to do folder-based stages (only)
-    if ( length(self$modelStages)==0 && ! any(c("ModelStages","ScenarioCategories") %in% names(modelParam_ls)) ) {
-      # Attempt to make sub-folders of self$scenarioPath into stages
-      # In general, to avoid errors with random sub-directories becoming stages
-      #  it is best to explicitly set ModelStages in the model's main visioneval.cnf
-      writeLog("Parsing implicit Scenarios from directories",Level="info")
-      stages <- list.dirs(self$scenarioPath,full.names=FALSE,recursive=FALSE)
-      structuralDirs <- c(
-        self$baseModel$setting("DatastoreName"),
-        self$baseModel$setting("QueryDir"),
-        self$baseModel$setting("ScriptsDir"),
-        self$baseModel$setting("InputDir"),
-        self$baseModel$setting("ParamDir"),
-        self$baseModel$setting("ScenarioDir"),
-        self$baseModel$setting("ResultsDir")
-      )
-      stages <- stages[ ! stages %in% structuralDirs ]
-      writeLog(paste0("Scenario Stage directories:\n",paste(stages,collapse=",")),Level="info")
-      self$modelStages <- lapply(stages,
-        function(stage) {
-          stageParam_ls <- list(
-            Dir=stage,                              # Relative to modelPath
-            Name=stage,                             # Will only change root directory
-            Path=file.path(self$scenarioPath,stage),# Root for stage inputs
-            IsScenario=TRUE                         # Mark it as a scenario
-          )
-          VEModelStage$new(
-            Name = stageParam_ls$Name,
-            Model = self$baseModel,
-            ScenarioDir=self$scenarioPath,
-            modelParam_ls=modelParam_ls,
-            stageParam_ls=stageParam_ls
-          )
-        }
-      )
-    }
+    #
+    #     if ( length(self$modelStages)==0 && ! any(c("ModelStages","ScenarioCategories") %in% names(modelParam_ls)) ) {
+    #       # Attempt to make sub-folders of self$scenarioPath into stages
+    #       # In general, to avoid errors with random sub-directories becoming stages
+    #       #  it is best to explicitly set ModelStages in the model's main visioneval.cnf
+    #       writeLog("Parsing implicit Scenarios from directories",Level="info")
+    #       stages <- list.dirs(self$scenarioPath,full.names=FALSE,recursive=FALSE)
+    #       structuralDirs <- c(
+    #         self$baseModel$setting("DatastoreName"),
+    #         self$baseModel$setting("QueryDir"),
+    #         self$baseModel$setting("ScriptsDir"),
+    #         self$baseModel$setting("InputDir"),
+    #         self$baseModel$setting("ParamDir"),
+    #         self$baseModel$setting("ScenarioDir"),
+    #         self$baseModel$setting("ResultsDir")
+    #       )
+    #       stages <- stages[ ! stages %in% structuralDirs ]
+    #       writeLog(paste0("Scenario Stage directories:\n",paste(stages,collapse=",")),Level="info")
+    #       self$modelStages <- lapply(stages,
+    #         function(stage) {
+    #           stageParam_ls <- list(
+    #             Dir=stage,                              # Relative to modelPath
+    #             Name=stage,                             # Will only change root directory
+    #             Path=file.path(self$scenarioPath,stage),# Root for stage inputs
+    #             IsScenario=TRUE                         # Mark it as a scenario
+    #           )
+    #           VEModelStage$new(
+    #             Name = stageParam_ls$Name,
+    #             Model = self$baseModel,
+    #             ScenarioDir=self$scenarioPath,
+    #             modelParam_ls=modelParam_ls,
+    #             stageParam_ls=stageParam_ls
+    #           )
+    #         }
+    #       )
+    #     }
   }
 
   # If self$Elements is undefined, scenarios are just the individual modelStages
@@ -418,17 +480,6 @@ ve.scenario.stages <- function() {
   return( self$modelStages )
 }
 
-# Return TRUE or FALSE depending on whether the indicated stage name is the Scenario StartFrom
-# In a scenario-bearing model, only the startFrom stage will be Reportable from the Base Model
-ve.scenario.reportable <- function(stageName) {
-  startFrom <- self$RunParam_ls$StartFrom
-  return(
-    is.character(startFrom) &&
-    is.character(stageName) &&
-    stageName==startFrom
-  )
-}
-
 # TODO: Add a "verify" function (perhaps just a flag on "build" that says to report
 # inconsistencies without doing anything to repair them). It makes sure that all listed
 # Scenarios and Categories are complete (Scenarios in each Category must be distinct - in the
@@ -623,18 +674,18 @@ VEModelScenarios <- R6::R6Class(
     loadedParam_ls = NULL,                # Scenario parameters as loaded from configFile (or to be rewritten)
     RunParam_ls = NULL,                   # RunParam_ls for Scenarios (runtime)
     modelStages = list(),                 # list of VEModelStage object, built during $load, empty if undefined/invalid
-    startFrom = NULL,                     # ModelStage to start from (from config, set during $load)
     invalidStages = list(),               # List of diagnostics (generated during "load" by calling "verify")
     Elements = NULL,                      # list of ScenarioELements for this scenario set
     Categories = NULL,                    # list of ScenarioCategories for this scenario set
+    startFrom = NULL,                     # Overall ModelStage to start from (category stages may start from modelStages here)
+    baseScenario = NULL,                  # name of baseModel stage from whose inputs the defined scenarios pivot
 
     # Functions
     initialize=ve.scenario.init,          # Initializes VEModelScenarios object
     load=ve.scenario.load,                # loads ScenarioDir/ScenarioConfig
     stages=ve.scenario.stages,            # Returns list of VEModelStage representing scenarios
     verify=ve.scenario.verify,            # Returns scenario diagnostics
     build=ve.scenario.build,              # If Category/Scenario defined, will create any missing directories/files then return verify
-    reportable=ve.scenario.reportable,    # Returns TRUE if the supplied stage name is the Scenario StartFrom stage, else FALSE
     print=ve.scenario.print,              # Display scenario configuration
     inputs=ve.scenario.inputs,            # Set/View list of inputs by category (or just list of files if no categories)
     categories=ve.scenario.categories,    # Return categories, or replace/update them (optionally save config to .csv files)

diff --git a/sources/framework/VEModel/inst/models/VERSPM/scenarios-cat/visioneval-commented.cnf b/sources/framework/VEModel/inst/models/VERSPM/scenarios-cat/visioneval-commented.cnf
@@ -2,7 +2,8 @@ ConfigDocs:
   - "Intended to extend VERSPM-pop model variant"
   - "Adjust StartFrom to respect your model"
 
-StartFrom: "stage-pop-future"       # StartFrom stage for ModelStages (adjust for your model)
+StartFrom   : "stage-pop-base"       # StartFrom stage for ModelStages (adjust for your model)
+BaseScenario: "stage-pop-future"     # Stage providing InputPath (optional: if not present use StartFrom)
 
 ModelStagesDocs:
   ModelStages:

diff --git a/sources/framework/VEModel/inst/models/VERSPM/scenarios-cat/visioneval.cnf b/sources/framework/VEModel/inst/models/VERSPM/scenarios-cat/visioneval.cnf
@@ -1,4 +1,5 @@
-StartFrom: "stage-pop-future"       # StartFrom stage for ModelStages (adjust for your model)
+StartFrom   : "stage-pop-base"       # StartFrom stage for ModelStages (adjust for your model)
+BaseScenario: "stage-pop-future"     # Stage providing InputPath (optional: if not present use StartFrom)
 
 ScenarioElements:
   - Name: B

diff --git a/sources/framework/VEModel/inst/models/VERSPM/scenarios-ms/visioneval.cnf b/sources/framework/VEModel/inst/models/VERSPM/scenarios-ms/visioneval.cnf
@@ -8,8 +8,11 @@ Notes:
     included. It is bad practice to include an unmodified file in the scenario ModelStages inputs
   - ScenarioCategories / ScenarioElements are auto-generated for the visualizer - a single Category,
     with one level mapping directly to each ModelStage
+  - StartFrom stage provides InputPath and Datastore (it is usually the Base Year stage)
+  - BaseScenario just provides InputPath (and it is the "null case" for Category Scenarios)
 
-StartFrom: "stage-pop-future"       # StartFrom stage for ModelStages (adjust for your model)
+StartFrom    : "stage-pop-base"       # Provides data elements
+BaseScenario : "stage-pop-future"     # Provides InputPath (optional: if not present use StartFrom or BaseModel)
 
 ModelStages:
   "Design-1":

diff --git a/sources/framework/VEModel/tests/test.R b/sources/framework/VEModel/tests/test.R
@@ -995,7 +995,7 @@ test_05_query_extract <- function(log="info") {
 test_05_build_query <- function(log="info",break.query=TRUE,reset=FALSE) {
   # Process the standard query list for the test model
   # If multiple==TRUE, copy the test model and its results a few times, then submit the
-  # list of all the copies to VEQuery. Each column of results will be the same (see
+  # list of all the columnopies to VEQuery. Each column of results will be the same (see
   # test_06_scenarios for a run that will generate different results in each column).
   # if break.query, do some deliberately bad stuff to see the error messages
 
@@ -1727,6 +1727,7 @@ test_06_scenarios <- function(
   run=useStages,
   querySpec="VERSPM-scenarios",
   install=FALSE,
+  multicore=TRUE, # or set to number of workers (default is 3)
   log="info"
 ) {
   logLevel(log)
@@ -1736,35 +1737,40 @@ test_06_scenarios <- function(
   testStep(paste("Selecting, installing, and running scenarios as",if(useStages)"Model Stages"else"Scenario Combinations"))
 
   existingModel <- dir.exists(modelPath <- file.path("models",scenarioModelName))
-  mod <- test_01_run(scenarioModelName,baseModel="VERSPM",variant=scenarioVariant,reset=install,log=log,confirm=FALSE)
-
-  testStep("Loading scenario query")
-  qr <- mod$query(querySpec) # Fails if model has not been run
-  qf <- qr$QueryFile
-  print(qr)
-  cat("QueryFile:",qf,"\n")
-
-  testStep("Running Query")
-  qr$run(Force=TRUE)
-  print(qr)
-
-  testStep("Examine Query Results")
-  qrr <- qr$results()
-  print(class(qrr))
-  print(length(qrr))
-
-  testStep("Extracting Query Results")
-  qrs <- qr$extract()
-  print(qrs)
-
-  testStep("Exporting Query Results")
-  qr$export()
-
-  testStep("Returning scenario model")
-  print(mod,scenarios=TRUE)
-  return(invisible(list(
-    Model=mod, Query=qr, QueryFile=qf, QueryResults=qrs
-  )))
+  if ( run ) {
+    mod <- test_01_run(scenarioModelName,baseModel="VERSPM",variant=scenarioVariant,reset=install,log=log,confirm=FALSE,multicore=multicore)
+
+    testStep("Loading scenario query")
+    qr <- mod$query(querySpec) # Fails if model has not been run
+    qf <- qr$QueryFile
+    print(qr)
+    cat("QueryFile:",qf,"\n")
+
+    testStep("Running Query")
+    qr$run(Force=TRUE,log="info")
+    print(qr)
+
+    testStep("Examine Query Results")
+    qrr <- qr$results()
+    print(class(qrr))
+    print(length(qrr))
+
+    testStep("Extracting Query Results")
+    qrs <- qr$extract()
+    print(qrs)
+
+    testStep("Exporting Query Results")
+    qr$export()
+
+    testStep("Returning scenario model")
+    print(mod,scenarios=TRUE)
+    return(invisible(list(
+      Model=mod, Query=qr, QueryFile=qf, QueryResults=qrs
+    )))
+  } else {
+    mod <- test_00_install("VERSPM",variant=scenarioVariant,installAs=scenarioModelName,log=log,confirm=FALSE)
+    return(mod)
+  }
 }
 
 test_07_extrafields <- function(reset=FALSE,installSQL=TRUE,log="info") {