Implement Sobol initialization.

DESCRIPTION

@@ -27,6 +27,7 @@ Imports:
         data.table (>= 1.15.0),
         matrixStats,
         R6,
+        spacefillr,
         withr
 Suggests:
     Rmpi (>= 0.6.0),

NAMESPACE

@@ -64,3 +64,4 @@ importFrom(graphics,par)
 importFrom(graphics,plot)
 importFrom(graphics,points)
 importFrom(graphics,strwidth)
+importFrom(spacefillr,generate_sobol_set)

NEWS.md

@@ -62,9 +62,11 @@
 ## New features and improvements
 
  * `sampleUniform()` and `sampleModel()` are significantly faster thanks to using [`data.table`](https://r-datatable.com).
+
+ * Initial configurations are sampled using Sobol low-discrepancy sequences using `spacefillr::generate_sobol_set()`. This should provide a better initial distribution of parameter values.
 
  * Ablation will report configurations that produced the same results, which
-   points to parameter values that have the same effect on the target algorithm,
+   indicates parameter values that have the same effect on the target algorithm,
    possibly indicating a bug in the target algorithm.
 
  * New option `instancesFile` of `ablation()` for using either the training

R/generation.R

@@ -48,7 +48,6 @@ getDependentBound <- function(parameters, param, configuration)
                    "). This is NOT a bug in irace. Check the definition of these parameters.")
     }
   }
-
   values
 }
 
@@ -138,6 +137,113 @@ generate_uniform <- function(parameters, nbConfigurations, repair = NULL)
   newConfigurations
 }
 
