WIP #544

DESCRIPTION

@@ -42,9 +42,10 @@ Collate:
     'create-population.R'
     'data-column.R'
     'data-repository.R'
+    'enum.R'
+    'data-set.R'
     'dot-net-wrapper.R'
     'entity.R'
-    'enum.R'
     'error-checks.R'
     'formula.R'
     'get-net-task.R'
@@ -89,6 +90,7 @@ Collate:
     'user-defined-pk-parameter.R'
     'utilities-container.R'
     'utilities-data-repository.R'
+    'utilities-data-set.R'
     'utilities-dot-net.R'
     'utilities-entity.R'
     'utilities-file.R'

NAMESPACE

@@ -1,6 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
 export(CompareBy)
+export(DataErrorType)
+export(DataSet)
 export(Gender)
 export(HumanPopulation)
 export(IndividualCharacteristics)
@@ -34,6 +36,7 @@ export(createIndividualCharacteristics)
 export(createPopulation)
 export(createPopulationCharacteristics)
 export(createSimulationBatch)
+export(dataSetToDataFrame)
 export(enum)
 export(enumGetValue)
 export(enumHasKey)
@@ -58,6 +61,7 @@ export(getAllQuantityPathsIn)
 export(getAllStateVariablesPaths)
 export(getBaseUnit)
 export(getContainer)
+export(getDimensionByName)
 export(getDimensionForUnit)
 export(getDimensionsEnum)
 export(getEnumKey)

R/create-population.R

@@ -25,8 +25,7 @@ createPopulation <- function(populationCharacteristics) {
       population = populationCharacteristics$population,
       age = 30
     )
