* R/parameterAnalysis.R (getConfigurationById): use match instead of…

… %in%.

NEWS.md

@@ -25,6 +25,9 @@
    (`--capping-after-first-test`). If set to 1, elimination due to capping only
    happens after `firstTest` instances are seen (issue #78, suggested by Nguyen Dang).
 
+ * `getConfigurationById()` now returns configurations in the same order
+   (including repeated values) of the IDs passed as argument.
+
 ## Fixes
 
  * Fix #76: Recovery (`--recover-file`) is working again with a completely new implementation.

R/parameterAnalysis.R

@@ -1,54 +1,55 @@
 #' Return the elite configurations of the final iteration.
-#' 
+#'
 #' @inheritParams has_testing_data
-#' @param n Number of elite configurations to return, if \code{n} is larger than the 
+#' @param n `integer(1)`\cr Number of elite configurations to return, if \code{n} is larger than the
 #' number of configurations, then only the existing ones are returned. The default (\code{n=0}) returns all of them.
 #' @param drop.metadata `logical(1)`\cr Remove metadata, such as the
 #'   configuration ID and the ID of the parent, from the returned
 #'   configurations.  See [removeConfigurationsMetaData()].
-#' 
+#'
 #' @return A data frame containing the elite configurations required.
 #'
 #' @examples
 #' log_file <- system.file("exdata/irace-acotsp.Rdata", package="irace", mustWork=TRUE)
 #' print(removeConfigurationsMetaData(getFinalElites(log_file, n=1)))
-#' 
+#'
 #' @author Manuel López-Ibáñez and Leslie Pérez Cáceres
 #' @concept analysis
 #' @export
 getFinalElites <- function(iraceResults, n = 0L, drop.metadata = FALSE)
 {
   if (missing(iraceResults)) stop("argument 'iraceResults' is missing")
   iraceResults <- read_logfile(iraceResults)
-    
-  last.elites <- iraceResults$allElites[[length(iraceResults$allElites)]]
-  
+
+  last_elites <- iraceResults$allElites[[length(iraceResults$allElites)]]
+
   if (n == 0L)
-    n <- length(last.elites) 
-    
-  if (length(last.elites) < n) {
-    cat("Only", length(last.elites), "configurations available, reducing n,")
-    n <- length(last.elites)
+    n <- length(last_elites)
+
+  if (length(last_elites) < n) {
+    cat("Only", length(last_elites), "configurations available, reducing n,")
+    n <- length(last_elites)
   }
-  last.elites <- last.elites[seq_len(n)]
-  
+  last_elites <- last_elites[seq_len(n)]
+
   configurations <- subset(iraceResults$allConfigurations,
-                           get(".ID.") %in% as.character(last.elites),
+                           get(".ID.") %in% as.character(last_elites),
                            drop = FALSE)
   if (drop.metadata)
     configurations <- removeConfigurationsMetaData(configurations)
   configurations
 }
 
 #' Returns the configurations selected by ID.
-#' 
-#' @param ids (`integer()`)\cr The id or a vector of ids of the candidates configurations to obtain.
+#'
+#' @param ids `integer()`\cr The id or a vector of ids of the candidates configurations to obtain.
 #' @inheritParams getFinalElites
-#' 
-#' @return A data frame containing the elite configurations required.
+#'
+#' @return A data frame containing the elite configurations required, in the
+#'   order and with the repetitions given by `ids`.
 #' @examples
 #' log_file <- system.file("exdata/irace-acotsp.Rdata", package="irace", mustWork=TRUE)
-#' getConfigurationById(log_file, ids = c(1,2), drop.metadata = TRUE)
+#' getConfigurationById(log_file, ids = c(2,1), drop.metadata = TRUE)
 #'
 #' @author Manuel López-Ibáñez and Leslie Pérez Cáceres
 #' @concept analysis
@@ -57,24 +58,24 @@ getConfigurationById <- function(iraceResults, ids, drop.metadata = FALSE)
 {
   if (missing(iraceResults)) stop("argument 'iraceResults' is missing")
   iraceResults <- read_logfile(iraceResults)
-    
+
   if (length(ids) < 1L) stop("You must provide at least one configuration id.")
 
   get_configuration_by_id_helper(iraceResults$allConfigurations, ids, drop_metadata = drop.metadata)
 }
 
 #' Returns the configurations by the iteration in which they were executed.
 #'
-#' @param iterations (`integer()`)\cr The iteration number or a vector of iteration numbers from where 
+#' @param iterations `integer()`\cr The iteration number or a vector of iteration numbers from where
 #'  the configurations should be obtained. Negative values start counting from the last iteration.
 #' @inheritParams getFinalElites
-#' 
+#'
 #' @return A data frame containing the elite configurations required.
 #'
 #' @examples
 #' log_file <- system.file("exdata/irace-acotsp.Rdata", package="irace", mustWork=TRUE)
 #' getConfigurationByIteration(log_file, iterations = c(-2, -1), drop.metadata = TRUE)
-#' 
+#'
 #' @author Manuel López-Ibáñez and Leslie Pérez Cáceres
 #' @concept analysis
 #' @export
@@ -94,7 +95,7 @@ getConfigurationByIteration <- function(iraceResults, iterations, drop.metadata
   if (is.null(iraceResults$state$experiment_log) ||
         nrow(iraceResults$state$experiment_log) == 0L)
     stop("'iraceResults' does not contain experiment_log, maybe the wrong file, an incomplete run or the wrong version of irace?")
-    
+
   ids <- unique(subset(as.data.frame(iraceResults$state$experiment_log),
                        iteration %in% iterations,
                        select="configuration", drop=TRUE))
@@ -103,11 +104,11 @@ getConfigurationByIteration <- function(iraceResults, iterations, drop.metadata
 
 
 get_configuration_by_id_helper <- function(allConfigurations, ids, drop_metadata)
-{  
-  configurations <- allConfigurations[allConfigurations[[".ID."]] %in% ids, , drop=FALSE]
+{
+  configurations <- allConfigurations[match(ids, allConfigurations[[".ID."]]), , drop=FALSE]
   if (nrow(configurations) == 0L)
     stop("No configuration found with ID:", ids, ".")
-  
+
   if (drop_metadata)
     configurations <- removeConfigurationsMetaData(configurations)
   configurations
@@ -117,9 +118,9 @@ get_configuration_by_id_helper <- function(allConfigurations, ids, drop_metadata
 #' (and optionally the actual instances).
 #'
 #' @inheritParams getFinalElites
-#' @param index  (`integer()`)\cr Indexes of the (instanceID,seed) pairs to be returned. The default returns everything.
-#' @param instances (`logical(1)`)\cr Whether to add the actual instances as an additional column (only if the instances are of atomic type).
-#' 
+#' @param index  `integer()`\cr Indexes of the (instanceID,seed) pairs to be returned. The default returns everything.
+#' @param instances `logical(1)`\cr Whether to add the actual instances as an additional column (only if the instances are of atomic type).
+#'
 #' @return `data.table()`\cr With default arguments, a `data.table` containing two columns
 #'   `"instanceID"` and `"seed"`. With `instances=TRUE` and if the instances
 #'   are of atomic type (see [is.atomic()]) type, another column `instance` is
@@ -148,7 +149,7 @@ get_instanceID_seed_pairs <- function(iraceResults, index, instances = FALSE)
     warning("instances=TRUE requested, but instances are not of atomic type")
     return(instances_log)
   }
-    
+
   instanceID <- instances_log[["instanceID"]]
   cbind(instances_log, instance = instances[instanceID])
 }

tests/testthat/test-get-functions.R

@@ -0,0 +1,11 @@
+withr::with_output_sink("test-get-functions.Rout", {
+
+  test_that("getConfigurationById()", {
+    log <- read_logfile(system.file(package="irace", "exdata", "irace-acotsp.Rdata", mustWork=TRUE))
+    ids <- sample(log$allConfigurations[[".ID."]], size=3)
+    ids <- c(ids, rev(ids))
+    sel_ids <- getConfigurationById(log, ids = ids)[[".ID."]]
+    expect_identical(sel_ids, ids)
+})
+
+})