p_int works for negative values. (#402)

* p_int works for negative values.
closes #401

* Handle assignment of empty tags list to empty ps()
closes #400

R/ParamInt.R

@@ -54,7 +54,7 @@ domain_check.ParamInt = function(param, values) {
 
 #' @export
 domain_sanitize.ParamInt = function(param, values) {
-  as.list(as.integer(as.numeric(values) + 0.5))
+  as.list(as.integer(round(as.numeric(values))))
 }
 
 #' @export

R/ParamSet.R

@@ -695,9 +695,10 @@ ParamSet = R6Class("ParamSet",
     #' @template field_tags
     tags = function(v) {
       if (!missing(v)) {
-        assert_names(names(v), permutation.of = private$.params$id)
         assert_list(v, any.missing = FALSE, types = "character")
-        private$.tags = data.table(id = rep(names(v), map_int(v, length)), tag = unlist(v), key = "id")
+        if (length(v)) assert_names(names(v), permutation.of = private$.params$id)
+        # as.character() to handle empty lists and resulting NULL-valures.
+        private$.tags = data.table(id = rep(as.character(names(v)), map_int(v, length)), tag = as.character(unlist(v)), key = "id")
         setindexv(private$.tags, "tag")
         # return value with original ordering
         return(v)

tests/testthat/test_ParamInt.R

@@ -55,3 +55,29 @@ test_that("assigning integer value results in int", {
   expect_error({p$values$x = 1e-2}, "be of type.*integerish")
 
 })
+
+test_that("integer params are not corrected to the wrong value", {
+  param_set = ps(a = p_int())
+  param_set$values$a = 100
+  expect_identical(param_set$values$a, 100L)
+  param_set$values$a = -100
+  expect_identical(param_set$values$a, -100L)
+
+})
+
+test_that("integer params are not corrected to the wrong value", {
+  param_set = ps(a = p_int(tolerance = 0.4))
+  param_set$values$a = 100.4
+  expect_identical(param_set$values$a, 100L)
+  param_set$values$a = 100.6
+  expect_identical(param_set$values$a, 101L)
+  expect_error({param_set$values$a = 100.41}, "Must be of type.*integerish.*not.*double")
+  expect_error({param_set$values$a = 100.59}, "Must be of type.*integerish.*not.*double")
+
+  param_set$values$a = -100.4
+  expect_identical(param_set$values$a, -100L)
+  param_set$values$a = -100.6
+  expect_identical(param_set$values$a, -101L)
+  expect_error({param_set$values$a = -100.41}, "Must be of type.*integerish.*not.*double")
+  expect_error({param_set$values$a = -100.59}, "Must be of type.*integerish.*not.*double")
+})

tests/testthat/test_ParamSet.R

@@ -305,6 +305,17 @@ test_that("required tag, empty param set (#219)", {
   expect_identical(ps$ids(tags = "required"), character(0))
 })
 
+test_that("setting empty tags on empty paramset", {
+  param_set = ps()
+  nl <- structure(list(), names = character(0))
+  expect_identical(param_set$tags, nl)
+  param_set$tags = nl
+  expect_identical(param_set$tags, nl)
+  param_set$tags = list()
+  expect_identical(param_set$tags, nl)
+
+})
+
 test_that("paramset clones properly", {
   ps = ParamSet_legacy$new()
   ps = ps_union(list(ps, ParamFct$new("a", levels = letters[1:3])))