-  }
-  else {
+  } else {
     # create an individual with similar properties Species and population. WEIGHT AND AGE DO NOT MATTER as long as we can create an indiviual
     individualCharacteristics <- createIndividualCharacteristics(
       species = populationCharacteristics$species,

R/data-column.R

@@ -10,27 +10,49 @@ DataColumn <- R6::R6Class(
   inherit = DotNetWrapper,
   cloneable = FALSE,
   active = list(
-    #' @field values Returns the values defined in the column  (Read-Only)
+    #' @field values Returns the values defined in the column
     values = function(value) {
-      private$wrapReadOnlyProperty("ValuesAsArray", value)
+      private$wrapProperty("ValuesAsArray", value)
     },
     #' @field name Returns the name of the column  (Read-Only)
     name = function(value) {
       private$wrapReadOnlyProperty("Name", value)
     },
     #' @field unit The base unit in which the values are defined (Read-Only)
     unit = function(value) {
+      if (!missing(value)) {
+        value <- enc2utf8(value)
+      }
       private$.unit <- private$wrapExtensionMethodCached(WITH_DIMENSION_EXTENSION, "BaseUnitName", "unit", private$.unit, value)
       return(private$.unit)
     },
-    #' @field displayUnit The unit in which the values should be displayed (Read-Only)
+    #' @field displayUnit The unit in which the values should be displayed
     displayUnit = function(value) {
-      private$wrapExtensionMethod(WITH_DISPLAY_UNIT_EXTENSION, "DisplayUnitName", "displayUnit", value)
+      if (missing(value)) {
+        return(private$wrapExtensionMethod(WITH_DISPLAY_UNIT_EXTENSION, "DisplayUnitName", "displayUnit", value))
+      }
+      value <- enc2utf8(value)
+      dimension <- getDimensionByName(self$dimension)
+      # we use the ignore case parameter set  to true so that we do not have to worry about casing when set via scripts
+      unit <- rClr::clrCall(dimension, "FindUnit", value, TRUE)
+      if (is.null(unit)) {
+        stop(messages$errorUnitNotSupported(unit = value, dimension = self$dimension))
+      }
+      rClr::clrSet(self$ref, "DisplayUnit", unit)
     },
-    #' @field dimension The dimension of the values  (Read-Only)
+    #' @field dimension The dimension of the values
     dimension = function(value) {
-      private$.dimension <- private$wrapExtensionMethodCached(WITH_DIMENSION_EXTENSION, "DimensionName", "dimension", private$.dimension, value)
-      return(private$.dimension)
+      if (missing(value)) {
+        if (is.null(private$.dimension)) {
+          private$.dimension <- private$wrapExtensionMethodCached(WITH_DIMENSION_EXTENSION, "DimensionName", "dimension", private$.dimension, value)
+        }
+        return(private$.dimension)
+      }
+      value <- enc2utf8(value)
+      # updating the dimension
+      rClr::clrSet(self$ref, "Dimension", getDimensionByName(value))
+      private$.dimension <- NULL
+      private$.unit <- NULL
     }
   ),
   public = list(
@@ -41,7 +63,7 @@ DataColumn <- R6::R6Class(
       if (self$unit == "") {
         private$printLine(self$name)
       } else {
-        private$printLine(self$name, paste0("[", self$unit, "]"))
+        private$printLine(self$name, paste0("base unit: [", self$unit, "]"))
       }
       invisible(self)
     }

R/data-repository.R

@@ -7,16 +7,18 @@ DataRepository <- R6::R6Class(
   inherit = DotNetWrapper,
   cloneable = FALSE,
   active = list(
+    #' @field name The name of the object.
+    name = function(value) {
+      private$wrapProperty("Name", value)
+    },
     #' @field baseGrid Returns the base column for the data repository (typically time column).
     baseGrid = function(value) {
       if (missing(value)) {
         if (is.null(private$.baseGrid)) {
-          private$.baseGrid <- DataColumn$new(private$wrapReadOnlyProperty("BaseGrid", value))
+          private$.baseGrid <- DataColumn$new(private$wrapProperty("BaseGrid", value))
         }
         return(private$.baseGrid)
       }
-
-      private$throwPropertyIsReadonly("baseGrid")
     },
     #' @field columns Returns all columns (including baseGrid) defined in the data repository.
     columns = function(value) {
@@ -56,12 +58,59 @@ DataRepository <- R6::R6Class(
     }
   ),
   public = list(
+    #' @description
+    #' Adds a column to the data repository
+    #' @param column Column to add
+    addColumn = function(column) {
+      validateIsOfType(column, DataColumn)
+      rClr::clrCall(self$ref, "Add", column$ref)
+      # we need to reset the cache when adding a new column
+      private$.columns <- NULL
+      private$.baseGrid <- NULL
+    },
+    #' @description
+    #' Initialize a new instance of the class
+    #' @param ref Optional underlying DataRepository. If it is not provided, a new instance will be created
+    #' @return A new `DataRepository` object.
+    initialize = function(ref = NULL) {
+      super$initialize(ref %||% rClr::clrNew("OSPSuite.Core.Domain.Data.DataRepository"))
+    },
     #' @description
     #' Print the object to the console
     #' @param ... Rest arguments.
     print = function(...) {
       private$printClass()
       invisible(self)
+    },
+    #' @description
+    #' Adds a new entry to meta data list or changes its value if the name is already present.
+    #'
+    #' @param name Name of new meta data list entry
+    #' @param value Value of new meta data list entry
+    addMetaData = function(name, value) {
+      if (length(name) != 1) {
+        stop(messages$errorMultipleMetaDataEntries())
+      }
+      validateIsString(name)
+      validateIsString(value)
+      dataRepositoryTask <- getNetTask("DataRepositoryTask")
+      rClr::clrCall(dataRepositoryTask, "AddMetaData", self$ref, name, value)
+      # we need to reset the cache when adding a new meta data
+      private$.metaData <- NULL
+    },
+    #' @description
+    #' Removes the meta data entry in the list if one is defined with this name
+    #'
+    #' @param name Name of meta data entry to delete
+    removeMetaData = function(name) {
+      if (length(name) != 1) {
+        stop(messages$errorMultipleMetaDataEntries())
+      }
+      validateIsString(name)
+      dataRepositoryTask <- getNetTask("DataRepositoryTask")
+      rClr::clrCall(dataRepositoryTask, "RemoveMetaData", self$ref, name)
+      # we need to reset the cache when adding a new meta data
+      private$.metaData <- NULL
     }
   ),
   private = list(