README.md
In CollinErickson/AdaptCompExp: Run adaptive computer experiments
AdaptCompExp
The goal of AdaptCompExp is to implement algorithms for adaptive
computer experiments.
Installation
You can install the development version of AdaptCompExp from
GitHub with:
# install.packages("devtools")
devtools::install_github("CollinErickson/AdaptCompExp")
Example of adapt.concept2.sFFLHD.R6
library(AdaptCompExp)
adapt.concept2.sFFLHD.R6 is an R6 class, meaning that you create a new
instance using adapt.concept2.sFFLHD.R6$new().
Some of the important parameters to see when making a new object:
-
D: the number of input dimensions
-
L: the number of points in each batch
-
func: the function to evaluate inputs
-
obj: The objective to maximize when selecting points.
-
des_func: The desirability function.
-
n0: The number of points to begin with before adding points in
batches.
a <- adapt.concept2.sFFLHD.R6$new(
D=2,L=3,func=TestFunctions::gaussian1,obj="desirability",
des_func=des_func_relmax, n0=20, take_until_maxpvar_below=.9,
package="GauPro", design='sFFLHD', selection_method="max_des_red",
alpha_des=1
)
#> Registered S3 method overwritten by 'DoE.base':
#> method from
#> factorize.factor conf.design
To run batches of the experiment, use $run(). By default it runs one
batch, but you can set how many. You can also tell it not to make plots.
a$run(2)
#> Starting iteration 1 at 2020-03-10 20:29:07
#> no suitable resolution IV or more array found
#> Warning in DoE.base::oa.design(nruns = L^2, nfactors = D + 1, nlevels = L, :
#> resources were not sufficient for optimizing column selection
#> Below nug.min, setting nug to nug.min and reoptimizing #82387
#> Starting iteration 2 at 2020-03-10 20:29:15
a$stats
#> $iteration
#> [1] 1 2
#>
#> $n
#> [1] 20 23
#>
#> $pvar
#> [1] 0.00904274 0.01684534
#>
#> $mse
#> [1] 0.008527951 0.041484027
#>
#> $ppu
#> [1] 0.9523810 0.6388889
#>
#> $minbatch
#> [1] 7 8
#>
#> $pamv
#> [1] 0.000 0.155
#>
#> $actual_intwerror
#> [1] NaN NaN
#>
#> $actual_intwvar
#> [1] NaN NaN
#>
#> $intwerror
#> [1] 0.01979764 0.02077772
#>
#> $intwvar
#> [1] 0.002002648 0.003025799
#>
#> $intwerror01
#> [1] NaN NaN
Example of a comparison
ca1 <- compare.adaptR6$new(func=TestFunctions::gaussian1, D=2, L=3,
batches=2, reps=2,
n0=6, obj="desirability",
selection_method=c('max_des', 'SMED'),
des_func=c('des_func_relmax', 'des_func_relmax')
)
#> [1] "TestFunctions::gaussian1"
#> [1] 2
#> [1] 3
#> [1] 3
#> [1] 2
#> [1] 2
#> [1] "desirability"
#> [1] 0
#> [1] 0
#> [1] 6
#> [1] "laGP"
#> [1] "max_des" "SMED"
#> [1] "sFFLHD"
#> [1] "des_func_relmax" "des_func_relmax"
ca1$run_all(noplot = T)
#> Running 1, completed 0/4 Tue Mar 10 8:29:27 PM 2020
#> Starting iteration 1 at 2020-03-10 20:29:27
#> no suitable resolution IV or more array found
#> Warning in DoE.base::oa.design(nruns = L^2, nfactors = D + 1, nlevels = L, :
#> resources were not sufficient for optimizing column selection
#> Starting iteration 2 at 2020-03-10 20:29:28
#> Running 2, completed 1/4 Tue Mar 10 8:29:30 PM 2020
#> Starting iteration 1 at 2020-03-10 20:29:30
#> no suitable resolution IV or more array found
#> Warning in DoE.base::oa.design(nruns = L^2, nfactors = D + 1, nlevels = L, :
#> resources were not sufficient for optimizing column selection
#> Starting iteration 2 at 2020-03-10 20:29:31
#> Running 3, completed 2/4 Tue Mar 10 8:29:32 PM 2020
#> Starting iteration 1 at 2020-03-10 20:29:32
#> no suitable resolution IV or more array found
#> Warning in DoE.base::oa.design(nruns = L^2, nfactors = D + 1, nlevels = L, :
#> resources were not sufficient for optimizing column selection
#> Starting iteration 2 at 2020-03-10 20:29:32
#> Running 4, completed 3/4 Tue Mar 10 8:29:33 PM 2020
#> Starting iteration 1 at 2020-03-10 20:29:33
#> no suitable resolution IV or more array found
#> Warning in DoE.base::oa.design(nruns = L^2, nfactors = D + 1, nlevels = L, :
#> resources were not sufficient for optimizing column selection
#> Starting iteration 2 at 2020-03-10 20:29:34
ca1$plot()
#> Warning: Removed 8 rows containing missing values (geom_path).
#> Warning: Removed 4 rows containing missing values (geom_path).
#> Warning: Removed 8 rows containing missing values (geom_point).
Code from papers
Below is some code that was used to create the results shown in papers.
# In order, these are
# 1. sFFLHD (nonadapt)
# 2. Sobol (nonadapt)
# 3. ALC (no weighting)
# 4. grad mean
# 5. IMVSE
# 6. VSMED
# 7. max VSE at point, not over surface
objs <- c("nonadapt","nonadapt","desirability","desirability",
"desirability", "desirability", "desirability")
selection_methods <- c("nonadapt","nonadapt", 'ALC_all_best',
'max_des_red_all_best', 'max_des_red_all_best',
'SMED', 'max_des_all_best')
designs <- c('sFFLHD_Lflex', "sobol", 'sFFLHD_Lflex', 'sFFLHD_Lflex', 'sFFLHD_Lflex',
'sFFLHD_Lflex', 'sFFLHD_Lflex')
des_funcs <- c('des_func_grad_norm2_mean','des_func_grad_norm2_mean',
'des_func_grad_norm2_mean','des_func_mean_grad_norm2',
'des_func_grad_norm2_mean','des_func_grad_norm2_mean',
'des_func_grad_norm2_mean')
source('.//compare_adaptconceptR6.R')
require('ggplot2'); require('dplyr'); require('magrittr')
run_test <- function(funcstring, reps, batches, D, L, stage1batches,
use_parallel=TRUE,
seed_start, design_seed_start, startover=FALSE) {
# print("c1 doesn't exist, creating new")
if (Sys.info()['sysname'] == "Windows") {
parallel_cores <- 'detect-1'
} else {
which_matches <- which(substr(commandArgs(),1,18) == "number_of_threads=")
if (length(which_matches) == 1) {
parallel_cores <- as.integer(substr(commandArgs()[which_matches], 19, 21))
cat("Found number of cores = ", parallel_cores, '\n')
} else {
parallel_cores <- 1
cat("Didn't find number of cores to use, setting to 1\n")
}
}
# Test that func and des func match
if (test_des_func_grad_norm2_mean(get(funcstring),
get(paste0('actual_des_func_grad_norm2_mean_', funcstring)),
D) < .99) {
stop(paste("actual_des_func_grad_norm2_mean doesn't match for ", funcstring))
}
c1 <- compare.adaptR6$new(func=funcstring, reps=reps, batches=batches, D=D, L=L,
n0=0, stage1batches=stage1batches,
obj=c(objs, "desirability"),
selection_method=c(selection_methods, "max_des_red_all_best"),
design=c(designs, "sFFLHD_Lflex"),
des_func=c(des_funcs,
paste0('actual_des_func_grad_norm2_mean_', funcstring)
), # HERE is key, add true one
actual_des_func=paste0('actual_des_func_grad_norm2_mean_', funcstring),
alpha_des=1, weight_const=0,
package="laGP_GauPro_kernel",
error_power=2,
seed_start=seed_start, design_seed_start=design_seed_start,
parallel=use_parallel, # always do parallel for temp_save
parallel_cores=parallel_cores, save_output=FALSE
)
# Check if already saved
c1_file <- paste0(c1$folder_path, "//object.rds")
if (file.exists(c1_file) && !startover) { # Load if saved, and recover
print("c1 already exists, loading")
c1 <- readRDS(c1_file)
c1$recover_parallel_temp_save(save_if_any_recovered=TRUE)
} else { # Otherwise create new
# Now it is created above and overwritten if not used
c1$recover_parallel_temp_save(save_if_any_recovered=TRUE)
}
# Run all, save temps
print("Running all c1")
already_run <- sum(c1$completed_runs)
if (use_parallel) {
c1$run_all(parallel_temp_save=TRUE, noplot=TRUE, run_order="reverse")
} else {
# For not parallel
while (TRUE) {
try(c1$run_one(noplot=TRUE))
c1$save_self()
print(table(c1$completed_runs))
if (all(c1$completed_runs == TRUE)) {break}
}
}
print("Finished c1, saving")
if (sum(c1$completed_runs) > already_run) {c1$save_self()}
return(c1)
}
Group.names <- c("obj=nonadapt,selection_method=nonadapt,design=sFFLHD_Lflex,des_func=des_func_grad_norm2_mean",
"obj=nonadapt,selection_method=nonadapt,design=sobol,des_func=des_func_grad_norm2_mean",
"obj=desirability,selection_method=ALC_all_best,design=sFFLHD_Lflex,des_func=des_func_grad_norm2_mean",
"obj=desirability,selection_method=max_des_red_all_best,design=sFFLHD_Lflex,des_func=des_func_mean_grad_norm2",
"obj=desirability,selection_method=max_des_red_all_best,design=sFFLHD_Lflex,des_func=des_func_grad_norm2_mean",
"obj=desirability,selection_method=SMED,design=sFFLHD_Lflex,des_func=des_func_grad_norm2_mean",
"obj=desirability,selection_method=max_des_all_best,design=sFFLHD_Lflex,des_func=des_func_grad_norm2_mean",
"obj=desirability,selection_method=max_des_red_all_best,design=sFFLHD_Lflex,des_func=actual_des_func_grad_norm2_mean_branin"
)
Group.names.clean <- c("sFFLHD", "Sobol", "ALC", "GradMean", "IMVSE", "VSMED", "MaxVal", "TrueGrad")
names(Group.names.clean) <- Group.names
# reps <- 10
if (F) {
reps <- 10
bran1 <- try(run_test(funcstring='branin', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1001000, design_seed_start=1011000))
franke1 <- try(run_test(funcstring='franke', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1002000, design_seed_start=1012000))
lim1 <- try(run_test(funcstring='limnonpoly', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1003000, design_seed_start=1013000))
beam1 <- try(run_test(funcstring='beambending', D=3, L=3, batches=4*10, reps=reps,
stage1batches=3, seed_start=1004000, design_seed_start=1014000))
otl1 <- try(run_test(funcstring='OTL_Circuit', D=6, L=4, batches=4*15, reps=reps,
stage1batches=4, seed_start=1005000, design_seed_start=1015000))
piston1 <- try(run_test(funcstring='piston', D=7, L=5, batches=4*14, reps=reps,
stage1batches=4, seed_start=1006000, design_seed_start=1016000));print("cut batches in half")
bh1 <- try(run_test(funcstring='borehole', D=8, L=5, batches=4*16, reps=reps,
stage1batches=5, seed_start=1007000, design_seed_start=1017000))
wing1 <- try(run_test(funcstring='wingweight', D=10, L=5, batches=4*20, reps=reps,
stage1batches=6, seed_start=1008000, design_seed_start=1018000))
}
# Look at results
if (F) {
bran1$outrawdf$Method <- Group.names.clean[bran1$outrawdf$Group]
ggplot(data=bran1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=bran1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=bran1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
franke1$outrawdf$Method <- Group.names.clean[franke1$outrawdf$Group]
ggplot(data=franke1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=franke1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=franke1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=franke1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(Method, actual_intwerrorquants.5, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
lim1$outrawdf$Method <- Group.names.clean[lim1$outrawdf$Group]
ggplot(data=lim1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=lim1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=lim1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
beam1$outrawdf$Method <- Group.names.clean[beam1$outrawdf$Group]
ggplot(data=beam1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=beam1$outrawdf %>% filter(n %in% c(30,60)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=beam1$outrawdf %>% filter(n %in% c(30,60)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
# otl1 <- readRDS("./compare_adaptconcept_output/wingweight_D=10_L=5_b=5_B=40_R=10_n0=0_s1b=6_S=1008000/object.rds")
otl1$outrawdf$Method <- Group.names.clean[otl1$outrawdf$Group]
ggplot(data=otl1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=otl1$outrawdf %>% filter(n %in% c(60,120)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=otl1$outrawdf %>% filter(n %in% c(60,120)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
# piston1 <- readRDS("./compare_adaptconcept_output/wingweight_D=10_L=5_b=5_B=40_R=10_n0=0_s1b=6_S=1008000/object.rds")
piston1$outrawdf$Method <- Group.names.clean[piston1$outrawdf$Group]
ggplot(data=piston1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=piston1$outrawdf %>% filter(n %in% c(70,140)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=piston1$outrawdf %>% filter(n %in% c(70,140)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
# bh1 <- readRDS("./compare_adaptconcept_output/wingweight_D=10_L=5_b=5_B=40_R=10_n0=0_s1b=6_S=1008000/object.rds")
bh1$outrawdf$Method <- Group.names.clean[bh1$outrawdf$Group]
ggplot(data=bh1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=bh1$outrawdf %>% filter(n %in% c(80,160)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=bh1$outrawdf %>% filter(n %in% c(80,160)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
wing1 <- readRDS("./compare_adaptconcept_output/wingweight_D=10_L=5_b=5_B=40_R=10_n0=0_s1b=6_S=1008000/object.rds")
wing1$outrawdf$Method <- Group.names.clean[wing1$outrawdf$Group]
ggplot(data=wing1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=wing1$outrawdf %>% filter(n %in% c(100,200)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=wing1$outrawdf %>% filter(n %in% c(100,200)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
}
if (F) {
# Waterfall
waterfall1 <- try(run_test(funcstring='waterfall', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
waterfall1$outrawdf$Method <- Group.names.clean[waterfall1$outrawdf$Group]
ggplot(data=waterfall1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=waterfall1$outrawdf %>% filter(n %in% c(20,40,80)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=waterfall1$outrawdf %>% filter(n %in% c(20,40,80)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
# gramacy2Dexp
gramacy2Dexp1 <- try(run_test(funcstring='gramacy2Dexp', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
gramacy2Dexp1$outrawdf$Method <- Group.names.clean[gramacy2Dexp1$outrawdf$Group]
ggplot(data=gramacy2Dexp1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=gramacy2Dexp1$outrawdf %>% filter(n %in% c(20,40,80)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=gramacy2Dexp1$outrawdf %>% filter(n %in% c(20,40,80)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
# gramacy6D
gramacy6D1 <- try(run_test(funcstring='gramacy6D', D=6, L=4, batches=4*15, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
gramacy6D1$outrawdf$Method <- Group.names.clean[gramacy6D1$outrawdf$Group]
ggplot(data=gramacy6D1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=gramacy6D1$outrawdf %>% filter(n %in% (c(20,40,80)*3)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=gramacy6D1$outrawdf %>% filter(n %in% (c(20,40,80)*3)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
gramacy6D1$outrawdf %>% filter(n==240) %>% group_by(Method) %>% summarize(n=n(), meanIWE=mean(actual_intwerror), sdIW=sd(actual_intwerror)/20)
}
if (F) {
# banana
banana1 <- try(run_test(funcstring='banana', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
banana1$outrawdf$Method <- Group.names.clean[banana1$outrawdf$Group]
ggplot(data=banana1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=banana1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=banana1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
banana1$outrawdf %>% filter(n==80) %>% group_by(Method) %>% summarize(n=n(), meanIWE=mean(actual_intwerror), sdIW=sd(actual_intwerror)/20)
}
if (F) {
# gramacy2Dexp3hole
gramacy2Dexp3hole1 <- try(run_test(funcstring='gramacy2Dexp3hole', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
gramacy2Dexp3hole1$outrawdf$Method <- Group.names.clean[gramacy2Dexp3hole1$outrawdf$Group]
ggplot(data=gramacy2Dexp3hole1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=gramacy2Dexp3hole1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=gramacy2Dexp3hole1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
}
if (F) {
# bananagramacy2Dexp, 6 input dims
bangram <- try(run_test(funcstring='bananagramacy2Dexp', D=6, L=4, batches=4*15, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
bangram$outrawdf$Method <- Group.names.clean[bangram$outrawdf$Group]
ggplot(data=bangram$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=bangram$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=bangram$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
}
if (F) {
# bananatimesgramacy2Dexp, 6 input dims
bangram2 <- try(run_test(funcstring='bananatimesgramacy2Dexp', D=6, L=4, batches=4*15, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
bangram2$outrawdf$Method <- Group.names.clean[bangram2$outrawdf$Group]
ggplot(data=bangram2$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=bangram2$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=bangram2$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
}
if (F) {
cf(function(xx) {TestFunctions::levy(c(.5*(xx[1]+.8+.3*xx[2]-.3), xx[2]))})
cf(levy)
cf(banana)
gcf(function(xx) {gramacy2Dexp(2*xx) + gramacy2Dexp(2*c(xx[1]-.7,xx[2]-.1)) - gramacy2Dexp(2*c(xx[1]-.5,xx[2]-.7))})
}
# ==================================================.
# ============== Doing 400 reps ---------------------------
#=======================================================.
reps2 <- 400
if (F) {
reps2 <- 400
# Run our new functions, use 400 reps
banana1 <- try(run_test(funcstring='banana', D=2, L=2, batches=4*10, reps=reps2,
stage1batches=3, seed_start=2000000, design_seed_start=2010000))
banana1$outrawdf$Method <- Group.names.clean[banana1$outrawdf$Group]
ggplot(data=banana1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=banana1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=banana1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_boxplot(size=2) + scale_y_log10() + facet_wrap(. ~ n)
banana1$outrawdf %>% filter(n==80) %>% group_by(Method) %>% summarize(n=n(), meanIWE=mean(actual_intwerror), sdIW=sd(actual_intwerror)/20)
levytilt1 <- try(run_test(funcstring='levytilt', D=2, L=2, batches=4*10, reps=reps2,
stage1batches=3, seed_start=2001000, design_seed_start=2011000))
levytilt1$outrawdf$Method <- Group.names.clean[levytilt1$outrawdf$Group]
ggplot(data=levytilt1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=levytilt1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=levytilt1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_boxplot(size=2) + scale_y_log10() + facet_wrap(. ~ n)
levytilt1$outrawdf %>% filter(n==80) %>% group_by(Method) %>% summarize(n=n(), meanIWE=mean(actual_intwerror), sdIW=sd(actual_intwerror)/20)
gramacy2Dexp1 <- try(run_test(funcstring='gramacy2Dexp', D=2, L=2, batches=4*10, reps=reps2,
stage1batches=3, seed_start=2002000, design_seed_start=2012000))
gramacy2Dexp1$outrawdf$Method <- Group.names.clean[gramacy2Dexp1$outrawdf$Group]
ggplot(data=gramacy2Dexp1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=gramacy2Dexp1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=gramacy2Dexp1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_boxplot(size=2) + scale_y_log10() + facet_wrap(. ~ n)
gramacy2Dexp1$outrawdf %>% filter(n==80) %>% group_by(Method) %>% summarize(n=n(), meanIWE=mean(actual_intwerror), sdIW=sd(actual_intwerror)/20)
gramacy2Dexp3hole1 <- try(run_test(funcstring='gramacy2Dexp3hole', D=2, L=2, batches=4*10, reps=reps2,
stage1batches=3, seed_start=2004000, design_seed_start=2014000))
gramacy2Dexp3hole1$outrawdf$Method <- Group.names.clean[gramacy2Dexp3hole1$outrawdf$Group]
ggplot(data=gramacy2Dexp3hole1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=gramacy2Dexp3hole1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=gramacy2Dexp3hole1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_boxplot(size=2) + scale_y_log10() + facet_wrap(. ~ n)
gramacy6D1 <- try(run_test(funcstring='gramacy6D', D=6, L=4, batches=4*15, reps=reps2,
stage1batches=3, seed_start=2003000, design_seed_start=2013000))
gramacy6D1$outrawdf$Method <- Group.names.clean[gramacy6D1$outrawdf$Group]
ggplot(data=gramacy6D1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=gramacy6D1$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=gramacy6D1$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_boxplot(size=2) + scale_y_log10() + facet_wrap(. ~ n)
gramacy6D1$outrawdf %>% filter(n==80) %>% group_by(Method) %>% summarize(n=n(), meanIWE=mean(actual_intwerror), sdIW=sd(actual_intwerror)/20)
}
if (F) {
# bananagramacy2Dexp, 6 input dims
bangram <- try(run_test(funcstring='bananagramacy2Dexp', D=6, L=4, batches=4*15, reps=reps2,
stage1batches=3, seed_start=2005000, design_seed_start=2015000))
bangram$outrawdf$Method <- Group.names.clean[bangram$outrawdf$Group]
ggplot(data=bangram$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=bangram$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=bangram$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
}
if (F) {
# bananatimesgramacy2Dexp, 6 input dims
bangram2 <- try(run_test(funcstring='bananatimesgramacy2Dexp', D=6, L=4, batches=4*15, reps=reps2,
stage1batches=3, seed_start=2006000, design_seed_start=2016000))
bangram2$outrawdf$Method <- Group.names.clean[bangram2$outrawdf$Group]
ggplot(data=bangram2$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=bangram2$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=bangram2$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
}
CollinErickson/AdaptCompExp documentation built on April 13, 2020, 4:53 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
AdaptCompExp
The goal of AdaptCompExp is to implement algorithms for adaptive computer experiments.
Installation
You can install the development version of AdaptCompExp from GitHub with:
# install.packages("devtools")
devtools::install_github("CollinErickson/AdaptCompExp")
Example of adapt.concept2.sFFLHD.R6
library(AdaptCompExp)
adapt.concept2.sFFLHD.R6 is an R6 class, meaning that you create a new
instance using adapt.concept2.sFFLHD.R6$new().
Some of the important parameters to see when making a new object:
-
D: the number of input dimensions
-
L: the number of points in each batch
-
func: the function to evaluate inputs
-
obj: The objective to maximize when selecting points.
-
des_func: The desirability function.
-
n0: The number of points to begin with before adding points in batches.
a <- adapt.concept2.sFFLHD.R6$new(
D=2,L=3,func=TestFunctions::gaussian1,obj="desirability",
des_func=des_func_relmax, n0=20, take_until_maxpvar_below=.9,
package="GauPro", design='sFFLHD', selection_method="max_des_red",
alpha_des=1
)
#> Registered S3 method overwritten by 'DoE.base':
#> method from
#> factorize.factor conf.design
To run batches of the experiment, use $run(). By default it runs one
batch, but you can set how many. You can also tell it not to make plots.
a$run(2)
#> Starting iteration 1 at 2020-03-10 20:29:07
#> no suitable resolution IV or more array found
#> Warning in DoE.base::oa.design(nruns = L^2, nfactors = D + 1, nlevels = L, :
#> resources were not sufficient for optimizing column selection
#> Below nug.min, setting nug to nug.min and reoptimizing #82387
#> Starting iteration 2 at 2020-03-10 20:29:15
a$stats
#> $iteration
#> [1] 1 2
#>
#> $n
#> [1] 20 23
#>
#> $pvar
#> [1] 0.00904274 0.01684534
#>
#> $mse
#> [1] 0.008527951 0.041484027
#>
#> $ppu
#> [1] 0.9523810 0.6388889
#>
#> $minbatch
#> [1] 7 8
#>
#> $pamv
#> [1] 0.000 0.155
#>
#> $actual_intwerror
#> [1] NaN NaN
#>
#> $actual_intwvar
#> [1] NaN NaN
#>
#> $intwerror
#> [1] 0.01979764 0.02077772
#>
#> $intwvar
#> [1] 0.002002648 0.003025799
#>
#> $intwerror01
#> [1] NaN NaN
Example of a comparison
ca1 <- compare.adaptR6$new(func=TestFunctions::gaussian1, D=2, L=3,
batches=2, reps=2,
n0=6, obj="desirability",
selection_method=c('max_des', 'SMED'),
des_func=c('des_func_relmax', 'des_func_relmax')
)
#> [1] "TestFunctions::gaussian1"
#> [1] 2
#> [1] 3
#> [1] 3
#> [1] 2
#> [1] 2
#> [1] "desirability"
#> [1] 0
#> [1] 0
#> [1] 6
#> [1] "laGP"
#> [1] "max_des" "SMED"
#> [1] "sFFLHD"
#> [1] "des_func_relmax" "des_func_relmax"
ca1$run_all(noplot = T)
#> Running 1, completed 0/4 Tue Mar 10 8:29:27 PM 2020
#> Starting iteration 1 at 2020-03-10 20:29:27
#> no suitable resolution IV or more array found
#> Warning in DoE.base::oa.design(nruns = L^2, nfactors = D + 1, nlevels = L, :
#> resources were not sufficient for optimizing column selection
#> Starting iteration 2 at 2020-03-10 20:29:28
#> Running 2, completed 1/4 Tue Mar 10 8:29:30 PM 2020
#> Starting iteration 1 at 2020-03-10 20:29:30
#> no suitable resolution IV or more array found
#> Warning in DoE.base::oa.design(nruns = L^2, nfactors = D + 1, nlevels = L, :
#> resources were not sufficient for optimizing column selection
#> Starting iteration 2 at 2020-03-10 20:29:31
#> Running 3, completed 2/4 Tue Mar 10 8:29:32 PM 2020
#> Starting iteration 1 at 2020-03-10 20:29:32
#> no suitable resolution IV or more array found
#> Warning in DoE.base::oa.design(nruns = L^2, nfactors = D + 1, nlevels = L, :
#> resources were not sufficient for optimizing column selection
#> Starting iteration 2 at 2020-03-10 20:29:32
#> Running 4, completed 3/4 Tue Mar 10 8:29:33 PM 2020
#> Starting iteration 1 at 2020-03-10 20:29:33
#> no suitable resolution IV or more array found
#> Warning in DoE.base::oa.design(nruns = L^2, nfactors = D + 1, nlevels = L, :
#> resources were not sufficient for optimizing column selection
#> Starting iteration 2 at 2020-03-10 20:29:34
ca1$plot()
#> Warning: Removed 8 rows containing missing values (geom_path).
#> Warning: Removed 4 rows containing missing values (geom_path).
#> Warning: Removed 8 rows containing missing values (geom_point).
Code from papers
Below is some code that was used to create the results shown in papers.
# In order, these are
# 1. sFFLHD (nonadapt)
# 2. Sobol (nonadapt)
# 3. ALC (no weighting)
# 4. grad mean
# 5. IMVSE
# 6. VSMED
# 7. max VSE at point, not over surface
objs <- c("nonadapt","nonadapt","desirability","desirability",
"desirability", "desirability", "desirability")
selection_methods <- c("nonadapt","nonadapt", 'ALC_all_best',
'max_des_red_all_best', 'max_des_red_all_best',
'SMED', 'max_des_all_best')
designs <- c('sFFLHD_Lflex', "sobol", 'sFFLHD_Lflex', 'sFFLHD_Lflex', 'sFFLHD_Lflex',
'sFFLHD_Lflex', 'sFFLHD_Lflex')
des_funcs <- c('des_func_grad_norm2_mean','des_func_grad_norm2_mean',
'des_func_grad_norm2_mean','des_func_mean_grad_norm2',
'des_func_grad_norm2_mean','des_func_grad_norm2_mean',
'des_func_grad_norm2_mean')
source('.//compare_adaptconceptR6.R')
require('ggplot2'); require('dplyr'); require('magrittr')
run_test <- function(funcstring, reps, batches, D, L, stage1batches,
use_parallel=TRUE,
seed_start, design_seed_start, startover=FALSE) {
# print("c1 doesn't exist, creating new")
if (Sys.info()['sysname'] == "Windows") {
parallel_cores <- 'detect-1'
} else {
which_matches <- which(substr(commandArgs(),1,18) == "number_of_threads=")
if (length(which_matches) == 1) {
parallel_cores <- as.integer(substr(commandArgs()[which_matches], 19, 21))
cat("Found number of cores = ", parallel_cores, '\n')
} else {
parallel_cores <- 1
cat("Didn't find number of cores to use, setting to 1\n")
}
}
# Test that func and des func match
if (test_des_func_grad_norm2_mean(get(funcstring),
get(paste0('actual_des_func_grad_norm2_mean_', funcstring)),
D) < .99) {
stop(paste("actual_des_func_grad_norm2_mean doesn't match for ", funcstring))
}
c1 <- compare.adaptR6$new(func=funcstring, reps=reps, batches=batches, D=D, L=L,
n0=0, stage1batches=stage1batches,
obj=c(objs, "desirability"),
selection_method=c(selection_methods, "max_des_red_all_best"),
design=c(designs, "sFFLHD_Lflex"),
des_func=c(des_funcs,
paste0('actual_des_func_grad_norm2_mean_', funcstring)
), # HERE is key, add true one
actual_des_func=paste0('actual_des_func_grad_norm2_mean_', funcstring),
alpha_des=1, weight_const=0,
package="laGP_GauPro_kernel",
error_power=2,
seed_start=seed_start, design_seed_start=design_seed_start,
parallel=use_parallel, # always do parallel for temp_save
parallel_cores=parallel_cores, save_output=FALSE
)
# Check if already saved
c1_file <- paste0(c1$folder_path, "//object.rds")
if (file.exists(c1_file) && !startover) { # Load if saved, and recover
print("c1 already exists, loading")
c1 <- readRDS(c1_file)
c1$recover_parallel_temp_save(save_if_any_recovered=TRUE)
} else { # Otherwise create new
# Now it is created above and overwritten if not used
c1$recover_parallel_temp_save(save_if_any_recovered=TRUE)
}
# Run all, save temps
print("Running all c1")
already_run <- sum(c1$completed_runs)
if (use_parallel) {
c1$run_all(parallel_temp_save=TRUE, noplot=TRUE, run_order="reverse")
} else {
# For not parallel
while (TRUE) {
try(c1$run_one(noplot=TRUE))
c1$save_self()
print(table(c1$completed_runs))
if (all(c1$completed_runs == TRUE)) {break}
}
}
print("Finished c1, saving")
if (sum(c1$completed_runs) > already_run) {c1$save_self()}
return(c1)
}
Group.names <- c("obj=nonadapt,selection_method=nonadapt,design=sFFLHD_Lflex,des_func=des_func_grad_norm2_mean",
"obj=nonadapt,selection_method=nonadapt,design=sobol,des_func=des_func_grad_norm2_mean",
"obj=desirability,selection_method=ALC_all_best,design=sFFLHD_Lflex,des_func=des_func_grad_norm2_mean",
"obj=desirability,selection_method=max_des_red_all_best,design=sFFLHD_Lflex,des_func=des_func_mean_grad_norm2",
"obj=desirability,selection_method=max_des_red_all_best,design=sFFLHD_Lflex,des_func=des_func_grad_norm2_mean",
"obj=desirability,selection_method=SMED,design=sFFLHD_Lflex,des_func=des_func_grad_norm2_mean",
"obj=desirability,selection_method=max_des_all_best,design=sFFLHD_Lflex,des_func=des_func_grad_norm2_mean",
"obj=desirability,selection_method=max_des_red_all_best,design=sFFLHD_Lflex,des_func=actual_des_func_grad_norm2_mean_branin"
)
Group.names.clean <- c("sFFLHD", "Sobol", "ALC", "GradMean", "IMVSE", "VSMED", "MaxVal", "TrueGrad")
names(Group.names.clean) <- Group.names
# reps <- 10
if (F) {
reps <- 10
bran1 <- try(run_test(funcstring='branin', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1001000, design_seed_start=1011000))
franke1 <- try(run_test(funcstring='franke', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1002000, design_seed_start=1012000))
lim1 <- try(run_test(funcstring='limnonpoly', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1003000, design_seed_start=1013000))
beam1 <- try(run_test(funcstring='beambending', D=3, L=3, batches=4*10, reps=reps,
stage1batches=3, seed_start=1004000, design_seed_start=1014000))
otl1 <- try(run_test(funcstring='OTL_Circuit', D=6, L=4, batches=4*15, reps=reps,
stage1batches=4, seed_start=1005000, design_seed_start=1015000))
piston1 <- try(run_test(funcstring='piston', D=7, L=5, batches=4*14, reps=reps,
stage1batches=4, seed_start=1006000, design_seed_start=1016000));print("cut batches in half")
bh1 <- try(run_test(funcstring='borehole', D=8, L=5, batches=4*16, reps=reps,
stage1batches=5, seed_start=1007000, design_seed_start=1017000))
wing1 <- try(run_test(funcstring='wingweight', D=10, L=5, batches=4*20, reps=reps,
stage1batches=6, seed_start=1008000, design_seed_start=1018000))
}
# Look at results
if (F) {
bran1$outrawdf$Method <- Group.names.clean[bran1$outrawdf$Group]
ggplot(data=bran1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=bran1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=bran1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
franke1$outrawdf$Method <- Group.names.clean[franke1$outrawdf$Group]
ggplot(data=franke1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=franke1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=franke1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=franke1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(Method, actual_intwerrorquants.5, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
lim1$outrawdf$Method <- Group.names.clean[lim1$outrawdf$Group]
ggplot(data=lim1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=lim1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=lim1$outrawdf %>% filter(n %in% c(20,40)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
beam1$outrawdf$Method <- Group.names.clean[beam1$outrawdf$Group]
ggplot(data=beam1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=beam1$outrawdf %>% filter(n %in% c(30,60)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=beam1$outrawdf %>% filter(n %in% c(30,60)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
# otl1 <- readRDS("./compare_adaptconcept_output/wingweight_D=10_L=5_b=5_B=40_R=10_n0=0_s1b=6_S=1008000/object.rds")
otl1$outrawdf$Method <- Group.names.clean[otl1$outrawdf$Group]
ggplot(data=otl1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=otl1$outrawdf %>% filter(n %in% c(60,120)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=otl1$outrawdf %>% filter(n %in% c(60,120)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
# piston1 <- readRDS("./compare_adaptconcept_output/wingweight_D=10_L=5_b=5_B=40_R=10_n0=0_s1b=6_S=1008000/object.rds")
piston1$outrawdf$Method <- Group.names.clean[piston1$outrawdf$Group]
ggplot(data=piston1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=piston1$outrawdf %>% filter(n %in% c(70,140)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=piston1$outrawdf %>% filter(n %in% c(70,140)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
# bh1 <- readRDS("./compare_adaptconcept_output/wingweight_D=10_L=5_b=5_B=40_R=10_n0=0_s1b=6_S=1008000/object.rds")
bh1$outrawdf$Method <- Group.names.clean[bh1$outrawdf$Group]
ggplot(data=bh1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=bh1$outrawdf %>% filter(n %in% c(80,160)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=bh1$outrawdf %>% filter(n %in% c(80,160)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
wing1 <- readRDS("./compare_adaptconcept_output/wingweight_D=10_L=5_b=5_B=40_R=10_n0=0_s1b=6_S=1008000/object.rds")
wing1$outrawdf$Method <- Group.names.clean[wing1$outrawdf$Group]
ggplot(data=wing1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=wing1$outrawdf %>% filter(n %in% c(100,200)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=wing1$outrawdf %>% filter(n %in% c(100,200)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
}
if (F) {
# Waterfall
waterfall1 <- try(run_test(funcstring='waterfall', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
waterfall1$outrawdf$Method <- Group.names.clean[waterfall1$outrawdf$Group]
ggplot(data=waterfall1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=waterfall1$outrawdf %>% filter(n %in% c(20,40,80)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=waterfall1$outrawdf %>% filter(n %in% c(20,40,80)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
# gramacy2Dexp
gramacy2Dexp1 <- try(run_test(funcstring='gramacy2Dexp', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
gramacy2Dexp1$outrawdf$Method <- Group.names.clean[gramacy2Dexp1$outrawdf$Group]
ggplot(data=gramacy2Dexp1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=gramacy2Dexp1$outrawdf %>% filter(n %in% c(20,40,80)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=gramacy2Dexp1$outrawdf %>% filter(n %in% c(20,40,80)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
# gramacy6D
gramacy6D1 <- try(run_test(funcstring='gramacy6D', D=6, L=4, batches=4*15, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
gramacy6D1$outrawdf$Method <- Group.names.clean[gramacy6D1$outrawdf$Group]
ggplot(data=gramacy6D1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=gramacy6D1$outrawdf %>% filter(n %in% (c(20,40,80)*3)), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=gramacy6D1$outrawdf %>% filter(n %in% (c(20,40,80)*3)), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
gramacy6D1$outrawdf %>% filter(n==240) %>% group_by(Method) %>% summarize(n=n(), meanIWE=mean(actual_intwerror), sdIW=sd(actual_intwerror)/20)
}
if (F) {
# banana
banana1 <- try(run_test(funcstring='banana', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
banana1$outrawdf$Method <- Group.names.clean[banana1$outrawdf$Group]
ggplot(data=banana1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=banana1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=banana1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
banana1$outrawdf %>% filter(n==80) %>% group_by(Method) %>% summarize(n=n(), meanIWE=mean(actual_intwerror), sdIW=sd(actual_intwerror)/20)
}
if (F) {
# gramacy2Dexp3hole
gramacy2Dexp3hole1 <- try(run_test(funcstring='gramacy2Dexp3hole', D=2, L=2, batches=4*10, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
gramacy2Dexp3hole1$outrawdf$Method <- Group.names.clean[gramacy2Dexp3hole1$outrawdf$Group]
ggplot(data=gramacy2Dexp3hole1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=gramacy2Dexp3hole1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=gramacy2Dexp3hole1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
}
if (F) {
# bananagramacy2Dexp, 6 input dims
bangram <- try(run_test(funcstring='bananagramacy2Dexp', D=6, L=4, batches=4*15, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
bangram$outrawdf$Method <- Group.names.clean[bangram$outrawdf$Group]
ggplot(data=bangram$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=bangram$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=bangram$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
}
if (F) {
# bananatimesgramacy2Dexp, 6 input dims
bangram2 <- try(run_test(funcstring='bananatimesgramacy2Dexp', D=6, L=4, batches=4*15, reps=reps,
stage1batches=3, seed_start=1009000, design_seed_start=1019000))
bangram2$outrawdf$Method <- Group.names.clean[bangram2$outrawdf$Group]
ggplot(data=bangram2$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=bangram2$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=bangram2$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
}
if (F) {
cf(function(xx) {TestFunctions::levy(c(.5*(xx[1]+.8+.3*xx[2]-.3), xx[2]))})
cf(levy)
cf(banana)
gcf(function(xx) {gramacy2Dexp(2*xx) + gramacy2Dexp(2*c(xx[1]-.7,xx[2]-.1)) - gramacy2Dexp(2*c(xx[1]-.5,xx[2]-.7))})
}
# ==================================================.
# ============== Doing 400 reps ---------------------------
#=======================================================.
reps2 <- 400
if (F) {
reps2 <- 400
# Run our new functions, use 400 reps
banana1 <- try(run_test(funcstring='banana', D=2, L=2, batches=4*10, reps=reps2,
stage1batches=3, seed_start=2000000, design_seed_start=2010000))
banana1$outrawdf$Method <- Group.names.clean[banana1$outrawdf$Group]
ggplot(data=banana1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=banana1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=banana1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_boxplot(size=2) + scale_y_log10() + facet_wrap(. ~ n)
banana1$outrawdf %>% filter(n==80) %>% group_by(Method) %>% summarize(n=n(), meanIWE=mean(actual_intwerror), sdIW=sd(actual_intwerror)/20)
levytilt1 <- try(run_test(funcstring='levytilt', D=2, L=2, batches=4*10, reps=reps2,
stage1batches=3, seed_start=2001000, design_seed_start=2011000))
levytilt1$outrawdf$Method <- Group.names.clean[levytilt1$outrawdf$Group]
ggplot(data=levytilt1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=levytilt1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=levytilt1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_boxplot(size=2) + scale_y_log10() + facet_wrap(. ~ n)
levytilt1$outrawdf %>% filter(n==80) %>% group_by(Method) %>% summarize(n=n(), meanIWE=mean(actual_intwerror), sdIW=sd(actual_intwerror)/20)
gramacy2Dexp1 <- try(run_test(funcstring='gramacy2Dexp', D=2, L=2, batches=4*10, reps=reps2,
stage1batches=3, seed_start=2002000, design_seed_start=2012000))
gramacy2Dexp1$outrawdf$Method <- Group.names.clean[gramacy2Dexp1$outrawdf$Group]
ggplot(data=gramacy2Dexp1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=gramacy2Dexp1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=gramacy2Dexp1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_boxplot(size=2) + scale_y_log10() + facet_wrap(. ~ n)
gramacy2Dexp1$outrawdf %>% filter(n==80) %>% group_by(Method) %>% summarize(n=n(), meanIWE=mean(actual_intwerror), sdIW=sd(actual_intwerror)/20)
gramacy2Dexp3hole1 <- try(run_test(funcstring='gramacy2Dexp3hole', D=2, L=2, batches=4*10, reps=reps2,
stage1batches=3, seed_start=2004000, design_seed_start=2014000))
gramacy2Dexp3hole1$outrawdf$Method <- Group.names.clean[gramacy2Dexp3hole1$outrawdf$Group]
ggplot(data=gramacy2Dexp3hole1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=gramacy2Dexp3hole1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=gramacy2Dexp3hole1$outrawdf %>% filter(n %in% (2*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_boxplot(size=2) + scale_y_log10() + facet_wrap(. ~ n)
gramacy6D1 <- try(run_test(funcstring='gramacy6D', D=6, L=4, batches=4*15, reps=reps2,
stage1batches=3, seed_start=2003000, design_seed_start=2013000))
gramacy6D1$outrawdf$Method <- Group.names.clean[gramacy6D1$outrawdf$Group]
ggplot(data=gramacy6D1$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=gramacy6D1$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=gramacy6D1$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_boxplot(size=2) + scale_y_log10() + facet_wrap(. ~ n)
gramacy6D1$outrawdf %>% filter(n==80) %>% group_by(Method) %>% summarize(n=n(), meanIWE=mean(actual_intwerror), sdIW=sd(actual_intwerror)/20)
}
if (F) {
# bananagramacy2Dexp, 6 input dims
bangram <- try(run_test(funcstring='bananagramacy2Dexp', D=6, L=4, batches=4*15, reps=reps2,
stage1batches=3, seed_start=2005000, design_seed_start=2015000))
bangram$outrawdf$Method <- Group.names.clean[bangram$outrawdf$Group]
ggplot(data=bangram$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=bangram$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=bangram$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
}
if (F) {
# bananatimesgramacy2Dexp, 6 input dims
bangram2 <- try(run_test(funcstring='bananatimesgramacy2Dexp', D=6, L=4, batches=4*15, reps=reps2,
stage1batches=3, seed_start=2006000, design_seed_start=2016000))
bangram2$outrawdf$Method <- Group.names.clean[bangram2$outrawdf$Group]
ggplot(data=bangram2$outrawdf, mapping=aes(n, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10()
ggplot(data=bangram2$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(des_func, actual_intwerror, color=des_func)) + geom_point() + scale_y_log10() + facet_wrap(. ~ n)
ggplot(data=bangram2$outrawdf %>% filter(n %in% (6*c(10,20,40))), mapping=aes(Method, actual_intwerror, color=des_func)) + geom_point(size=5) + scale_y_log10() + facet_wrap(. ~ n)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.