Merge pull request #53 from kapsner/master

Fix #52: removing `setorder` due to reproducibility-issues

Author: AnotherSamWilson

.gitignore

@@ -1,7 +1,5 @@
-.Rproj
 .Rbuildignore
 .Rhistory
-ParBayesianOptimization.Rproj
 README.Rmd
 CRAN-RELEASE
 .Rproj.user

DESCRIPTION

@@ -14,6 +14,6 @@ Imports: data.table (>= 1.11.8), DiceKriging, stats, foreach, dbscan, lhs, crayo
 Suggests: knitr, rmarkdown, xgboost, doParallel, testthat
 License: GPL-2
 Encoding: UTF-8
-RoxygenNote: 7.1.1
+RoxygenNote: 7.2.1
 VignetteBuilder: knitr
 Maintainer: Samuel Wilson <[email protected]>

NAMESPACE

@@ -12,6 +12,7 @@ import(foreach)
 importFrom(DiceKriging,km)
 importFrom(crayon,make_style)
 importFrom(crayon,red)
+importFrom(data.table,".SD")
 importFrom(data.table,":=")
 importFrom(data.table,.I)
 importFrom(data.table,as.data.table)
@@ -23,7 +24,6 @@ importFrom(data.table,rbindlist)
 importFrom(data.table,setDT)
 importFrom(data.table,setcolorder)
 importFrom(data.table,setnames)
-importFrom(data.table,setorder)
 importFrom(data.table,uniqueN)
 importFrom(dbscan,dbscan)
 importFrom(ggplot2,aes_string)

ParBayesianOptimization.Rproj

@@ -0,0 +1,21 @@
+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace

R/SmallFuncs.R

@@ -160,7 +160,7 @@ checkParameters <- function(
   if (parallel & (getDoParWorkers() == 1)) stop("parallel is set to TRUE but no back end is registered.\n")
   if (!parallel & getDoParWorkers() > 1 & verbose > 0) message("parallel back end is registered, but parallel is set to false. Process will not be run in parallel.")
   if (any(!names(otherHalting) %in% c("timeLimit","minUtility"))) stop("otherHalting element not recognized. Must be one of timeLimit and minUtility.")
-  if (class(bounds) != "list") stop("bounds must be a list of parameter bounds with the same arguments as FUN.")
+  if (!inherits(x = bounds, what = "list")) stop("bounds must be a list of parameter bounds with the same arguments as FUN.")
   if (any(lengths(bounds) != 2)) stop("Not all elements in bounds are length 2.")
   if (acqThresh > 1 | acqThresh < 0) stop("acqThresh must be in [0,1]")
   if (!is.logical(plotProgress)) stop("plotProgress must be logical")

R/addIterations.R

@@ -70,7 +70,7 @@ addIterations <- function(
 ) {
 
   startT <- Sys.time()
-  if(class(optObj) != "bayesOpt") stop("optObj must be of class bayesOpt")
+  if (!inherits(x = optObj, what = "bayesOpt")) stop("optObj must be of class bayesOpt")
 
   # Check the parameters
   checkParameters(

R/bayesOpt.R

@@ -309,7 +309,7 @@ bayesOpt <- function(
 
       # Make sure everything was returned in the correct format. Any errors here will be passed.
       if (any(class(Result) %in% c("simpleError","error","condition"))) return(Result)
-      if (class(Result) != "list") stop("Object returned from FUN was not a list.")
+      if (!inherits(x = Result, what = "list")) stop("Object returned from FUN was not a list.")
       resLengths <- lengths(Result)
       if (!any(names(Result) == "Score")) stop("FUN must return list with element 'Score' at a minimum.")
       if (!is.numeric(Result$Score)) stop("Score returned from FUN was not numeric.")

R/changeSaveFile.R

@@ -29,7 +29,7 @@
 #' @export
 changeSaveFile <- function(optObj,saveFile = NULL) {
 
-  if (class(optObj) != "bayesOpt") stop("optObj should be of class bayesOpt.")
+  if (!inherits(x = optObj, what = "bayesOpt")) stop("optObj should be of class bayesOpt.")
 
   # See if saveFile can be written to.
   if (!is.null(saveFile)) {

R/getNextParameters.R

@@ -1,5 +1,7 @@
 #' @importFrom dbscan dbscan
-#' @importFrom data.table fintersect uniqueN setorder
+#' @importFrom data.table fintersect
+#' @importFrom data.table uniqueN
+#' @importFrom data.table ".SD"
 getNextParameters <- function(
     LocalOptims
   , boundsDT
@@ -15,17 +17,21 @@ getNextParameters <- function(
 ) {
 
   LocalOptims <- LocalOptims[get("relUtility") >= acqThresh,]
-  LocalOptims <- LocalOptims[,c(boundsDT$N,"gpUtility"),with=FALSE]
-  setorder(LocalOptims,-"gpUtility")
+  LocalOptims <- LocalOptims[
+    ,
+    .SD,
+    .SDcols = c(boundsDT$N,"gpUtility")
+  ]
+
   LocalOptims$acqOptimum <- TRUE
 
   # Mark clusters as duplicates if they have already been attempted. Note that
   # parameters must match exactly. Whether or not we should eliminate 'close'
   # parameters is experimental, and could cause problems as the parameter space
   # becomes more fully explored.
   LocalOptims$Duplicate <- checkDup(
-      LocalOptims[,boundsDT$N,with=FALSE]
-    , scoreSummary[,boundsDT$N,with=FALSE]
+      LocalOptims[, boundsDT$N, with = FALSE]
+    , scoreSummary[, boundsDT$N, with = FALSE]
   )
 
   # If we already have runNew non-duplicate local optims, use the best of those.

R/updateGP.R

@@ -75,7 +75,7 @@ updateGP <- function(optObj,bounds = optObj$bounds,verbose = 1, ...) {
         }
       )
 
-      if (class(sgp) == "stopEarlyMsg") {
+      if (inherits(x = sgp, what = "stopEarlyMsg")) {
         optObj$stopStatus <- sgp
         return(optObj)
       } else {