diff --git a/ParBayesianOptimization.Rproj b/ParBayesianOptimization.Rproj index 270314b..cc8eaa6 100644 --- a/ParBayesianOptimization.Rproj +++ b/ParBayesianOptimization.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: 8ae895b8-1b05-45be-b9df-6b55fc0867bd RestoreWorkspace: Default SaveWorkspace: Default diff --git a/R/SmallFuncs.R b/R/SmallFuncs.R index c94f61f..e05577a 100644 --- a/R/SmallFuncs.R +++ b/R/SmallFuncs.R @@ -117,8 +117,10 @@ saveSoFar <- function(optObj,verbose) { if (!is.null(optObj$saveFile)) { tryCatch( { - suppressWarnings(saveRDS(optObj, file = optObj$saveFile)) - if (verbose > 0) cat(" 4) Saving Intermediary Results to: \n ",optObj$saveFile,"\n") + temp = optObj + temp$FUN = NULL + suppressWarnings(saveRDS(temp, file = temp$saveFile)) + if (verbose > 0) cat(" 4) Saving Intermediary Results to: \n ",temp$saveFile,"\n") } , error = function(e) { if (verbose > 0) cat(red(" 4) Failed to save intermediary results. Please check file path.\n")) diff --git a/R/addIterations.R b/R/addIterations.R index 033e74e..51cb950 100644 --- a/R/addIterations.R +++ b/R/addIterations.R @@ -165,6 +165,7 @@ addIterations <- function( ) )[[3]] if (verbose > 0) cat(" ",tm,"seconds\n") + tm_local_search = tm # Should we continue? if (otherHalting$minUtility > max(LocalOptims$gpUtility)) { @@ -228,7 +229,7 @@ addIterations <- function( # 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))) + return(data.table(nextPars[get("iter"),], Elapsed = Elapsed[[3]], ElapsedLocalSearch = tm_local_search, Score = NA, errorMessage = conditionMessage(Result))) } else { if (any(lengths(Result) != 1)) { @@ -242,9 +243,9 @@ addIterations <- function( } 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.")) + return(data.table(nextPars[get("iter"),], Elapsed = Elapsed[[3]], ElapsedLocalSearch = tm_local_search, 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)) + return(data.table(nextPars[get("iter"),], Elapsed = Elapsed[[3]], ElapsedLocalSearch = tm_local_search, as.data.table(Result),errorMessage = NA)) } } diff --git a/R/bayesOpt.R b/R/bayesOpt.R index ce50fb3..d011d92 100644 --- a/R/bayesOpt.R +++ b/R/bayesOpt.R @@ -220,6 +220,12 @@ bayesOpt <- function( startT <- Sys.time() + # look for defaults that are literally the same symbol as the arg‐name + argNames <- names(formals(FUN))[names(formals(FUN)) == as.character(formals(FUN))] + for (argName in argNames) { + formals(FUN)[[argName]] <- get(argName) + } + # Construct bayesOpt list optObj <- list() class(optObj) <- "bayesOpt" @@ -285,12 +291,27 @@ bayesOpt <- function( # Run initialization if (verbose > 0) cat("\nRunning initial scoring function",nrow(initGrid),"times in",Workers,"thread(s)...") sink(file = sinkFile) + + optObj$initPars$scoreSummary = list() + listAndSave <- function(already, newRow) { + # already: the accumulated result so far (a list of data.tables) + # newRow: the one data.table returned by a freshly completed iteration + if(!is.null(already) && already$Iteration == 1) { + optObj$initPars$scoreSummary[[1]] <<- already + } + nextIdx <- newRow$Iteration + optObj$initPars$scoreSummary[[nextIdx]] <<- newRow + optObj$scoreSummary <<- rbindlist(optObj$initPars$scoreSummary, fill = TRUE) + saveSoFar(optObj, verbose = verbose) + NULL + } + tm <- system.time( scoreSummary <- foreach( iter = 1:nrow(initGrid) , .options.multicore = list(preschedule=FALSE) - , .combine = list - , .multicombine = TRUE + , .combine = listAndSave + , .multicombine = FALSE , .inorder = FALSE , .errorhandling = 'pass' #, .packages ='data.table' @@ -308,35 +329,34 @@ 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 (!inherits(x = Result, what = "list")) stop("Object returned from FUN was not a list.") + if (any(class(Result) %in% c("simpleError","error","condition"))) return( + data.table(Iteration = get("iter"), Params, errorMessage = Result$message)) + + if (!inherits(x = Result, what = "list")) return( + data.table(Iteration = get("iter"), Params, errorMessage = "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(names(Result) == "Score")) return( + data.table(Iteration = get("iter"), Params, errorMessage = "FUN must return list with element 'Score' at a minimum.")) + + if (!is.numeric(Result$Score)) return( + data.table(Iteration = get("iter"), Params, errorMessage = "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 = ",")) + return(data.table(Iteration = get("iter"), Params, errorMessage = paste0("FUN returned these elements with length > 1: ",paste(badReturns,collapse = ",")))) } - data.table(Params,Elapsed = Elapsed[[3]],as.data.table(Result)) - + data.table(Iteration = get("iter"), Params,Elapsed = Elapsed[[3]],as.data.table(Result)) } )[[3]] while (sink.number() > 0) sink() if (verbose > 0) cat(" ",tm,"seconds\n") + scoreSummary = optObj$scoreSummary # 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) - ) - ) + if(any(!is.null(scoreSummary$errorMessage))) { stop("Errors encountered in initialization are listed above.") - } else { - scoreSummary <- rbindlist(scoreSummary) } # Format scoreSummary table. Initial iteration is set to 0 diff --git a/tests/testthat/test-bayesOpt2D.R b/tests/testthat/test-bayesOpt2D.R index 2d1166e..3e5e5f6 100644 --- a/tests/testthat/test-bayesOpt2D.R +++ b/tests/testthat/test-bayesOpt2D.R @@ -1,4 +1,4 @@ -testthat::test_that( +test_that( "2 Dimension" diff --git a/tests/testthat/test-errorHandling.R b/tests/testthat/test-errorHandling.R index e0aa267..dea33aa 100644 --- a/tests/testthat/test-errorHandling.R +++ b/tests/testthat/test-errorHandling.R @@ -1,6 +1,6 @@ context('errorHandling') -testthat::test_that( +test_that( "continue" diff --git a/tests/testthat/test-errorHandlingInitialization.R b/tests/testthat/test-errorHandlingInitialization.R index 4be5bc0..5acba51 100644 --- a/tests/testthat/test-errorHandlingInitialization.R +++ b/tests/testthat/test-errorHandlingInitialization.R @@ -1,6 +1,6 @@ context('errorHandling') -testthat::test_that( +test_that( "Error in FUN - Initialization"