WIP #544

DESCRIPTION

@@ -42,6 +42,7 @@ Collate:
     'create-population.R'
     'data-column.R'
     'data-repository.R'
+    'data-set.R'
     'dot-net-wrapper.R'
     'entity.R'
     'enum.R'

NAMESPACE

@@ -58,6 +58,7 @@ export(getAllQuantityPathsIn)
 export(getAllStateVariablesPaths)
 export(getBaseUnit)
 export(getContainer)
+export(getDimensionByName)
 export(getDimensionForUnit)
 export(getDimensionsEnum)
 export(getEnumKey)

R/data-column.R

@@ -10,9 +10,9 @@ 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) {
@@ -23,14 +23,31 @@ DataColumn <- R6::R6Class(
       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))
+      }
+      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)
+      }
+      # updating the dimension
+      rClr::clrSet(self$ref, "Dimension", getDimensionByName(value))
+      private$.dimension <- NULL
+      private$.unit <- NULL
     }
   ),
   public = list(

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,6 +58,23 @@ 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.

R/data-set.R

@@ -0,0 +1,141 @@
+#' @title DataSet
+#' @docType class
+#' @description  A wrapper around DataRepository exposing convenience methods to use and manipulate dataSets
+#' (typically observed data) containing an X column, a Y column and potentially an Error columns
+#' @format NULL
+DataSet <- R6::R6Class(
+  "DataSet",
+  inherit = Printable,
+  cloneable = FALSE,
+  active = list(
+    #' @field name The name of the DataSet
+    name = function(value) {
+      if (missing(value)) {
+        return(self$dataRepository$name)
+      }
+      self$dataRepository$name <- value
+    },
+    #' @field xDimension Dimension in which the xValues are defined
+    xDimension = function(value) {
+      if (missing(value)) {
+        return(private$.xValues$dimension)
+      }
+      private$setColumnDimension(private$.xValues, value)
+    },
+    #' @field xUnit Unit in which the xValues are defined
+    xUnit = function(value) {
+      if (missing(value)) {
+        return(private$.xValues$displayUnit)
+      }
+      private$setColumnUnit(private$.xValues, value)
+    },
+    #' @field xValues Values stored in the xUnit dimension (not necessarily in the base unit of the dimension)
+    xValues = function(values) {
+      if (missing(values)) {
+        return(private$getColumnValues(private$.xValues))
+      }
+
+      private$setColumnValues(private$.xValues, values)
+    },
+    #' @field yDimension Dimension in which the xValues are defined
+    yDimension = function(value) {
+      if (missing(value)) {
+        return(private$.yValues$dimension)
+      }
+      private$setColumnDimension(private$.yValues, value)
+    },
+    #' @field yUnit Unit in which the yValues are defined
+    yUnit = function(value) {
+      if (missing(value)) {
+        return(private$.yValues$displayUnit)
+      }
+      private$.yValues$displayUnit <- value
+    },
+    #' @field yValues Values stored in the yUnit dimension (not necessarily in the base unit of the dimension)
+    yValues = function(values) {
+      if (missing(values)) {
+        return(private$getColumnValues(private$.yValues))
+      }
+
+      private$setColumnValues(private$.yValues, values)
+    }
+  ),
+  public = list(
+    dataRepository = NULL,
+    #' @description
+    #' Initialize a new instance of the class
+    #' @param dataRepository Instance of the \code{DataRepository} object to wrap
+    #' @return A new `DotNetWrapper` object.
+    initialize = function(dataRepository = NULL) {
+      self$dataRepository <- dataRepository %||% private$createDataRepository()
+      private$initializeCache()
+    },
+    #' @description
+    #' Print the object to the console
+    #' @param ... Rest arguments.
+    print = function(...) {
+      private$printClass()
+      invisible(self)
+    }
+  ),
+  private = list(
+    .xValues = NULL,
+    .yValues = NULL,
+    setColumnValues = function(column, values) {
+      # values are set in the display unit. We need to make sure we convert them to the base unit
+      valuesInBaseUnit <- toBaseUnit(quantityOrDimension = column$dimension, values = values, unit = column$displayUnit)
+      column$values <- valuesInBaseUnit
+      invisible()
+    },
+    getColumnValues = function(column) {
+      # we need to convert the values in the display unit
+      toUnit(quantityOrDimension = column$dimension, values = column$values, targetUnit = column$displayUnit)
+    },
+    setColumnDimension = function(column, value){
+      # no need to update anything if we are setting the same values
+      if(column$dimension == value){
+        return()
+      }
+
+      # save the values in their display unit before updating
+      values <- private$getColumnValues(column)
+
+      #now we need to update dimension (display unit will be the default one as per .NET implementation)
+      column$dimension <- value
+
+      private$setColumnValues(column, values)
+    },
+    setColumnUnit = function(column, unit){
+      # no need to update anything if we are setting the same values
+      if(column$displayUnit == unit){
+        return()
+      }
+
+      # save the values in their display unit before updating
+      values <- private$getColumnValues(column)
+
+      #now we need to update dimension and display unit
+      column$displayUnit <- unit
+
+      private$setColumnValues(column, values)
+    },
+    createDataRepository = function() {
+      # Create an empty data repository with a base grid and column
+      dataRepository <- DataRepository$new()
+      # Passing time for dimension for now
+      xValues <- DataColumn$new(rClr::clrNew("OSPSuite.Core.Domain.Data.BaseGrid", "xValues", getDimensionByName(ospDimensions$Time)))
+
+      # Passing concentration (mass) for dimension for now
+      yValues <- DataColumn$new(rClr::clrNew("OSPSuite.Core.Domain.Data.DataColumn", "yValues", getDimensionByName(ospDimensions$`Concentration (mass)`), xValues$ref))
+
+      dataRepository$addColumn(xValues)
+      dataRepository$addColumn(yValues)
+      return(dataRepository)
+    },
+    initializeCache = function() {
+      private$.xValues <- self$dataRepository$baseGrid
+      # TODO we need to be a bit more careful here
+      private$.yValues <- self$dataRepository$allButBaseGrid[[1]]
+    }
+  )
+)

R/object-base.R

@@ -9,7 +9,7 @@ ObjectBase <- R6::R6Class(
   cloneable = FALSE,
   inherit = DotNetWrapper,
   active = list(
-    #' @field name The name of the object
+    #' @field name The name of the object. (read-only)
     name = function(value) {
       private$wrapReadOnlyProperty("Name", value)
     },

R/utilities-units.R

@@ -238,6 +238,19 @@ getDimensionTask <- function() {
   return(dimensionTask)
 }
 
+#' Returns the an instance of the dimension with the given name if found or NULL otherwise
+#'
+#' @param dimension Name of dimension that should be retrieved
+#'
+#' @examples
+#' dim <- getDimensionByName("Time")
+#' @export
+getDimensionByName <- function(name){
+  validateIsString(name)
+  dimensionTask <- getDimensionTask()
+  rClr::clrCall(dimensionTask, "DimensionByName", enc2utf8(name))
+}
+
 
 #' Loop through dimensions and build a list containing an enum of all units available for each dimension
 #' @return enum of all units for each dimension

R/utilities.R

@@ -30,12 +30,17 @@ toObjectType <- function(netObject, class) {
 }
 
 
-#' Mimic the ternary operator  \code{a ? x : y} behavior in other languages
-#' If \code{condition} is not null, returns \code{outputIfNotNull} otherwise \code{outputIfNull}
+#' Shortkey checking if argument 1 is not null,
+#' output the argument 2 if not null, or output argument 3 otherwise
 #'
-#' @param condition The .NET object instances (single or list) to wrap
-#' @param outputIfNotNull The class definition that will be used to convert the parameter
-#' @param outputIfNull The class definition that will be used to convert the parameter
+#' @title ifnotnull
+#' @param inputToCheck argument 1
+#' @param outputIfNotNull argument 2
+#' @param outputIfNull argument 3
+#' @return outputIfNotNull if inputToCheck is not null, outputIfNull otherwise
+#' @description
+#' Check if inputToCheck is not null, if so output outputIfNotNull,
+#' otherwise, output outputIfNull
 ifNotNull <- function(condition, outputIfNotNull, outputIfNull = NULL) {
   if (!is.null(condition)) {
     outputIfNotNull