Improved Error Handling

Author: AnotherSamWilson

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ParBayesianOptimization
 Title: Parallel Bayesian Optimization of Hyperparameters
-Version: 1.1.0
+Version: 1.2.0
 Authors@R: person("Samuel", "Wilson", email = "[email protected]", role = c("aut", "cre"))
 Description: Fast, flexible framework for implementing Bayesian optimization of model 
 	hyperparameters according to the methods described in Snoek et al. <arXiv:1206.2944>.
@@ -15,6 +15,6 @@ Suggests: knitr, rmarkdown, xgboost, doParallel, testthat
 License: GPL-2
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.0.2
+RoxygenNote: 7.1.0
 VignetteBuilder: knitr
 Maintainer: Samuel Wilson <[email protected]>

NAMESPACE

@@ -19,6 +19,7 @@ importFrom(data.table,copy)
 importFrom(data.table,data.table)
 importFrom(data.table,fintersect)
 importFrom(data.table,is.data.table)
+importFrom(data.table,rbindlist)
 importFrom(data.table,setDT)
 importFrom(data.table,setcolorder)
 importFrom(data.table,setnames)

NEWS.md

@@ -1,5 +1,9 @@
-## ParBayesianOptimization 1.1.0
+## ParBayesianOptimization 1.2.0
+
+# Changes
+Improved the way error handling works - any errors encountered in initialization will be returned.
 
+## ParBayesianOptimization 1.1.0
 
 # Changes
 Changed Gaussian Process package to DiceKriging. predict method is much faster.

R/addIterations.R

@@ -207,10 +207,26 @@ addIterations <- function(
           )
         )
 
-        if (!any(class(Result) %in% c("simpleError","error","condition"))) {
-          return(data.table(nextPars[get("iter"),], Elapsed = Elapsed[[3]], as.data.table(Result),errorMessage = NA))
-        } else {
+      # Handle the Result.
+        if (any(class(Result) %in% c("simpleError","error","condition"))) {
           return(data.table(nextPars[get("iter"),], Elapsed = Elapsed[[3]],Score = NA, errorMessage = conditionMessage(Result)))
+        } else {
+
+          if (any(lengths(Result) != 1)) {
+            stop(
+              paste0(
+                  "FUN returned list with elements of length > 1. Cannot collapse into a data.table, so this is a fatal error. Parameters used were <"
+                , paste(names(Params),"=",Params,collapse = ", ")
+                , ">"
+              )
+            )
+          }
+
+          if (!is.numeric(Result$Score)) {
+            return(data.table(nextPars[get("iter"),], Elapsed = Elapsed[[3]], as.data.table(Result),errorMessage = "Score returned from FUN was not numeric."))
+          } else {
+            return(data.table(nextPars[get("iter"),], Elapsed = Elapsed[[3]], as.data.table(Result),errorMessage = NA))
+          }
         }
 
       }

R/bayesOpt.R

@@ -176,7 +176,7 @@
 #'   , verbose = 1
 #' )
 #' }
