add max_length and type checking to entity objects

- enforce a length on entity objects to prevent a list when a single input is required
- add type checking for entity objects. initialised value must be of type specied by 'type' slot

Author: grlloyd

NAMESPACE

@@ -4,6 +4,7 @@ export("dataset.data<-")
 export("dataset.sample_meta<-")
 export("dataset.variable_meta<-")
 export("description<-")
+export("max_length<-")
 export("method.steps<-")
 export("models<-")
 export("name<-")
@@ -39,6 +40,7 @@ export(iris_dataset)
 export(is.output)
 export(is.param)
 export(iterator)
+export(max_length)
 export(method)
 export(method.apply)
 export(method.seq)
@@ -91,6 +93,7 @@ exportMethods("dataset.data<-")
 exportMethods("dataset.sample_meta<-")
 exportMethods("dataset.variable_meta<-")
 exportMethods("description<-")
+exportMethods("max_length<-")
 exportMethods("method.steps<-")
 exportMethods("models<-")
 exportMethods("name<-")
@@ -114,6 +117,7 @@ exportMethods(evaluate)
 exportMethods(is.output)
 exportMethods(is.param)
 exportMethods(length)
+exportMethods(max_length)
 exportMethods(method.apply)
 exportMethods(method.steps)
 exportMethods(model.predict)

R/entity_class.R

@@ -12,6 +12,7 @@
 #' @export entity
 #' @param obj An entity object
 #' @param value Value of the entity
+#' @param max_length maximum length of value vector (default 1)
 #' @include generics.R struct_class.R
 #' @return and entity object
 #' @examples
@@ -29,10 +30,27 @@
 #'
 entity<-setClass(
     "entity",
-    slots=c('value'),
+    slots=c(value='ANY'),
     contains='struct_class',
     prototype=list(name='name not provided',
-        description='no description provided')
+        description='no description provided',
+        value='',
+        type='character',
+        max_length=1
+        ),
+    validity = function(object) {
+        check_length=length(value(object)) <= max_length(object)
+        check_type=class(value(object))[1] %in% type(object)
+
+        msg=TRUE
+        if (!check_length) {
+            msg=paste0(name(object),': number of values must be less than "max_length"')
+        }
+        if (!check_type) {
+            msg=paste0(name(object),': class of value must match "type"')
+        }
+        return(msg)
+    }
 )
 
 #' @describeIn entity get the value for an entity
@@ -52,8 +70,29 @@ setMethod(f="value<-",
     definition=function(obj,value)
     {
         obj@value=value
+        validObject(obj)
         return(obj)
     }
 )
 
+#' @describeIn entity get the maximum length of value vector for an entity
+#' @export
+setMethod(f="max_length",
+    signature=c("entity"),
+    definition=function(obj)
+    {
+        return(obj@max_length)
+    }
+)
 
+#' @describeIn entity set the maximum length of value vector for an entity
+#' @export
+setMethod(f="max_length<-",
+    signature=c("entity"),
+    definition=function(obj,value)
+    {
+        obj@max_length=value
+        validObject(obj)
+        return(obj)
+    }
+)

R/example_objects.R

@@ -57,7 +57,7 @@ example_model=setClass('example_model',
             stato.id='STATO:0000047'),
         params.value_2=20,
         outputs.result_1=entity(name='Result 1',type='dataset',
-            description='An example entity object'),
+            description='An example entity object',value=dataset()),
         outputs.result_2=dataset(),
         predicted='result_1'
     )
@@ -167,7 +167,7 @@ example_method=setClass('example_method',
             stato.id='STATO:0000047'),
         params.value_2=20,
         outputs.result_1=entity(name='Result 1',type='dataset',
-            description='An example entity object'),
+            description='An example entity object',value=dataset()),
         outputs.result_2=dataset()
     )
 )

R/generics.R

@@ -693,6 +693,19 @@ setGeneric("value",function(obj)standardGeneric("value"))
 #' @rdname metric
 setGeneric("value<-",function(obj,value)standardGeneric("value<-"))
 
+#' get the max value vector length for an entity
+#'
+#' @return max value vector length for an entity
+#' @rdname entity
+#' @export
+setGeneric("max_length",function(obj)standardGeneric("max_length"))
+
+#' set the value for a metric
+#'
+#' @export
+#' @rdname metric
+setGeneric("max_length<-",function(obj,value)standardGeneric("max_length<-"))
+
 ####################################
 ###### stato class generics #####
 ####################################

man/entity-class.Rd

@@ -26,14 +26,14 @@ test_that('metric object',{
 
 # test entity
 test_that('entity object',{
-    E=entity()
+    E=entity(type='numeric',value=0)
     value(E)=1
     expect_equal(value(E),1)
 })
 
 # test enum
 test_that('enum object',{
-    E=enum(list=c('hello','world'),value='hello')
+    E=enum(list=c('hello','world'),value='hello',type='character')
     # check object creation
     expect_equal(value(E),'hello')
     # check use first value if value = NULL