+param_qunif_c <- function(x, domain)
+{
+  n <- length(domain)
+  z <- floor(x * n * (1 - 1e-16)) + 1L # make sure we don't map to upper+1
+  domain[z]
+}
+
+param_qunif_i <- function(x, domain)
+{
+  upper <- domain[2L]
+  lower <- domain[1L]
+  n <- (upper - lower) + 1L
+  as.integer(floor(x * n * (1 - 1e-16)) + lower) # make sure we don't map to upper+1
+}
+
+param_qunif_o <- function(x, domain)
+{
+  z <- param_qunif_i(x, c(1L, length(domain)))
+  domain[z]
+}
+
+param_qunif_r <- function(x, domain)
+{
+  upper <- domain[2L]
+  lower <- domain[1L]
+  x <- x * (upper - lower) + lower
+  clamp(x, lower, upper)
+}
+
+.param_qunif <- c(i = param_qunif_i, r = param_qunif_r, c = param_qunif_c,
+  o = param_qunif_o)
+
+generate_sobol <- function(parameters, n, repair = NULL)
+{
+  # Do not use .Machine$integer.max to minimize differences between machines.
+  seed <- sample.int(2147483647L, size = 1L)
+  confs <- spacefillr::generate_sobol_set(n, dim = parameters$nbVariable, seed = seed)
+  confs <- data.table(confs)
+  setnames(confs, parameters$names[!parameters$isFixed])
+  nodep_names <- parameters$names[!parameters$isDependent & !parameters$isFixed]
+  # FIXME: How to do this faster using data.table?
+  for (x in nodep_names) {
+    this_qunif <- .param_qunif[[parameters$types[x]]]
+    set(confs, j = x, value = this_qunif(confs[[x]], parameters$domain[[x]]))
+  }
+  for (x in parameters$names[parameters$isFixed]) {
+    set(confs, j = x, value = parameters$domain[[x]][[1L]])
+  }
+  setcolorder(confs, parameters$names)
+
+  hierarchy <- parameters$hierarchy
+  max_level <- max(hierarchy)
+  if (max_level > 1L) {
+    .NEWVALUE <- .DOMAIN <- NULL # To silence CRAN warnings.
+    for (k in seq_len(max_level - 1L)) {
+      prev_names <- names(hierarchy)[hierarchy <= k]
+      dep_names <- names(hierarchy)[hierarchy == k+1L]
+      for (p in dep_names) {
+        idx_satisfied <- which_satisfied(confs, parameters$conditions[[p]])
+        if (parameters$isDependent[[p]] && length(idx_satisfied) > 0L) {
+          this_qunif <- .param_qunif[[parameters$types[p]]]
+          confs[idx_satisfied, let(.DOMAIN = list(get_dependent_domain(parameters, p, .SD))), by=.I, .SDcols=prev_names]
+          confs[idx_satisfied, .NEWVALUE := this_qunif(.SD, unlist(.DOMAIN)), by=.I, .SDcols=p]
+          confs[, (p):=.NEWVALUE]
+          confs[, let(.NEWVALUE=NULL, .DOMAIN=NULL)]
+        } else if (length(idx_satisfied) < n) {
+          idx_not_satisfied <- if (length(idx_satisfied))
+                                 seq_len(n)[-idx_satisfied] else NULL
+          set(confs, i = idx_not_satisfied, j = p, value = NA)
+        }
+      }
+    }
+  }
+  if (!is.null(repair)) {
+    # FIXME: Pass the whole newConfigurations to repair and let it handle each row.
+    j <- colnames(confs)
+    for (i in seq_nrow(confs))
+      set(confs, i, j = j, value = repair(as.data.frame(confs[i]), parameters))
+  }
+  set(confs, j = ".PARENT.", value = NA_integer_)
+  confs
+}
+
+sampleSobol <- function(parameters, n, repair = NULL)
+{
+  newConfigurations <- generate_sobol(parameters, n, repair)
+  newConfigurations <- unique(newConfigurations)
+  forbidden <- parameters$forbidden  
+  newConfigurations <- filter_forbidden(newConfigurations, forbidden)
+  have <- nrow(newConfigurations)
+  if (have == n) {
+    setDF(newConfigurations)
+    return(newConfigurations)
+  }
+  needed <- max(ceiling(n + (n - have) * (2 - have / n)), min(parameters$nbVariable * 5L, 100L))
+  newConfigurations <- generate_sobol(parameters, needed, repair)
+  newConfigurations <- unique(newConfigurations)
+  newConfigurations <- filter_forbidden(newConfigurations, forbidden)
+  if (nrow(newConfigurations) == 0L) {
+    irace.error("irace tried to sample a configuration not forbidden without success, perhaps your constraints are too strict?")
+  }
+  newConfigurations <- truncate_rows(newConfigurations, n)
+  setDF(newConfigurations)
+  newConfigurations
+}
+
+
 ### Uniform sampling for the initial generation
 sampleUniform <- function(parameters, nbConfigurations, repair = NULL)
 {

R/irace-package.R

@@ -7,6 +7,7 @@
 #' @importFrom R6 R6Class
 #' @importFrom grDevices dev.off pdf
 #' @importFrom graphics abline axis boxplot par plot points strwidth bxp grid
+#' @importFrom spacefillr generate_sobol_set
 #' 
 #' @details  License: GPL (>= 2)
 #' 

R/irace.R

@@ -825,7 +825,7 @@ irace_run <- function(scenario, parameters)
       repeat {
         # Sample new configurations if needed
         if (nrow(allConfigurations) < nconfigurations) {
-          newConfigurations <- sampleUniform(parameters,
+          newConfigurations <- sampleSobol(parameters,
                                              nconfigurations - nrow(allConfigurations),
                                              repair = scenario$repairConfiguration)
           newConfigurations <- cbind (.ID. = max(0L, allConfigurations[[".ID."]]) + seq_nrow(newConfigurations),
@@ -1116,7 +1116,7 @@ irace_run <- function(scenario, parameters)
           catInfo("Sample ", nbNewConfigurations,
                   " configurations from uniform distribution", verbose = FALSE)
         }
-        newConfigurations <- sampleUniform(parameters, nbNewConfigurations,
+        newConfigurations <- sampleSobol(parameters, nbNewConfigurations,
                                            repair = scenario$repairConfiguration)
         newConfigurations <-
           cbind (.ID. = max(0L, allConfigurations[[".ID."]]) + seq_nrow(newConfigurations),

R/utils.R

@@ -716,3 +716,11 @@ seq_nrow <- function(x) seq_len(nrow(x))
 
 clamp <- function(x, lower, upper) pmax.int(lower, pmin.int(x, upper))
 
+truncate_rows <- function(x, n)
+{
+  nx <- nrow(x)
+  if (nx <= n) return(x)
+  x[-seq.int(n + 1L, nx), ]
+}
+
+

tests/testthat/test-targetRunnerParallel.R

@@ -49,7 +49,7 @@ x "x" r (1,2)
 ')
   expect_output(
     irace(scenario = list(targetRunnerParallel = targetRunnerParallel,
-                          instances = lapply(1:5, function(i) 10),
+                          instances = replicate(5, list(10)),
                           targetRunnerData = list(a=1, b=2),
                           maxExperiments = 42L),
           parameters = parameters),