stash

DESCRIPTION

@@ -61,7 +61,7 @@ Config/testthat/edition: 3
 Config/testthat/parallel: false
 NeedsCompilation: no
 Roxygen: list(markdown = TRUE, r6 = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 VignetteBuilder: knitr
 Collate:
     'Condition.R'

attic/ParamS6.R

@@ -15,14 +15,15 @@ p_s6 = function(support, special_vals = list(), default = NO_DEF, tags = charact
     cargo = set,
     lower = suppressWarnings(as.numeric(set$lower)),
     upper = suppressWarnings(as.numeric(set$upper)),
-    levels = as.list(set$elements),
+    levels = if (is.numeric(set$properties$cardinality)) as.list(set$elements),
     special_vals = special_vals,
     default = default,
     tags = tags,
     trafo = trafo,
     storage_type = storage_type,
     depends_expr = substitute(depends),
-    init = init)
+    init = init
+  )
 }
 
 #' @export
@@ -61,6 +62,7 @@ domain_qunif.ParamSet6 = function(param, x) stop("undefined")
 domain_is_number.ParamSet6 = function(param) {
   param$storage_type[[1]] != "list"
 }
+
 #' @export
 domain_is_categ.ParamSet6 = function(param) {
   set = set6_cache_get(param$grouping[[1]])
@@ -69,3 +71,11 @@ domain_is_categ.ParamSet6 = function(param) {
 
   categness
 }
+
+set6_unique_repr = function(object) {
+  assert_r6(object, "Set")
+  using_unicode_for_whatever_reason = set6::useUnicode()
+  on.exit(set6::useUnicode(using_unicode_for_whatever_reason))
+  set6::useUnicode(FALSE)
+  object$strprint(n = 1e10)
+}

attic/S6ObjectCache.R

@@ -1,4 +1,5 @@
 
+
 S6Cache = R6Class("S6Cache",
   cloneable = FALSE,
   public = list(

tests/testthat/helper_01_params.R

@@ -2,11 +2,12 @@
 # use th_ to indicate a test helper object
 
 # Param
-th_param_int = function() ParamInt$new(id = "th_param_int", default = 0, lower = -10, upper = 10)
-th_param_nat = function() ParamInt$new(id = "th_param_nat", default = 1L, lower = 1L, upper = 4L)
-th_param_dbl = function() ParamDbl$new(id = "th_param_dbl", default = 0, lower = -10, upper = 10)
-th_param_dbl_na = function() ParamDbl$new(id = "th_param_dbl_na", default = 0,
-  lower = -10, upper = 10, special_vals = list(NA))
-th_param_fct = function() ParamFct$new(id = "th_param_fct", default = "a", levels = letters[1:3])
-th_param_lgl = function() ParamLgl$new(id = "th_param_lgl", default = FALSE)
-th_param_uty = function() ParamUty$new(id = "th_param_uty")
+th_param_int = function() ps(th_param_int = p_int(default = 0, lower = -10, upper = 10))
+th_param_nat = function() ps(th_param_nat = p_int(default = 1L, lower = 1L, upper = 4L))
+th_param_dbl = function() ps(th_param_dbl = p_dbl(default = 0, lower = -10, upper = 10))
+th_param_dbl_na = function() ps(th_param_dbl_na = p_dbl(default = 0, lower = -10, upper = 10, special_vals = list(NA)))
+th_param_fct = function() ps(th_param_fct = p_fct(default = "a", levels = letters[1:3]))
+th_param_lgl = function() ps(th_param_lgl = p_lgl(default = FALSE))
+th_param_uty = function() ps(th_param_uty = p_uty())
+
+

tests/testthat/test_Param.R

@@ -1,4 +1,6 @@
-context("Param")
+
+
+
 
 
 test_that("basic properties", {