-#' @importFrom data.table data.table setDT setcolorder := as.data.table copy .I setnames is.data.table
+#' @importFrom data.table data.table setDT setcolorder := as.data.table copy .I setnames is.data.table rbindlist
 #' @importFrom utils head tail
 #' @export
 bayesOpt <- function(
@@ -271,7 +271,7 @@ bayesOpt <- function(
     scoreSummary <- foreach(
         iter = 1:nrow(initGrid)
       , .options.multicore = list(preschedule=FALSE)
-      , .combine = rbind
+      , .combine = list
       , .multicombine = TRUE
       , .inorder = FALSE
       , .errorhandling = 'pass'
@@ -280,18 +280,45 @@ bayesOpt <- function(
     ) %op% {
 
       Params <- initGrid[get("iter"),]
-      Elapsed <- system.time(Result <- do.call(what = FUN, args = as.list(Params)))
-      if(!any(names(Result) == "Score")) stop("FUN must return list with element 'Score' at a minimum.")
+      Elapsed <- system.time(
+        Result <- tryCatch(
+          {
+            do.call(what = FUN, args = as.list(Params))
+          }
+          , error = function(e) e
+        )
+      )
+
+      # 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.")
+      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.")
+      if(any(resLengths != 1)) {
+        badReturns <- names(Result)[which(resLengths != 1)]
+        stop("FUN returned these elements with length > 1: ",paste(badReturns,collapse = ","))
+      }
+
       data.table(Params,Elapsed = Elapsed[[3]],as.data.table(Result))
 
     }
   )[[3]]
   while (sink.number() > 0) sink()
   if (verbose > 0) cat(" ",tm,"seconds\n")
 
-  # foreach passes errors as a vector.
-  if (!is.data.table(scoreSummary)) {
-    stop(paste0("FUN failed to run on initial try. First error returned was <<",scoreSummary[[1]],">>"))
+  # Scan our list for any simpleErrors. If any exist, stop the process and return the errors.
+  se <- which(sapply(scoreSummary,function(cl) any(class(cl) %in% c("simpleError","error","condition"))))
+  if(length(se) > 0) {
+    print(
+      data.table(
+          initGrid[se,]
+        , errorMessage = sapply(scoreSummary[se],function(x) x$message)
+      )
+    )
+    stop("Errors encountered in initialization are listed above.")
+  } else {
+    scoreSummary <- rbindlist(scoreSummary)
   }
 
   # Format scoreSummary table. Initial iteration is set to 0

README.md

@@ -4,7 +4,7 @@
 [![Build
 Status](https://api.travis-ci.org/AnotherSamWilson/ParBayesianOptimization.svg)](https://travis-ci.org/AnotherSamWilson/ParBayesianOptimization)
 [![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/ParBayesianOptimization)](https://CRAN.R-project.org/package=ParBayesianOptimization)
-[![DEV\_Version\_Badge](https://img.shields.io/badge/Dev-1.1.0-blue.svg)](https://CRAN.R-project.org/package=ParBayesianOptimization)
+[![DEV\_Version\_Badge](https://img.shields.io/badge/Dev-1.2.0-blue.svg)](https://CRAN.R-project.org/package=ParBayesianOptimization)
 [![CRAN\_Downloads](https://cranlogs.r-pkg.org/badges/ParBayesianOptimization)](https://CRAN.R-project.org/package=ParBayesianOptimization)
 [![Coverage
 Status](https://codecov.io/gh/AnotherSamWilson/ParBayesianOptimization/branch/master/graph/badge.svg)](https://codecov.io/gh/AnotherSamWilson/ParBayesianOptimization/branch/master)
@@ -315,14 +315,14 @@ to see the results:
 ``` r
 optObj$scoreSummary
 #>    Epoch Iteration max_depth min_child_weight subsample gpUtility acqOptimum inBounds Elapsed     Score nrounds errorMessage
-#> 1:     0         1         2         1.670129 0.7880670        NA      FALSE     TRUE    0.12 0.9777163       2           NA
-#> 2:     0         2         2        14.913213 0.8763154        NA      FALSE     TRUE    0.28 0.9763760      15           NA
-#> 3:     0         3         4        18.833690 0.3403900        NA      FALSE     TRUE    0.46 0.9931657      18           NA
-#> 4:     0         4         4         8.639925 0.5499186        NA      FALSE     TRUE    0.27 0.9981437       7           NA
-#> 5:     1         5         4        21.871937 1.0000000 0.5857961       TRUE     TRUE    0.14 0.9945933       1           NA
-#> 6:     2         6         4         0.000000 0.9439879 0.6668303       TRUE     TRUE    0.27 0.9990567       7           NA
-#> 7:     3         7         5         1.395119 0.7071802 0.2973497       TRUE     TRUE    0.23 0.9984577       4           NA
-#> 8:     4         8         5         0.000000 0.2500000 0.3221660       TRUE     TRUE    0.38 0.9994020      10           NA
+#> 1:     0         1         2         1.670129 0.7880670        NA      FALSE     TRUE    0.07 0.9777163       2           NA
+#> 2:     0         2         2        14.913213 0.8763154        NA      FALSE     TRUE    0.15 0.9763760      15           NA
+#> 3:     0         3         4        18.833690 0.3403900        NA      FALSE     TRUE    0.20 0.9931657      18           NA
+#> 4:     0         4         4         8.639925 0.5499186        NA      FALSE     TRUE    0.12 0.9981437       7           NA
+#> 5:     1         5         4        21.871937 1.0000000 0.5857961       TRUE     TRUE    0.08 0.9945933       1           NA
+#> 6:     2         6         4         0.000000 0.9439879 0.6668303       TRUE     TRUE    0.12 0.9990567       7           NA
+#> 7:     3         7         5         1.395119 0.7071802 0.2973497       TRUE     TRUE    0.11 0.9984577       4           NA
+#> 8:     4         8         5         0.000000 0.2500000 0.3221660       TRUE     TRUE    0.16 0.9994020      10           NA
 ```
 
 ``` r
@@ -381,10 +381,10 @@ optimization steps, versus the 4 performed in the sequential example:
 ``` r
 tWithPar
 #>    user  system elapsed 
-#>    0.89    0.04    6.82
+#>    0.96    0.05    7.47
 tNoPar
 #>    user  system elapsed 
-#>   21.92    2.19   21.47
+#>   23.33    0.83   22.74
 ```
 
 ## Sampling Multiple Promising Points at Once

cran-comments.md

@@ -1,6 +1,6 @@
 
 ## Test environments
-* local Windows 10 x64, R 3.6.1
+* local Windows 10 x64, R 4.0.0
 * Windows Server 2008 R2 SP1 32/64 bit (Rhub)
 * Ubuntu Linux 16.04 LTS (Rhub)
 * Fedora Linux (Rhub)
@@ -14,6 +14,4 @@ There were no ERRORs, WARNINGs or NOTEs
 There are no downstream dependencies.
 
 ## Changes
-Changed Gaussian Process package to DiceKriging. predict method is much faster.
-Added errorHandling parameter - bayesOpt() and addIterations() should now return results no matter what, unless errorHandling = 'stop'
-Added otherHalting parameter.
+Improve error handling. Errors are now always returned without exception.

man/figures/README-plotObj-1.png

@@ -75,3 +75,76 @@ testthat::test_that(
   }
 
 )
+
+testthat::test_that(
+
+  "1D Error Handling"
+
+  , {
+
+    skip_on_cran()
+    set.seed(14)
+    sf <- function(x) 1000 - x^2
+
+    FUN <- function(x) {
+      if (runif(1) > 0.5) stop("You foo'd when you should have bar'd.")
+      return(list(Score = sf(x)))
+    }
+
+    bounds = list(
+      x = c(-1000,1000)
+    )
+
+    optObj <- bayesOpt(
+      FUN
+      , bounds
+      , initPoints = 3
+      , iters.n = 8
+      , errorHandling = 2
+      , verbose = 1
+    )
+
+    optObj$scoreSummary
+
+    expect_equal(
+      optObj$stopStatus
+      , ParBayesianOptimization:::makeStopEarlyMessage("Errors from FUN exceeded errorHandling limit")
+    )
+
+  }
+
+)
+
+testthat::test_that(
+
+  "Malformed FUN Return"
+
+  , {
+
+    skip_on_cran()
+    set.seed(14)
+    sf <- function(x) 1000 - x^2
+
+    FUN <- function(x) {
+      ot <- if (runif(1) > 0.75) c(0,1) else 1
+      return(list(Score = sf(x), ot = ot))
+    }
+
+    bounds = list(
+      x = c(-1000,1000)
+    )
+
+    expect_error(
+      bayesOpt(
+        FUN
+        , bounds
+        , initPoints = 3
+        , iters.n = 8
+        , errorHandling = 2
+        , verbose = 1
+      )
+    )
+
+  }
+
+)