Nothing
#' @importFrom R6 R6Class
#' @importFrom cli cat_boxx cat_line cat_rule
#' @importFrom data.table rbindlist set setattr setcolorder
#' @importFrom tools file_path_sans_ext
NULL
#' Create and Run Parametric Analysis, and Collect Results
#'
#' `EplusGroupJob` class is a wrapper of [run_multi()] and provides an interface
#' to group multiple EnergyPlus simulations together for running and collecting
#' outputs.
#'
#' @docType class
#' @name EplusGroupJob
#' @author Hongyuan Jia
NULL
#' @export
# EplusGroupJob {{{
EplusGroupJob <- R6::R6Class(classname = "EplusGroupJob", cloneable = FALSE,
public = list(
# INITIALIZE {{{
#' @description
#' Create an `EplusGroupJob` object
#'
#' @param idfs Paths to EnergyPlus IDF files or a list of IDF files and
#' [Idf] objects. If only one IDF supplied, it will be used for
#' simulations with all EPWs.
#' @param epws Paths to EnergyPlus EPW files or a list of EPW files and
#' [Epw] objects. Each element in the list can be `NULL`, which
#' will force design-day-only simulation. Note this needs at
#' least one `Sizing:DesignDay` object exists in that [Idf]. If
#' `epws` is `NULL`, design-day-only simulation will be conducted
#' for all input models. If only one EPW supplied, it will be
#' used for simulations with all IDFs.
#'
#' @return An `EplusGroupJob` object.
#'
#' @examples
#' \dontrun{
#' if (is_avail_eplus(8.8)) {
#' dir <- eplus_config(8.8)$dir
#' path_idfs <- list.files(file.path(dir, "ExampleFiles"), "\\.idf",
#' full.names = TRUE)[1:5]
#' path_epws <- list.files(file.path(dir, "WeatherData"), "\\.epw",
#' full.names = TRUE)[1:5]
#'
#' # create from local files
#' group <- group_job(path_idfs, path_epws)
#'
#' # create from Idfs and Epws object
#' group_job(lapply(path_idfs, read_idf), lapply(path_epws, read_epw))
#' }
#' }
#'
initialize = function(idfs, epws) {
# add Output:SQLite and Output:VariableDictionary if necessary
input <- get_epgroup_input(idfs, epws, sql = TRUE, dict = TRUE)
private$m_idfs <- input$idfs
private$m_epws_path <- input$epws
# log if the input idf has been changed
private$m_log <- new.env(hash = FALSE, parent = emptyenv())
private$m_log$unsaved <- input$sql | input$dict
# save uuid
private$log_idf_uuid()
private$log_new_uuid()
},
# }}}
# PUBLIC FUNCTIONS {{{
# run {{{
#' @description
#' Run grouped simulations
#'
#' @details
#' `$run()` runs all grouped simulations in parallel. The number of
#' parallel EnergyPlus process can be controlled by
#' `eplusr_option("num_parallel")`. If `wait` is FALSE, then the job
#' will be run in the background. You can get updated job status by just
#' printing the `EplusGroupJob` object.
#'
#' @param dir The parent output directory for specified simulations.
#' Outputs of each simulation are placed in a separate folder
#' under the parent directory.
#' @param wait If `TRUE`, R will hang on and wait all EnergyPlus
#' simulations finish. If `FALSE`, all EnergyPlus simulations are
#' run in the background. Default: `TRUE`.
#' @param force Only applicable when the last simulation runs with
#' `wait` equals to `FALSE` and is still running. If `TRUE`,
#' current running job is forced to stop and a new one will
#' start. Default: `FALSE`.
#' @param copy_external If `TRUE`, the external files that current `Idf`
#' object depends on will also be copied into the simulation
#' output directory. The values of file paths in the Idf will be
#' changed automatically. This ensures that the output directory
#' will have all files needed for the model to run. Default is
#' `FALSE`.
#' @param echo Only applicable when `wait` is `TRUE`. Whether to
#' simulation status. Default: same as `wait`.
#' @param separate If `TRUE`, all models are saved in a separate folder
#' with each model's name under `dir` when simulation. If `FALSE`,
#' all models are saved in `dir` when simulation. Default:
#' `TRUE`.
#' @param readvars If `TRUE`, the `ReadVarESO` post-processor will run
#' to generate CSV files from the ESO output. Since those CSV
#' files are never used when extracting simulation data in eplusr,
#' setting it to `FALSE` can speed up the simulation if there are
#' hundreds of output variables or meters. Default: `TRUE`.
#'
#' @return The `EplusGroupJob` object itself, invisibly.
#'
#' @examples
#' \dontrun{
#' # only run design day
#' group$run(NULL)
#'
#' # do not show anything in the console
#' group$run(echo = FALSE)
#'
#' # specify output directory
#' group$run(tempdir(), echo = FALSE)
#'
#' # run in the background
#' group$run(wait = TRUE, echo = FALSE)
#' # see group job status
#' group$status()
#'
#' # force to kill background group job before running the new one
#' group$run(force = TRUE, echo = FALSE)
#'
#' # copy external files used in the model to simulation output directory
#' group$run(copy_external = TRUE, echo = FALSE)
#' }
#'
run = function(dir = NULL, wait = TRUE, force = FALSE, copy_external = FALSE,
echo = wait, separate = TRUE, readvars = TRUE)
epgroup_run(self, private, dir, wait, force, copy_external, echo, separate, readvars),
# }}}
# kill {{{
#' @description
#' Kill current running jobs
#'
#' @details
#' `$kill()` kills all background EnergyPlus processes that are current
#' running if possible. It only works when simulations run in
#' non-waiting mode.
#'
#' @return A single logical value of `TRUE` or `FALSE`, invisibly.
#'
#' @examples
#' \dontrun{
#' group$kill()
#' }
#'
kill = function()
epgroup_kill(self, private),
# }}}
# status {{{
#' @description
#' Get the group job status
#'
#' @details
#' `$status()` returns a named list of values indicates the status of the job:
#'
#' * `run_before`: `TRUE` if the job has been run before. `FALSE` otherwise.
#' * `alive`: `TRUE` if the job is still running in the background. `FALSE`
#' otherwise.
#' * `terminated`: `TRUE` if the job was terminated during last
#' simulation. `FALSE` otherwise. `NA` if the job has not been run yet.
#' * `successful`: `TRUE` if all simulations ended successfully. `FALSE` if
#' there is any simulation failed. `NA` if the job has not been run yet.
#' * `changed_after`: `TRUE` if the models has been modified since last
#' simulation. `FALSE` otherwise.
#' * `job_status`: A [data.table::data.table()] contains meta data
#' for each simulation job. For details, please see [run_multi()]. If the
#' job has not been run before, a [data.table::data.table()]
#' with 4 columns is returned:
#' - `index`: The index of simulation
#' - `status`: The status of simulation. As the simulation has not been run,
#' `status` will always be "idle".
#' - `idf`: The path of input IDF file.
#' - `epw`: The path of input EPW file. If not provided, `NA` will be
#' assigned.
#'
#' @return A named list of 6 elements.
#'
#' @examples
#' \dontrun{
#' group$status()
#' }
#'
status = function()
epgroup_status(self, private),
# }}}
# errors {{{
#' @description
#' Read group simulation errors
#'
#' @details
#' $errors() returns a list of [ErrFile][read_err()] objects which
#' contain all contents of the simulation error files (`.err`). If
#' `info` is `FALSE`, only warnings and errors are printed.
#'
#' @param which An integer vector of the indexes or a character vector
#' or names of parametric simulations. If `NULL`, results of all
#' parametric simulations are returned. Default: `NULL`.
#' @param info If `FALSE`, only warnings and errors are printed.
#' Default: `FALSE`.
#'
#' @return A list of [ErrFile][read_err()] objects.
#'
#' @examples
#' \dontrun{
#' group$errors()
#'
#' # show all information
#' group$errors(info = TRUE)
#' }
#'
errors = function(which = NULL, info = FALSE)
epgroup_output_errors(self, private, which, info),
# }}}
# output_dir {{{
#' @description
#' Get simulation output directory
#'
#' @details
#' `$output_dir()` returns the output directory of simulation results.
#'
#' @param which An integer vector of the indexes or a character vector
#' or names of parametric simulations. If `NULL`, results of all
#' parametric simulations are returned. Default: `NULL`.
#'
#' @return A character vector.
#'
#' @examples
#' \dontrun{
#' # get output directories of all simulations
#' group$output_dir()
#'
#' # get output directories of specified simulations
#' group$output_dir(c(1, 4))
#' }
#'
output_dir = function(which = NULL)
epgroup_output_dir(self, private, which),
# }}}
# list_files {{{
#' @description
#' List all output files in simulations
#'
#' @details
#' `$list_files()` returns all input and output files for the grouped
#' EnergyPlus simulations.
#'
#' Description of all possible outputs from EnergyPlus can be found in
#' EnergyPlus documentation "Output Details and Examples".
#'
#' Below gives a brief summary on the meaning of elements in the
#' returned list.
#'
#' | # | Element | Description |
#' | --- | --- | --- |
#' | 1 | `ads` | EnergyPlus AirflowNetwork related output |
#' | 2 | `audit` | EnergyPlus inputs echo |
#' | 3 | `bnd` | EnergyPlus branch node details |
#' | 4 | `bsmt_audit` | Basement input Echo |
#' | 5 | `bsmt_csv` | Basement CSV output |
#' | 6 | `bsmt_idf` | Basement IDF output |
#' | 7 | `bsmt_out` | Basement Output |
#' | 8 | `cbor` | Energyplus CBOR binary output introduced since v9.5 |
#' | 9 | `dbg` | Energyplus debug output |
#' | 10 | `delight` | EnergyPlus DElight simulation inputs and outputs |
#' | 11 | `dfs` | EnergyPlus daylighting factor for exterior windows |
#' | 12 | `dxf` | EnergyPlus surface drawing output |
#' | 13 | `edd` | EnergyPlus EMS report |
#' | 14 | `eio` | EnergyPlus standard and optional reports |
#' | 15 | `end` | EnergyPlus simulation status in one line |
#' | 16 | `epjson` | EnergyPlus epJSON input converted from IDF |
#' | 17 | `epmdet` | EPMacro inputs echo |
#' | 18 | `epmidf` | EPMacro IDF output |
#' | 19 | `epw` | EnergyPlus Weather File input |
#' | 20 | `err` | EnergyPlus error summarry |
#' | 21 | `eso` | EnergyPlus standard output |
#' | 22 | `experr` | ExpandObjects error summary |
#' | 23 | `expidf` | ExpandObjects IDF output |
#' | 24 | `glhe` | EnergyPlus ground heat exchange file |
#' | 25 | `idf` | EnergyPlus IDF input |
#' | 26 | `imf` | EPMacro IMF input |
#' | 27 | `iperr` | convertESOMTR error summary |
#' | 28 | `ipeso` | convertESOMTR standard output in IP units |
#' | 29 | `ipmtr` | convertESOMTR meter output in IP units |
#' | 30 | `json` | EnergyPlus JSON time series output introduced since v9.5 |
#' | 31 | `log` | EnergyPlus log output |
#' | 32 | `map` | EnergyPlus daylighting intensity map output |
#' | 33 | `mdd` | EnergyPlus meter list |
#' | 34 | `meter` | EnergyPlus meter CSV output |
#' | 35 | `msgpack` | EnergyPlus MessagePack binary output introduced since v9.5 |
#' | 36 | `mtd` | EnergyPlus meter details |
#' | 37 | `mtr` | EnergyPlus meter output |
#' | 38 | `perflog` | EnergyPlus log for `PerformancePrecisionTradeoffs |
#' | 39 | `rdd` | EnergyPlus report variable names |
#' | 40 | `rvaudit` | ReadVarsESO input echo |
#' | 41 | `sci` | EnergyPlus cost benefit calculation information |
#' | 42 | `screen` | EnergyPlus window scrren transmittance map output |
#' | 43 | `shading` | EnergyPlus surface shading CSV output |
#' | 44 | `shd` | EnergyPlus surface shading combination report |
#' | 45 | `slab_ger` | Slab error summary |
#' | 46 | `slab_gtp` | Slab ground temperature output |
#' | 47 | `slab_out` | Slab IDF output |
#' | 48 | `sln` | EnergyPlus `Output:Surfaces:List, Lines` output |
#' | 49 | `sqlite` | EnergyPlus SQLite output |
#' | 50 | `sqlite_err` | EnergyPlus SQLite error summary |
#' | 51 | `ssz` | EnergyPlus system sizing outputs in CSV, TAB or TXT format |
#' | 52 | `svg` | HVAC-Diagram HVAC diagram output |
#' | 53 | `table` | EnergyPlus tabular outputs in CSV, TAB, TXT, HTM, or XML format |
#' | 54 | `variable` | EnergyPlus report variable CSV output |
#' | 55 | `wrl` | EnergyPlus `Output:Surfaces:List, VRML` output |
#' | 56 | `zsz` | EnergyPlus system sizing outputs in CSV, TAB or TXT format |
#' | 57 | `resource` | External file resources used for the simulation, e.g. `Schedule:File` |
#'
#' @param which An integer vector of the indexes or a character vector
#' or names of parametric simulations. If `NULL`, results of all
#' parametric simulations are returned. Default: `NULL`.
#'
#' @param simplify If `TRUE`, a list of character vectors of EnergyPlus
#' input and output file names in the output directory for each
#' simulation is given. If `FALSE`, a
#' [data.table][data.table::data.table()] giving all possible input and
#' output types is given. `NA` is returned if no input or output files
#' are found for that type. Default: `FALSE`.
#'
#' @param full If `TRUE`, the full file paths in the output directory
#' are returned. Otherwise, only the file names are returned. Default:
#' `FALSE`.
#'
#' @return If simplify is `TRUE`, a list. Otherwise, a
#' [data.table][data.table::data.table()] of 3 columns:
#'
#' * `index`: Integer type. Simulation indices.
#' * `type`: Character type. Input or output types. See table above for
#' the meaning
#' * `file`: List type. File names if `full` is `FALSE`. Full file paths
#' if `full` is `TRUE`
#'
#' @examples
#' \dontrun{
#' # list all files in the output directory
#' group$list_files(simplify = TRUE)
#'
#' # get a data.table that contains a full list of all possible inputs
#' # and outputs even though they may not exist for current simulation
#' group$list_files()
#'
#' # return the full paths instead of just file names
#' group$locate_output(full = TRUE)
#' }
#'
list_files = function(which = NULL, simplify = FALSE, full = FALSE)
epgroup_list_files(self, private, which, simplify, full),
# }}}
# locate_output {{{
#' @description
#' Get paths of output file
#'
#' @details
#' `$locate_output()` returns the path of a single output file of specified
#' simulations.
#'
#' @param which An integer vector of the indexes or a character vector
#' or names of parametric simulations. If `NULL`, results of all
#' parametric simulations are returned. Default: `NULL`.
#' @param suffix A string that indicates the file extension of
#' simulation output. Default: `".err"`.
#' @param strict If `TRUE`, it will check if the simulation was
#' terminated, is still running or the file exists or not.
#' Default: `TRUE`.
#'
#' @return A character vector.
#'
#' @examples
#' \dontrun{
#' # get the file path of the error file
#' group$locate_output(c(1, 4), ".err", strict = FALSE)
#'
#' # can detect if certain output file exists
#' group$locate_output(c(1, 4), ".expidf", strict = TRUE)
#' }
#'
locate_output = function(which = NULL, suffix = ".err", strict = TRUE)
epgroup_locate_output(self, private, which, suffix, strict),
# }}}
# list_table {{{
#' @description
#' List all table names in EnergyPlus SQL outputs
#'
#' @details
#' `$list_table()` returns a list of character vectors that contain all
#' available table and view names in the EnergyPlus SQLite files for
#' group simulations. The list is named using IDF names.
#'
#' @param which An integer vector of the indexes or a character vector
#' or names of parametric simulations. If `NULL`, results of all
#' parametric simulations are returned. Default: `NULL`.
#'
#' @return A named list of character vectors.
#'
#' @examples
#' \dontrun{
#' group$list_table(c(1, 4))
#' }
#'
list_table = function(which = NULL)
epgroup_list_table(self, private, which),
# }}}
# read_table {{{
#' @description
#' Read the same table from EnergyPlus SQL outputs
#'
#' @details
#' `$read_table()` takes a simulation index and a valid table `name` of
#' those from
#' \href{../../eplusr/html/EplusGroupJob.html#method-list_table}{\code{$list_table()}}
#' and returns that table data in a [data.table::data.table()] format.
#' The two column will always be `index` and `case` which can be used to
#' distinguish output from different simulations. `index` contains the
#' indices of simulated models and `case` contains the model names
#' without extensions.
#'
#' @param which An integer vector of the indexes or a character vector
#' or names of parametric simulations. If `NULL`, results of all
#' parametric simulations are returned. Default: `NULL`.
#' @param name A single string specifying the name of table to read.
#'
#' @return A [data.table::data.table()].
#'
#' @examples
#' \dontrun{
#' # read a specific table
#' group$read_table(c(1, 4), "Zones")
#' }
#'
read_table = function(which = NULL, name)
epgroup_read_table(self, private, which, name),
# }}}
# read_rdd {{{
#' @description
#' Read Report Data Dictionary (RDD) files
#'
#' @details
#' `$read_rdd()` return the core data of Report Data Dictionary (RDD)
#' files. For details, please see [read_rdd()].
#' The two column will always be `index` and `case` which can be used to
#' distinguish output from different simulations. `index` contains the
#' indices of simulated models and `case` contains the model names
#' without extensions.
#'
#' @param which An integer vector of the indexes or a character vector
#' or names of parametric simulations. If `NULL`, results of all
#' parametric simulations are returned. Default: `NULL`.
#'
#' @return A [data.table::data.table()].
#'
#' @examples
#' \dontrun{
#' group$read_rdd(c(1, 4))
#' }
#'
read_rdd = function(which = NULL)
epgroup_read_rdd(self, private, which),
# }}}
# read_mdd {{{
#' @description
#' Read Meter Data Dictionary (MDD) files
#'
#' @details
#' `$read_mdd()` return the core data of Meter Data Dictionary (MDD)
#' files. For details, please see [read_mdd()].
#' The two column will always be `index` and `case` which can be used to
#' distinguish output from different simulations. `index` contains the
#' indices of simulated models and `case` contains the model names
#' without extensions.
#'
#' @param which An integer vector of the indexes or a character vector
#' or names of parametric simulations. If `NULL`, results of all
#' parametric simulations are returned. Default: `NULL`.
#'
#' @return A [data.table::data.table()].
#'
#' @examples
#' \dontrun{
#' group$read_mdd(c(1, 4))
#' }
#'
read_mdd = function(which = NULL)
epgroup_read_mdd(self, private, which),
# }}}
# report_data_dict {{{
#' @description
#' Read report data dictionary from EnergyPlus SQL outputs
#'
#' @details
#' `$report_data_dict()` returns a [data.table::data.table()] which
#' contains all information about report data.
#'
#' For details on the meaning of each columns, please see "2.20.2.1
#' ReportDataDictionary Table" in EnergyPlus "Output Details and
#' Examples" documentation.
#'
#' @param which An integer vector of the indexes or a character vector
#' or names of parametric simulations. If `NULL`, results of all
#' parametric simulations are returned. Default: `NULL`.
#'
#' @return A [data.table::data.table()] of 10 columns:
#'
#' * `index`: The index of simulated model. This column can be used
#' to distinguish output from different simulations
#' * `case`: The model name without extension. This column can be used
#' to distinguish output from different simulations
#' * `report_data_dictionary_index`: The integer used to link the
#' dictionary data to the variable data. Mainly useful when joining
#' different tables
#' * `is_meter`: Whether report data is a meter data. Possible values:
#' `0` and `1`
#' * `timestep_type`: Type of data timestep. Possible values: `Zone` and
#' `HVAC System`
#' * `key_value`: Key name of the data
#' * `name`: Actual report data name
#' * `reporting_frequency`:
#' * `schedule_name`: Name of the the schedule that controls reporting
#' frequency.
#' * `units`: The data units
#'
#' @examples
#' \dontrun{
#' group$report_data_dict(c(1, 4))
#' }
#'
report_data_dict = function(which = NULL)
epgroup_report_data_dict(self, private, which),
# }}}
# report_data {{{
#' @description
#' Read report data
#'
#' @details
#' `$report_data()` extracts the report data in a
#' [data.table::data.table()] using key values, variable names and other
#' specifications.
#'
#' `$report_data()` can also directly take all or subset output from
#' `$report_data_dict()` as input, and extract all data specified.
#'
#' The returned column numbers varies depending on `all` argument.
#'
#' * `all` is `FALSE`, the returned [data.table::data.table()] has 6 columns:
#' * `index`: The index of simulated model. This column can be used
#' to distinguish output from different simulations
#' * `case`: The model name. This column can be used to distinguish
#' output from different simulations
#' * `datetime`: The date time of simulation result
#' * `key_value`: Key name of the data
#' * `name`: Actual report data name
#' * `units`: The data units
#' * `value`: The data value
#' * `all` is `TRUE`, besides columns described above, extra columns are also
#' included:
#' * `month`: The month of reported date time
#' * `day`: The day of month of reported date time
#' * `hour`: The hour of reported date time
#' * `minute`: The minute of reported date time
#' * `dst`: Daylight saving time indicator. Possible values: `0` and `1`
#' * `interval`: Length of reporting interval
#' * `simulation_days`: Day of simulation
#' * `day_type`: The type of day, e.g. `Monday`, `Tuesday` and etc.
#' * `environment_period_index`: The indices of environment.
#' * `environment_name`: A text string identifying the environment.
#' * `is_meter`: Whether report data is a meter data. Possible values: `0` and
#' `1`
#' * `type`: Nature of data type with respect to state. Possible values: `Sum`
#' and `Avg`
#' * `index_group`: The report group, e.g. `Zone`, `System`
#' * `timestep_type`: Type of data timestep. Possible values: `Zone` and `HVAC
#' System`
#' * `reporting_frequency`: The reporting frequency of the variable, e.g.
#' `HVAC System Timestep`, `Zone Timestep`.
#' * `schedule_name`: Name of the the schedule that controls reporting
#' frequency.
#'
#' With the `datetime` column, it is quite straightforward to apply time-series
#' analysis on the simulation output. However, another painful thing is that
#' every simulation run period has its own `Day of Week for Start Day`. Randomly
#' setting the `year` may result in a date time series that does not have
#' the same start day of week as specified in the RunPeriod objects.
#'
#' eplusr provides a simple solution for this. By setting `year` to `NULL`,
#' which is the default behavior, eplusr will calculate a year value (from
#' year 2017 backwards) for each run period that compliances with the start
#' day of week restriction.
#'
#' It is worth noting that EnergyPlus uses 24-hour clock system where 24 is only
#' used to denote midnight at the end of a calendar day. In EnergyPlus output,
#' "00:24:00" with a time interval being 15 mins represents a time period from
#' "00:23:45" to "00:24:00", and similarly "00:15:00" represents a time period
#' from "00:24:00" to "00:15:00" of the next day. This means that if current day
#' is Friday, day of week rule applied in schedule time period "00:23:45" to
#' "00:24:00" (presented as "00:24:00" in the output) is also Friday, but not
#' Saturday. However, if you try to get the day of week of time "00:24:00" in R,
#' you will get Saturday, but not Friday. This introduces inconsistency and may
#' cause problems when doing data analysis considering day of week value.
#'
#' With `wide` equals `TRUE`, `$report_data()` will format the simulation output
#' in the same way as standard EnergyPlus csv output file. Sometimes this can be
#' useful as there may be existing tools/workflows that depend on this format.
#' When both `wide` and `all` are `TRUE`, columns of runperiod environment names
#' and date time components are also returned, including:
#' `environment_period_index", "environment_name`, `simulation_days`,
#' `datetime`, `month`, `day`, `hour`, `minute`, `day_type`.
#'
#' For convenience, input character arguments matching in
#' `$report_data()` are **case-insensitive**.
#'
#' @param which An integer vector of the indexes or a character vector
#' or names of parametric simulations. If `NULL`, results of all
#' parametric simulations are returned. Default: `NULL`.
#'
#' @param key_value A character vector to identify key values of the
#' data. If `NULL`, all keys of that variable will be returned.
#' `key_value` can also be data.frame that contains `key_value`
#' and `name` columns. In this case, `name` argument in
#' `$report_data()` is ignored. All available `key_value` for
#' current simulation output can be obtained using
#' \href{../../eplusr/html/EplusGroupJob.html#method-report_data_dict}{\code{$report_data_dict()}}.
#' Default: `NULL`.
#'
#' @param name A character vector to identify names of the data. If
#' `NULL`, all names of that variable will be returned. If
#' `key_value` is a data.frame, `name` is ignored. All available
#' `name` for current simulation output can be obtained using
#' \href{../../eplusr/html/EplusGroupJob.html#method-report_data_dict}{\code{$report_data_dict()}}.
#' Default: `NULL`.
#'
#' @param year Year of the date time in column `datetime`. If `NULL`, it
#' will calculate a year value that meets the start day of week
#' restriction for each environment. Default: `NULL`.
#'
#' @param tz Time zone of date time in column `datetime`. Default:
#' `"UTC"`.
#'
#' @param case If not `NULL`, a character column will be added indicates
#' the case of this simulation. If `"auto"`, the name of the IDF
#' file without extension is used.
#'
#' @param all If `TRUE`, extra columns are also included in the returned
#' [data.table::data.table()].
#'
#' @param wide If `TRUE`, the output is formatted in the same way as
#' standard EnergyPlus csv output file.
#'
#' @param period A Date or POSIXt vector used to specify which time
#' period to return. The year value does not matter and only
#' month, day, hour and minute value will be used when
#' subsetting. If `NULL`, all time period of data is returned.
#' Default: `NULL`.
#'
#' @param month,day,hour,minute Each is an integer vector for month,
#' day, hour, minute subsetting of `datetime` column when
#' querying on the SQL database. If `NULL`, no subsetting is
#' performed on those components. All possible `month`, `day`,
#' `hour` and `minute` can be obtained using
#' \href{../../eplusr/html/EplusGroupJob.html#method-read_table}{\code{$read_table(NULL, "Time")}}.
#' Default: `NULL`.
#'
#' @param interval An integer vector used to specify which interval
#' length of report to extract. If `NULL`, all interval will be
#' used. Default: `NULL`.
#'
#' @param simulation_days An integer vector to specify which simulation
#' day data to extract. Note that this number resets after warmup
#' and at the beginning of an environment period. All possible
#' `simulation_days` can be obtained using
#' \href{../../eplusr/html/EplusGroupJob.html#method-read_table}{\code{$read_table(NULL, "Time")}}.
#' If `NULL`, all simulation days will be used. Default: `NULL`.
#'
#' @param day_type A character vector to specify which day type of data
#' to extract. All possible day types are: `Sunday`, `Monday`,
#' `Tuesday`, `Wednesday`, `Thursday`, `Friday`, `Saturday`,
#' `Holiday`, `SummerDesignDay`, `WinterDesignDay`, `CustomDay1`,
#' and `CustomDay2`. All possible values for current simulation
#' output can be obtained using
#' \href{../../eplusr/html/EplusGroupJob.html#method-read_table}{\code{$read_table(NULL, "Time")}}.
#' A few grouped options are also provided:
#'
#' - `"Weekday"`: All working days, i.e. from Monday to Friday
#' - `"Weekend"`: Saturday and Sunday
#' - `"DesignDay"`: Equivalent to `"SummerDesignDay"` plus `"WinterDesignDay"`
#' - `"CustomDay"`: CustomDay1 and CustomDay2
#' - `"SpecialDay"`: Equivalent to `"DesignDay"` plus `"CustomDay"`
#' - `"NormalDay"`: Equivalent to `"Weekday"` and `"Weekend"` plus `"Holiday"`
#'
#' @param environment_name A character vector to specify which
#' environment data to extract. If `NULL`, all environment data
#' are returned. Default: `NULL`. All possible
#' `environment_name` for current simulation output can be
#' obtained using:
#' ```
#' $read_table(NULL, "EnvironmentPeriods")
#' ```
#'
#' @return A [data.table::data.table()].
#'
#' @examples
#' \dontrun{
#' # read report data
#' group$report_data(c(1, 4))
#'
#' # specify output variables using report data dictionary
#' dict <- group$report_data_dict(1)
#' group$report_data(c(1, 4), dict[units == "C"])
#'
#' # specify output variables using 'key_value' and 'name'
#' group$report_data(c(1, 4), "environment", "site outdoor air drybulb temperature")
#'
#' # explicitly specify year value and time zone
#' group$report_data(c(1, 4), dict[1], year = 2020, tz = "Etc/GMT+8")
#'
#' # get all possible columns
#' group$report_data(c(1, 4), dict[1], all = TRUE)
#'
#' # return in a format that is similar as EnergyPlus CSV output
#' group$report_data(c(1, 4), dict[1], wide = TRUE)
#'
#' # return in a format that is similar as EnergyPlus CSV output with
#' # extra columns
#' group$report_data(c(1, 4), dict[1], wide = TRUE, all = TRUE)
#'
#' # only get data at the working hour on the first Monday
#' group$report_data(c(1, 4), dict[1], hour = 8:18, day_type = "monday", simulation_days = 1:7)
#' }
#'
report_data = function(which = NULL, key_value = NULL, name = NULL,
year = NULL, tz = "UTC", all = FALSE, wide = FALSE,
period = NULL, month = NULL, day = NULL, hour = NULL, minute = NULL,
interval = NULL, simulation_days = NULL, day_type = NULL,
environment_name = NULL)
epgroup_report_data(self, private, which,
key_value = key_value, name = name, year = year, tz = tz, all = all, wide = wide,
period = period, month = month, day = day, hour = hour, minute = minute,
interval = interval, simulation_days = simulation_days, day_type = day_type,
environment_name = environment_name
),
# }}}
# tabular_data {{{
#' @description
#' Read tabular data
#'
#' @details
#' `$tabular_data()` extracts the tabular data in a
#' [data.table::data.table()] using report, table, column and row name
#' specifications. The returned [data.table::data.table()] has
#' 9 columns:
#'
#' * `index`: The index of simulated model. This column can be used
#' to distinguish output from different simulations
#' * `case`: The model name. This column can be used to distinguish
#' output from different simulations
#' * `index`: Tabular data index
#' * `report_name`: The name of the report that the record belongs to
#' * `report_for`: The `For` text that is associated with the record
#' * `table_name`: The name of the table that the record belongs to
#' * `column_name`: The name of the column that the record belongs to
#' * `row_name`: The name of the row that the record belongs to
#' * `units`: The units of the record
#' * `value`: The value of the record **in string format** by default
#'
#' For convenience, input character arguments matching in
#' `$tabular_data()` are **case-insensitive**.
#'
#' @param which An integer vector of the indexes or a character vector
#' or names of parametric simulations. If `NULL`, results of all
#' parametric simulations are returned. Default: `NULL`.
#'
#' @param report_name,report_for,table_name,column_name,row_name Each is
#' a character vector for subsetting when querying the SQL
#' database. For the meaning of each argument, please see the
#' description above.
#'
#' @param wide If `TRUE`, each table will be converted into the similar
#' format as it is shown in EnergyPlus HTML output file. Default:
#' `FALSE`.
#'
#' @param string_value Only applicable when `wide` is `TRUE`. If
#' `string_value` is `FALSE`, instead of keeping all values as
#' characters, values in possible numeric columns are converted
#' into numbers. Default: the opposite of `wide`. Possible
#' numeric columns indicate column that:
#' * columns that have associated units
#' * columns that contents numbers
#'
#' @return A [data.table::data.table()] with 9 columns (when `wide` is
#' `FALSE`) or a named list of [data.table::data.table()]s where the
#' names are the combination of `report_name`, `report_for` and
#' `table_name`.
#'
#' @examples
#' \dontrun{
#' # read all tabular data
#' group$tabular_data(c(1, 4))
#'
#' # explicitly specify data you want
#' str(group$tabular_data(c(1, 4),
#' report_name = "AnnualBuildingUtilityPerformanceSummary",
#' table_name = "Site and Source Energy",
#' column_name = "Total Energy",
#' row_name = "Total Site Energy"
#' ))
#'
#' # get tabular data in wide format and coerce numeric values
#' str(group$tabular_data(c(1, 4),
#' report_name = "AnnualBuildingUtilityPerformanceSummary",
#' table_name = "Site and Source Energy",
#' column_name = "Total Energy",
#' row_name = "Total Site Energy",
#' wide = TRUE, string_value = FALSE
#' ))
#' }
#'
tabular_data = function(which = NULL, report_name = NULL, report_for = NULL,
table_name = NULL, column_name = NULL, row_name = NULL,
wide = FALSE, string_value = !wide)
epgroup_tabular_data(self, private, which, report_name = report_name,
report_for = report_for, table_name = table_name,
column_name = column_name, row_name = row_name,
wide = wide, string_value = string_value),
# }}}
# print {{{
#' @description
#' Print `EplusGroupJob` object
#'
#' @details
#' `$print()` shows the core information of this `EplusGroupJob`, including the
#' path of IDFs and EPWs and also the simulation job status.
#'
#' `$print()` is quite useful to get the simulation status, especially when
#' `wait` is `FALSE` in `$run()`. The job status will be updated and printed
#' whenever `$print()` is called.
#'
#' @return The `EplusGroupJob` object itself, invisibly.
#'
#' @examples
#' \dontrun{
#' group$print()
#' }
#'
print = function()
epgroup_print(self, private)
# }}}
# }}}
),
private = list(
# PRIVATE FIELDS {{{
m_idfs = NULL,
m_epws_path = NULL,
m_job = NULL,
m_log = NULL,
# }}}
# PRIVATE FUNCTIONS {{{
uuid = function() private$m_log$uuid,
log_new_uuid = function() log_new_uuid(private$m_log),
idf_uuid = function(which = NULL) {
idfs <- if (is.null(which)) private$m_idfs else private$m_idfs[which]
vcapply(idfs, function(idf) get_priv_env(idf)$uuid())
},
log_idf_uuid = function(which = NULL) {
if (is.null(which)) which <- seq_along(private$m_idfs)
private$m_log$idf_uuid[which] <- private$idf_uuid(which)
},
cached_idf_uuid = function(which = NULL) {
if (is.null(which)) which <- seq_along(private$m_log$idf_uuid)
private$m_log$idf_uuid[which]
},
is_unsaved = function() private$m_log$unsaved,
log_saved = function(which = NULL) log_saved(private$m_log, which),
log_unsaved = function(which = NULL) log_unsaved(private$m_log, which)
# }}}
)
)
# }}}
#' Create An EnergyPlus Parametric Simulation Job
#'
#' `group_job()` takes IDFs and EPWs as input and returns a `EplusGroupJob`.
#'
#' @param idfs Paths to EnergyPlus IDF files or a list of IDF files and [Idf]
#' objects.
#' @param epws Paths to EnergyPlus EPW files or a list of EPW files and [Epw]
#' objects. Each element in the list can be `NULL`, which will force
#' design-day-only simulation when [`$run()`][EplusGroupJob] method is
#' called. Note this needs at least one `Sizing:DesignDay` object exists
#' in that [Idf]. If `epws` is `NULL`, design-day-only simulation will be
#' conducted for all input models.
#' @return A `EplusGroupJob` object.
#' @seealso [eplus_job()] for creating an EnergyPlus single simulation job.
#' @export
#' @name EplusGroupJob
# group_job {{{
group_job <- function(idfs, epws) {
EplusGroupJob$new(idfs, epws)
}
# }}}
# epgroup_run {{{
epgroup_run <- function(self, private, output_dir = NULL, wait = TRUE,
force = FALSE, copy_external = FALSE, echo = wait,
separate = TRUE, readvars = TRUE) {
# check if generated models have been modified outside
uuid <- private$idf_uuid()
if (any(i <- uuid != private$cached_idf_uuid())) {
warn(paste0(
"Some of the grouped models have been modified. ",
"Running these models will result in simulation outputs that may be not reproducible. ",
paste0(" # ", seq_along(uuid)[i], " | ", names(uuid)[i], collapse = "\n")
), "group_model_modified")
private$log_unsaved(which(i))
}
private$log_new_uuid()
epgroup_run_models(self, private, output_dir, wait, force, copy_external, echo, separate, readvars)
}
# }}}
# epgroup_run_models {{{
#' @importFrom checkmate test_names
epgroup_run_models <- function(self, private, output_dir = NULL, wait = TRUE,
force = FALSE, copy_external = FALSE, echo = wait,
separate = TRUE, readvars = TRUE) {
assert_flag(wait)
assert_flag(echo)
assert_flag(separate)
assert_flag(readvars)
path_idf <- vcapply(private$m_idfs, function(idf) idf$path())
if (checkmate::test_names(names(private$m_idfs))) {
# for parametric job
nms <- paste0(make_filename(names(private$m_idfs)), ".idf")
} else {
nms <- basename(path_idf)
}
if (is.null(private$m_epws_path)) {
path_epw <- NULL
design_day <- TRUE
} else {
path_epw <- private$m_epws_path
if (length(path_epw) == 1L) {
path_epw <- rep(path_epw, length(path_idf))
}
design_day <- is.na(path_epw)
}
if (is.null(output_dir))
output_dir <- dirname(path_idf)
else if (length(output_dir) == 1L) {
output_dir <- rep(output_dir, length(path_idf))
} else {
assert_same_len(path_idf, output_dir)
}
output_dir <- normalizePath(output_dir, mustWork = FALSE)
if (any(!dir.exists(uniq_dir <- unique(output_dir)))) {
dir_to_create <- uniq_dir[!dir.exists(uniq_dir)]
create_dir <- vlapply(dir_to_create, dir.create, showWarnings = FALSE, recursive = TRUE)
# nocov start
if (any(!create_dir)) {
abort(paste0("Failed to create output directory: ", collapse(dir_to_create)[!create_dir]))
}
# nocov end
}
# check if the model is still running
proc <- private$m_job
if (!is.null(proc)) {
# check if running in non-waiting mode
if (inherits(proc, "process") && proc$is_alive()) {
pid <- proc$get_pid()
if (force) {
verbose_info("Force to kill all current running parametric simulations (",
"Parent R Process PID: ", pid, ") and restart...")
suppressMessages(self$kill())
} else {
abort(paste0("Current parametric simulations are still running (Parent R Process PID: ",
pid, "). Please set `force` to TRUE if you want ",
"to kill the running process and restart."))
}
}
}
if (separate) {
path_group <- normalizePath(file.path(output_dir, tools::file_path_sans_ext(nms), nms), mustWork = FALSE)
} else {
path_group <- normalizePath(file.path(output_dir, nms), mustWork = FALSE)
}
if (any(to_save <- path_group != path_idf | private$is_unsaved())) {
# remove duplications
dup <- duplicated(path_group)
apply2(private$m_idfs[to_save & !dup], path_group[to_save & !dup],
function(x, y) x$save(y, overwrite = TRUE, copy_external = copy_external)
)
private$log_idf_uuid(which(to_save))
private$log_saved(which(to_save))
}
# reset status
private$m_log$start_time <- current()
private$m_log$killed <- NULL
private$m_job <- NULL
ver <- vcapply(private$m_idfs, function(idf) as.character(idf$version()))
# init job table
jobs <- pre_job_inputs(path_group, path_epw, NULL, design_day, FALSE, ver)
if (!copy_external) {
set(jobs, NULL, "resources", list())
} else {
# check if external file dependencies are found
resrc <- lapply(private$m_idfs, function(idf) {
deps <- idf$external_deps()
if (!length(deps)) deps <- NULL
deps
})
set(jobs, NULL, "resources", resrc)
}
options <- list(num_parallel = eplusr_option("num_parallel"), echo = echo,
expand_obj = TRUE, readvars = readvars)
state <- list(jobs = jobs, options = options)
if (wait) {
private$m_job <- run_sim_event_loop(state)
} else {
# always echo in order to catch standard output and error
state$options$echo <- TRUE
private$m_job <- callr::r_bg(
function(state) run_sim_event_loop(state),
args = list(state = state), package = TRUE
)
}
private$log_new_uuid()
if (wait) private$m_log$end_time <- current()
self
}
# }}}
# epgroup_kill {{{
epgroup_kill <- function(self, private) {
if (is.null(private$m_job)) {
verbose_info("The parametric job is not running.")
return(invisible(FALSE))
}
if (!inherits(private$m_job, "process")) {
verbose_info("The parametric job is not running.")
return(invisible(FALSE))
}
proc <- private$m_job
if (!proc$is_alive()) {
verbose_info("The parametric job is not running.")
return(invisible(FALSE))
}
k <- tryCatch(proc$kill(), error = function(e) FALSE)
if (isTRUE(k)) {
verbose_info("The parametric job has been successfully killed.")
private$m_log$killed <- TRUE
return(invisible(TRUE))
} else {
verbose_info("Failed to kill parametric job, because it was already finished/dead.")
return(invisible(FALSE))
}
}
# }}}
# epgroup_status {{{
epgroup_status <- function(self, private) {
status <- list(
run_before = FALSE, # if the model has been run before
alive = FALSE, # if simulation is still running
terminated = NA, # if last simulation was terminated
successful = NA, # if last simulation was successful
changed_after = NA, # if the seed model has been changed after last simulation
job_status = data.table() # if no simulation has been run
)
proc <- private$m_job
if (is.null(private$m_job)) {
if (!is.null(private$m_idfs)) {
status$job_status <- data.table(
index = seq_along(private$m_idfs),
status = "idle",
idf = vcapply(private$m_idfs, function(idf) idf$path())
)
if (is.null(private$m_epws_path)) {
epw <- NA_character_
} else {
epw <- vcapply(private$m_epws_path, function(epw) if (is.null(epw)) NA_character_ else epw)
}
set(status$job_status, NULL, "epw", epw)
}
return(status)
}
status$run_before <- TRUE
if (isTRUE(private$m_log$killed)) {
status$terminated <- TRUE
} else {
status$terminated <- FALSE
}
status$changed_after <- FALSE
uuid <- private$idf_uuid()
if (any(private$cached_idf_uuid() != uuid)) {
status$changed_after <- TRUE
}
# for parametric job
if (is_idf(private$m_seed) && !identical(private$seed_uuid(), get_priv_env(private$m_seed)$uuid())) {
status$changed_after <- TRUE
}
if (inherits(proc, "r_process")) {
if (proc$is_alive()) {
status$alive <- TRUE
} else {
status$alive <- FALSE
proc$wait()
exit_status <- proc$get_exit_status()
# retrieve results
res <- tryCatch(proc$get_result(), error = function(e) data.table())
if (!is.null(res)) {
# update job
private$m_job <- res
# process the raw table
status$job_status <- post_process_sim_state(res)
}
# only if all simulation ran successfully
if (!is.na(exit_status) && exit_status == 0L &&
nrow(status$job_status) && all(status$job_status$exit_status == 0L)) {
status$successful <- TRUE
} else {
status$successful <- FALSE
}
}
} else {
status$alive <- FALSE
status$successful <- all(proc$jobs$exit_status == 0L)
status$job_status <- post_process_sim_state(proc)
}
status
}
# }}}
# epgroup_output_dir {{{
epgroup_output_dir <- function(self, private, which = NULL) {
epgroup_job_from_which(self, private, which, keep_unsucess = TRUE)$output_dir
}
# }}}
# epgroup_list_files {{{
epgroup_list_files <- function(self, private, which = NULL, simplify = FALSE, full = FALSE) {
assert_flag(simplify)
assert_flag(full)
jobs <- epgroup_job_from_which(self, private, which, keep_unsucess = TRUE)
jobs <- jobs[, .SD, .SDcols = c("index", "output_dir", "result")]
set(jobs, NULL, "file", lapply(jobs$result, "[[", "file"))
set(jobs, NULL, "result", NULL)
if (simplify) {
files <- lapply(jobs$file, function(f) {
files <- unlist(f, FALSE, FALSE)
files[!is.na(files)]
})
if (full) {
files <- apply2(jobs$output_dir, files, use.names = FALSE,
function(dir, file) normalizePath(file.path(dir, file), mustWork = FALSE)
)
}
} else {
if (!full) {
files <- jobs[, by = "index", {
list(type = names(file[[1L]]), file = file[[1L]])
}]
} else {
files <- jobs[, by = "index", {
file <- file[[1L]]
type <- names(file)
file <- lapply(file, function(f) {
if (all(is.na(f))) {
f
} else {
normalizePath(file.path(output_dir, f), mustWork = FALSE)
}
})
list(type = type, file = file)
}]
}
}
files
}
# }}}
# epgroup_locate_output {{{
epgroup_locate_output <- function(self, private, which = NULL, suffix = ".err", strict = TRUE, keep_unsucess = FALSE) {
job <- epgroup_job_from_which(self, private, which, keep_unsucess = keep_unsucess)
out <- paste0(tools::file_path_sans_ext(job$model), suffix)
if (strict && any(!file.exists(out))) {
msg <- job[!file.exists(out), get_sim_status_string("MISSING", index, model, weather)]
stop("Path does not exist for job:\n", paste0(msg, collapse = "\n"), call. = FALSE)
}
out
}
# }}}
# epgroup_output_errors {{{
epgroup_output_errors <- function(self, private, which, info = FALSE) {
# continue to parse err file for jobs having non-zero exits (#24)
path_err <- epgroup_locate_output(self, private, which, ".err", keep_unsucess = TRUE)
err <- lapply(path_err, parse_err_file)
names(err) <- epgroup_case_from_which(self, private, which, name = TRUE)
if (!info) err <- lapply(err, function(x) x[!(level == "Info")])
err
}
# }}}
# epgroup_list_table {{{
epgroup_list_table <- function(self, private, which = NULL) {
cases <- epgroup_case_from_which(self, private, which, name = TRUE)
lists <- lapply(epgroup_sql_path(self, private, which), list_sql_table)
setattr(lists, "names", cases)[]
}
# }}}
# epgroup_read_table {{{
epgroup_read_table <- function(self, private, which = NULL, table) {
tables <- lapply(epgroup_sql_path(self, private, which), read_sql_table, table)
epgroup_combine_data(self, private, which, tables)[]
}
# }}}
# epgroup_read_rdd {{{
epgroup_read_rdd <- function(self, private, which = NULL) {
rdds <- lapply(epgroup_rdd_path(self, private, which, "rdd"), read_rdd)
epgroup_combine_data(self, private, which, rdds)[]
}
# }}}
# epgroup_read_mdd {{{
epgroup_read_mdd <- function(self, private, which = NULL) {
mdds <- lapply(epgroup_rdd_path(self, private, which, "mdd"), read_mdd)
epgroup_combine_data(self, private, which, mdds)[]
}
# }}}
# epgroup_report_data_dict {{{
epgroup_report_data_dict <- function(self, private, which) {
dicts <- lapply(epgroup_sql_path(self, private, which), get_sql_report_data_dict)
epgroup_combine_data(self, private, which, dicts)[]
}
# }}}
# epgroup_report_data {{{
epgroup_report_data <- function(self, private, which = NULL, key_value = NULL,
name = NULL, year = NULL, tz = "GMT", all = FALSE, wide = FALSE,
period = NULL, month = NULL, day = NULL, hour = NULL, minute = NULL,
interval = NULL, simulation_days = NULL, day_type = NULL,
environment_name = NULL) {
rbindlist(Map(get_sql_report_data,
sql = epgroup_sql_path(self, private, which),
index = epgroup_case_from_which(self, private, which, name = FALSE),
case = epgroup_case_from_which(self, private, which, name = TRUE),
MoreArgs = list(
key_value = key_value, name = name, all = all, wide = wide, year = year,
tz = tz, period = period, month = month, day = day, hour = hour, minute = minute,
interval = interval, simulation_days = simulation_days, day_type = day_type,
environment_name = environment_name
),
USE.NAMES = FALSE
), fill = TRUE)
}
# }}}
# epgroup_tabular_data {{{
epgroup_tabular_data <- function(self, private, which = NULL, report_name = NULL, report_for = NULL,
table_name = NULL, column_name = NULL, row_name = NULL,
wide = FALSE, string_value = !wide) {
l <- Map(get_sql_tabular_data,
sql = epgroup_sql_path(self, private, which),
index = epgroup_case_from_which(self, private, which, name = FALSE),
case = epgroup_case_from_which(self, private, which, name = TRUE),
MoreArgs = list(
report_name = report_name, report_for = report_for,
table_name = table_name, column_name = column_name, row_name = row_name,
wide = wide, string_value = string_value
)
)
if (!wide) return(rbindlist(l, fill = TRUE))
nm_all <- unique(unlist(lapply(l, names)))
names(nm_all) <- nm_all
lapply(nm_all, function(nm) {
rbindlist(lapply(l, function(lst) lst[[nm]]), fill = TRUE)
})
}
# }}}
# epgroup_print {{{
epgroup_print <- function(self, private) {
cli::cat_rule("EnergPlus Group Simulation Job", col = "green")
cli::cat_line(paste0("Grouped Jobs [", length(private$m_idfs), "]: "))
epgroup_print_status(self, private)
}
# }}}
# helper
# get_epgroup_input {{{
get_epgroup_input <- function(idfs, epws, sql = TRUE, dict = TRUE) {
# check idf {{{
if (is_idf(idfs)) {
idfs <- list(get_init_idf(idfs, sql = sql, dict = dict))
} else {
init_idf <- function(...) {
tryCatch(get_init_idf(...),
eplusr_error_idf_not_local = function(e) e,
eplusr_error_idf_path_not_exist = function(e) e,
eplusr_error_idf_not_saved = function(e) e
)
}
idfs <- lapply(idfs, init_idf, sql = sql, dict = dict)
}
err <- c("eplusr_error_idf_not_local", "eplusr_error_idf_path_not_exist", "eplusr_error_idf_not_saved")
if (any(invld <- vlapply(idfs, inherits, err))) {
abort(paste0("Invalid IDF input found:\n",
paste0(lpad(paste0(" #", which(invld))), ": ", vcapply(idfs[invld], conditionMessage),
collapse = "\n"
)
))
}
sql <- vlapply(idfs, attr, "sql")
dict <- vlapply(idfs, attr, "sql")
# }}}
# check epw paths {{{
get_epw <- function(epw) if (is.null(epw)) NA_character_ else get_init_epw(epw)
epws <- lapply(epws, function(x) {
tryCatch(get_epw(x),
eplusr_error_epw_not_local = function(e) e,
eplusr_error_epw_path_not_exist = function(e) e,
eplusr_error_epw_not_saved = function(e) e
)
})
err <- c("eplusr_error_epw_not_local", "eplusr_error_epw_path_not_exist", "eplusr_error_epw_not_saved")
if (any(invld <- vlapply(epws, inherits, err))) {
abort(paste0("Invalid EPW input found:\n",
paste0(lpad(paste0(" #", which(invld))), ": ", vcapply(epws[invld], conditionMessage),
collapse = "\n"
)
))
}
if (!length(epws)) epws <- NULL
# }}}
# check length
if (!is.null(epws)) {
epws <- vcapply(epws, `%||%`, NA_character_)
if (length(epws) == 1L) epws <- replicate(length(idfs), epws)
if (length(idfs) == 1L) {
idfs <- replicate(length(epws), idfs[[1L]]$clone())
sql <- rep(sql, length(epws))
dict <- rep(dict, length(epws))
}
assert_same_len(idfs, epws)
}
list(idfs = idfs, epws = epws, sql = sql, dict = dict)
}
# }}}
# epgroup_retrieve_data {{{
epgroup_retrieve_data <- function(self, private, status) {
if (!status$run_before) return(invisible())
if (status$alive) {
private$m_log$stdout <- c(private$m_log$stdout, private$m_job$read_output_lines(10000))
private$m_log$stderr <- c(private$m_log$stderr, private$m_job$read_error_lines(10000))
} else {
if (inherits(private$m_job, "r_process") & !status$terminated) {
private$m_log$stdout <- c(private$m_log$stdout, private$m_job$read_all_output_lines())
private$m_log$stderr <- c(private$m_log$stderr, private$m_job$read_all_error_lines())
}
if (status$successful) {
if (inherits(private$m_job, "r_process")) {
private$m_job <- tryCatch(private$m_job$get_result(),
error = function(e) {
stop("Failed to retrieve output of parametric job. ", e, "\n",
private$m_log$stderr, call. = FALSE)
}
)
}
if (is.null(private$m_log$end_time)) {
end_times <- private$m_job[!is.na(end_time), end_time]
if (length(end_times)) private$m_log$end_time <- max(end_times)
}
}
}
}
# }}}
# epgroup_job_from_which {{{
epgroup_job_from_which <- function(self, private, which, keep_unsucess = FALSE) {
status <- epgroup_status(self, private)
if (!isTRUE(status$run_before))
stop("Parametric job did not run before. Please run it using `$run()` ",
"before collect output", call. = FALSE)
if (isTRUE(status$terminated))
stop("Parametric job was terminated before. Please solve ",
"the problems and re-run it before collect output.", call. = FALSE)
if (isTRUE(status$alive))
stop("Parametric job is still running. Please wait it ",
"to finish before collecting results.", call. = FALSE)
if (isTRUE(status$changed_after))
warning("The seed model has been changed since last run. ",
"The job output may not be correct.", call. = FALSE)
# if success, retrieve data
epgroup_retrieve_data(self, private, status)
jobs <- private$m_job$jobs
idx <- epgroup_case_from_which(self, private, which, name = FALSE)
job <- jobs[idx]
# setting `keep_unsucess` to TRUE makes it possible to continue to parse
# some output files such like .err files. (#24)
if (nrow(job[status != "completed"])) {
incomplete <- job[status != "completed"]
msg <- incomplete[, get_sim_status_string(rpad(toupper(status)), index, model, weather)]
if (keep_unsucess) {
warn(paste0("Some of jobs failed to complete. ",
"Simulation results may not be correct:\n",
paste0(msg, collapse = "\n")
), "job_error")
} else {
abort(paste0("Some of jobs failed to complete. ",
"Please fix the problems and re-run it before collecting output:\n",
paste0(msg, collapse = "\n")
), "job_error")
}
}
job
}
# }}}
# epgroup_case_from_which {{{
#' @importFrom checkmate test_names
epgroup_case_from_which <- function(self, private, which = NULL, name = FALSE) {
if (checkmate::test_named(private$m_idfs)) {
nms <- names(private$m_idfs)
} else {
nms <- vcapply(private$m_idfs, function(idf) tools::file_path_sans_ext(basename(idf$path())))
}
if (is.null(which)) {
if (name) return(nms) else return(seq_along(nms))
}
if (is.character(which)) {
valid <- chmatch(stri_trans_tolower(which), stri_trans_tolower(nms))
if (anyNA(valid))
stop("Invalid job name found: ",
collapse(which[is.na(valid)]), ".", call. = FALSE)
idx <- valid
} else if (checkmate::test_integerish(which, lower = 1L, any.missing = FALSE)) {
valid <- which <= length(nms)
if (any(!valid))
stop("Invalid job index found for current parametric job: ",
collapse(which[!valid]), ".", call. = FALSE)
idx <- which
} else {
stop("'which' should either be a character or an integer vector.",
call. = FALSE)
}
if (name) nms[idx] else idx
}
# }}}
# epgroup_sql_path {{{
epgroup_sql_path <- function(self, private, which) {
epgroup_locate_output(self, private, which, ".sql")
}
# }}}
# epgroup_rdd_path {{{
epgroup_rdd_path <- function(self, private, which, type = c("rdd", "mdd")) {
type <- match.arg(type)
epgroup_locate_output(self, private, which, paste0(".", type))
}
# }}}
# epgroup_combine_data {{{
epgroup_combine_data <- function(self, private, which, data, fill = TRUE) {
index <- epgroup_case_from_which(self, private, which, name = FALSE)
cases <- epgroup_case_from_which(self, private, which, name = TRUE)
# add case
for (idx in seq_along(cases)) {
set(data[[idx]], NULL, "index", index[idx])
set(data[[idx]], NULL, "case", cases[idx])
setcolorder(data[[idx]], c("index", "case"))
}
rbindlist(data, fill = fill)
}
# }}}
# epgroup_print_status {{{
epgroup_print_status <- function(self, private, epw = TRUE) {
status <- epgroup_status(self, private)
epgroup_retrieve_data(self, private, status)
if (!is.null(names(private$m_idfs))) {
nm_idf <- paste0(names(private$m_idfs), ".idf")
} else {
nm_idf <- vcapply(private$m_idfs, function(x) basename(x$path()))
}
if (!epw) {
nm <- cli::ansi_strtrim(paste0(
"[", lpad(seq_along(private$m_idfs), 0), "]: ", surround(nm_idf)
))
} else {
nm_idf <- cli::ansi_strtrim(paste0(
"[", lpad(seq_along(private$m_idfs), 0), "]: ",
paste0("[IDF] ", surround(nm_idf))
))
if (is.null(private$m_epws_path)) {
nm_epw <- "[EPW] << Not specified >>"
} else {
nm_epw <- basename(private$m_epws_path)
nm_epw[!is.na(nm_epw)] <- surround(nm_epw[!is.na(nm_epw)])
nm_epw[is.na(nm_epw)] <- "<< Not specified >>"
nm_epw <- paste0("[EPW] ", nm_epw)
}
nm <- paste0(rpad(nm_idf), " + ", nm_epw)
}
if (!status$run_before) {
cli::cat_line(paste0(cli::ansi_strtrim(nm), collapse = "\n"))
cli::cat_line("<< Job has not been run before >>",
col = "white", background_col = "blue")
return(invisible())
}
# each job status {{{
if (status$alive) {
if (length(private$m_log$stderr)) {
stderr <- private$m_log$stderr
# keep the latest status
job_status <- as.data.table(stri_split_fixed(stderr, "|", n = 2L, simplify = TRUE))
job_status <- unique(job_status, fromLast = TRUE, by = "V1")
# get index
set(job_status, NULL, "index", as.integer(job_status$V1))
# order by index
setorder(job_status, "index")
# make sure all models are included
job_status <- job_status[J(seq_along(nm)), on = "index"]
# for models that are idle
job_status[J(NA_character_), on = "V2", V2 := paste0(
"IDLE --> [IDF]", surround(names(private$m_idfs)[index]))]
stderr <- paste0(lpad(job_status$index, "0"), "|" ,job_status$V2)
safe_width <- getOption("width") - 2L
stderr_trunc <- vcapply(stderr, function(l) {
if (nchar(l) > safe_width) {
paste0(substr(l, 1, safe_width), "...")
} else {
l
}
})
cli::cat_boxx(stderr_trunc, col = "green", border_col = "green",
padding = 0)
}
} else {
if (isTRUE(status$terminated)) {
cli::cat_line(paste0(cli::ansi_strtrim(rpad(nm), width = cli::console_width() - 15L),
" <-- TERMINATED", collapse = "\n"))
} else {
nm <- private$m_job$jobs[, paste0(
ifelse(exit_status == 0L,
cli::ansi_strtrim(paste0(rpad(nm), " <-- SUCCEEDED")),
cli::ansi_strtrim(paste0(rpad(nm), " <-- FAILED"))
)
)]
cli::cat_line(paste0(nm, collapse = "\n"))
}
}
# }}}
# print summary status {{{
if (isTRUE(status$terminated)) {
cli::cat_line(" Job was terminated before.",
col = "white", background_col = "red")
} else if (status$alive) {
cli::cat_line(" Job started at ",
surround(private$m_log$start_time), " and is still running...",
col = "black", background_col = "green"
)
} else if (!isTRUE(status$successful)) {
cli::cat_line(" Job started at ",
surround(private$m_log$start_time), " and ended unsuccessfully...",
col = "white", background_col = "red"
)
} else {
if (!is.null(private$m_log$end_time)) {
run_time <- format(round(difftime(
private$m_log$end_time, private$m_log$start_time), digits = 2L)
)
cli::cat_line(" Simulation started at ",
surround(private$m_log$start_time), " and completed successfully after ",
run_time, ".",
col = "black", background_col = "green"
)
} else {
cli::cat_line(" Simulation started at ",
surround(private$m_log$start_time), " and completed successfully.",
col = "black", background_col = "green"
)
}
}
# }}}
}
# }}}
# S3 EplusGroupJob methods {{{
#' @export
str.EplusGroupJob <- function(object, ...) {
object$print()
}
#' @export
format.EplusGroupJob <- function(x, ...) {
paste0(utils::capture.output(x$print()), collapse = "\n")
}
#' @export
`==.EplusGroupJob` <- function(e1, e2) {
if (!inherits(e2, "EplusGroupJob")) return(FALSE)
identical(get_priv_env(e1)$uuid(), get_priv_env(e2)$uuid())
}
#' @export
`!=.EplusGroupJob` <- function(e1, e2) {
Negate(`==.EplusGroupJob`)(e1, e2)
}
# }}}
# vim: set fdm=marker:
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.