# source("adaptconcept2_sFFLHD_R6.R")
# library(ggplot2)
#' @importFrom grDevices axisTicks
base_breaks <- function(n = 10){
function(x) {
axisTicks(log10(range(x, na.rm = TRUE)), log = TRUE, nint = n)
}
}
#' Compare adapt R6
#' @export
compare.adaptR6 <- R6::R6Class("compare.adaptR6",
public=list(
func = NULL,
D = NULL,
L = NULL,
b = NULL,
batches = NULL,
reps = NULL,
obj = NULL,#=c("nonadapt", "grad"),
#plot_after = NULL,#=c(),
#plot_every = NULL,#=c(),
forces = NULL,#=c("old"),
force_vals = NULL,#=c(0),
force_old = NULL,
force_pvar = NULL,
n0 = NULL,#=0,
stage1batches = NULL,#=0
save_output = NULL,#=F,
func_string = NULL,
seed_start = NULL, # Start with seed to make comparisons much better,
# default is to use Sys.time() to get seed.
design_seed_start = NULL,
# folder_created = FALSE,
folder_path = NULL,
folder_name = NULL,
outdf = data.frame(),
outrawdf = data.frame(),
plotdf = data.frame(),
enddf = data.frame(),
meandf = data.frame(),
meanlogdf = data.frame(),
endmeandf = data.frame(),
rungrid = data.frame(),
rungridlist = list(),
package = NULL,
selection_method=NULL,
des_func=NULL,
alpha_des = NULL,
weight_const = NULL,
error_power = NULL,
actual_des_func=NULL,
design = NULL,
number_runs = NULL,
completed_runs = NULL,
pass_list = NULL,
parallel = NULL,
parallel_cores = NULL,
parallel_cluster = NULL,
initialize = function(func, D, L, b=NULL, batches=10, reps=5,
obj=c("nonadapt", "grad"),
#plot_after=c(), plot_every=c(),
#forces=c("old"),force_vals=c(0),
force_old=c(0), force_pvar=c(0),
n0=0, stage1batches=0,
save_output=F, func_string = NULL,
seed_start=as.numeric(Sys.time()),
design_seed_start=as.numeric(Sys.time()),
package="laGP",
selection_method='SMED',
design='sFFLHD',
des_func=NA, alpha_des=1, weight_const=0,
error_power=1,
actual_des_func=NULL,
pass_list=list() # List of things to pass to adapt concept for each
, folder_name,
parallel=FALSE, parallel_cores="detect"
) {
print('creating compad')
self$func <- func
self$D <- D
self$L <- L
if (is.null(b)) {
b <- L
}
self$b <- b
self$batches <- batches
self$reps <- reps
self$obj <- obj
#self$forces <- forces
#self$force_vals <- force_vals
self$force_old <- force_old
self$force_pvar <- force_pvar
self$n0 <- n0
self$stage1batches <- stage1batches
self$save_output <- save_output
self$seed_start <- seed_start
self$design_seed_start <- design_seed_start
self$package <- package
self$selection_method <- selection_method
self$design <- self$design
self$des_func <- des_func
self$alpha_des <- alpha_des
self$weight_const <- weight_const
self$error_power <- error_power
self$actual_des_func <- actual_des_func
self$pass_list <- pass_list
self$parallel <- parallel
self$parallel_cores <- parallel_cores
if (self$parallel) { # For now assume using parallel package
if (parallel_cores == "detect") {
self$parallel_cores <- parallel::detectCores()
} else if (parallel_cores == "detect-1") {
detectCor <- parallel::detectCores()
if (detectCor == 1) {
stop("Only 1 core detected, can't do 'detect-1'")
}
self$parallel_cores <- detectCor - 1
} else {
self$parallel_cores <- parallel_cores
}
}
if (is.null(func_string)) {
if (is.character(func)) {func_string <- func}
else if (length(func) == 1){func_string <- paste0(deparse(substitute(func)), collapse='')}
else if (length(func) > 1) {func_string <- paste0('func',1:length(func))}
else {stop("Function error 325932850")}
}
self$func_string <- func_string
self$set_folder_name(folder_name=folder_name)
if (any(is.function(func))) {
}
self$rungrid <- reshape::expand.grid.df(
data.frame(
func=func_string, func_string=func_string,
func_num=1:length(func), stringsAsFactors=FALSE
),
data.frame(D),data.frame(L), data.frame(b),
data.frame(repl=1:reps,
seed=if(!is.null(seed_start)) seed_start+1:reps-1 else NA,
design_seed=if(!is.null(design_seed_start)) {
design_seed_start+(1:reps-1)*1e5
} else {NA}),
data.frame(reps),
data.frame(batches),
data.frame(obj, selection_method, des_func,
alpha_des, weight_const, error_power,
actual_des_func, #=deparse(substitute(actual_des_func)),
actual_des_func_num=1:length(actual_des_func),
design,
stringsAsFactors = F),
#data.frame(forces=forces,force_vals=force_vals),
data.frame(force_old,force_pvar),
data.frame(n0),
data.frame(stage1batches),
data.frame(package, stringsAsFactors = FALSE)
#data.frame(selection_method, des_func, stringsAsFactors = FALSE)
)
#self$multiple_option_columns <- c()
#self$rungrid$Group <- ""
group_names <- c()
# These are columns to use to split into groups
for (i_input in c('func_string', 'D', 'L', 'b', 'reps', 'batches', 'obj',
'force_old', 'force_pvar', 'n0','package',
'selection_method', 'design', 'des_func')) {
evalparsei <- eval(parse(text=i_input))
if (length(evalparsei) > 1 && !all(evalparsei == evalparsei[1])) {
#self$rungrid$Group <- paste(self$rungrid$Group, self$rungrid[,i_input])
group_names <- c(group_names, i_input)
}
}
if (length(group_names) == 0) {
stop("All inputs are length one, need at least one with multiple values #59102")
}
group_cols <- sapply(group_names, function(gg){paste0(gg,'=',self$rungrid[,gg])})
self$rungrid$Group <- apply(group_cols, 1, function(rr){paste(rr, collapse=',')})
self$rungridlist <- as.list(
self$rungrid[, !(colnames(self$rungrid) %in%
c("func_string", "func_num", "repl","reps","batches",
"seed","Group", "actual_des_func_num"))])
self$rungridlist$func <- c(func)[self$rungrid$func_num]
self$rungridlist$actual_des_func <- c(actual_des_func)[self$rungrid$actual_des_func_num]
self$number_runs <- nrow(self$rungrid)
self$completed_runs <- rep(FALSE, self$number_runs)
#self$outrawdf <- data.frame()
},
set_folder_name = function(folder_name, add_timestamp=FALSE) {
if (missing(folder_name)) {
folderTime0 <- gsub(" ","_", Sys.time())
folderTime <- gsub(":","-", folderTime0)
t1 <- c(self$func_string,"_D=",self$D,"_L=",self$L,"_b=",self$b,
"_B=",self$batches,"_R=",self$reps,"_n0=",self$n0,
# "_Fold=",self$force_old,"_Fpvar=",self$force_pvar,
"_s1b=",self$stage1batches)
if (!is.null(self$seed_start)) {t1 <- c(t1,"_","S=",self$seed_start)}
if (add_timestamp) {t1 <- c(t1,"_",folderTime)}
folder_name <- paste0(t1, collapse = "")
}
self$folder_name <- folder_name
self$folder_path <- paste0("./compare_adaptconcept_output/",self$folder_name)
},
create_output_folder = function(add_timestamp = FALSE) {
# if (self$folder_created) {return(invisible(self))}
if (!dir.exists(self$folder_path)) {
dir.create(path = self$folder_path)
# self$folder_created = TRUE
} else {
# stop("Error, folder already exists but folder_created==FALSE")
}
invisible(self)
},
run_all = function(redo = FALSE, noplot=FALSE, save_every=FALSE, run_order,
parallel=self$parallel, parallel_temp_save=FALSE) {
if (!redo) { # Only run ones that haven't been run yet
to_run <- which(self$completed_runs == FALSE)
} else {
to_run <- 1:self$number_runs
}
# Set run order
if (missing(run_order)) { # random for parallel for load balancing
if (self$parallel) {run_order <- "random"}
else {run_order <- "inorder"}
}
if (run_order == "inorder") {} # Leave it in order
else if (run_order == "reverse") {to_run <- rev(to_run)}
else if (run_order == "random") {to_run <- sample(to_run)}
else {stop("run_order not recognized #567128")}
# Run, handle parallel differently
if (parallel) {
if (is.null(self$parallel_cluster)) {
self$parallel_cluster <- parallel::makeCluster(spec = self$parallel_cores, type = "SOCK")
}
if (parallel_temp_save) {self$create_output_folder()}
parout <- parallel::clusterApplyLB(
cl=self$parallel_cluster,
to_run,
function(ii){
tempout <- self$run_one(ii, is_parallel=TRUE, noplot=TRUE)
if (parallel_temp_save) {
saveRDS(object=tempout, file=paste0(self$folder_path,"/parallel_temp_output_",ii,".rds"))
}
tempout
})
lapply(parout, function(oneout) {do.call(self$add_result_of_one, oneout)})
parallel::stopCluster(self$parallel_cluster)
self$parallel_cluster <- NULL
if (parallel_temp_save) {
sapply(to_run,
function(ii) {
unlink(paste0(self$folder_path,"/parallel_temp_output_",ii,".rds"))
})
self$delete_save_folder_if_empty()
}
} else {
# sapply(to_run,function(ii){self$run_one(ii, noplot=noplot)})
for (ii in to_run) {
self$run_one(ii, noplot=noplot)
if (save_every) {self$save_self()}
}
}
self$postprocess_outdf()
invisible(self)
},
run_one = function(irow=NULL, save_output=self$save_output, noplot=FALSE, is_parallel=FALSE) {
if (is.null(irow)) { # If irow not given, set to next not run
if (any(self$completed_runs == FALSE)) {
irow <- which(self$completed_runs == 0)[1]
} else {
stop("irow not given and all runs completed")
}
} else if (length(irow) > 1) { # If more than one, run each separately
sapply(irow, function(ii){self$run_one(irow=ii, save_output=save_output)})
return(invisible(self))
} else if (self$completed_runs[irow] == TRUE) {
warning("irow already run, will run again anyways")
}
cat("Running ", irow, ", completed ", sum(self$completed_runs),"/",
length(self$completed_runs), " ",
format(Sys.time(), "%a %b %d %X %Y"), "\n", sep="")
row_grid <- self$rungrid[irow, ] #rungrid row for current run
if (!is.na(row_grid$seed)) {set.seed(row_grid$seed)}
#if (is.function(row_grid$func)) {}#funci <- self$func}
#else if (row_grid$func == "RFF") {row_grid$func <- RFF_get(D=self$D)}
#else {stop("No function given")}
# If parallel, need to source file
if (is_parallel) {
source("adaptconcept2_sFFLHD_R6.R")
# Save a start file
STARTED_filepath <- paste0(self$folder_path,"/STARTED_", irow, ".csv")
cat(timestamp(), "\n",
file=STARTED_filepath)
}
input_list <- c(lapply(self$rungridlist, function(x)x[[irow]]), self$pass_list)
u <- do.call(adapt.concept2.sFFLHD.R6$new, input_list)
# Run and time it
start_time <- Sys.time()
systime <- system.time(u$run(row_grid$batches,noplot=noplot))
end_time <- Sys.time()
newdf0 <- data.frame(batch=u$stats$iteration, mse=u$stats$mse,
pvar=u$stats$pvar, pamv=u$stats$pamv,
pred_intwerror=u$stats$intwerror,
actual_intwerror=u$stats$actual_intwerror,
actual_intwvar=u$stats$actual_intwvar,
do.call(rbind, lapply(u$stats$actual_intwquants, function(df) {data.frame(actual_intabserquants =t((df$abserrquant)))})),
do.call(rbind, lapply(u$stats$actual_intwquants, function(df) {data.frame(actual_intsqerrquants =t((df$sqerrquant)))})),
do.call(rbind, lapply(u$stats$actual_intwquants, function(df) {data.frame(actual_preddesabserrquants =t((df$preddesabserrquant)))})),
n=u$stats$n,
#obj=row_grid$obj,
num=paste0(row_grid$obj,row_grid$repl),
time = systime[3], #repl=row_grid$repl,
start_time=start_time, end_time=end_time,
run_number=irow,
#force_old=row_grid$force_old, force_pvar=row_grid$force_pvar,
force2=paste0(row_grid$force_old, '_', row_grid$force_pvar),
row.names=NULL,
stringsAsFactors = FALSE
)
newdf1 <- cbind(row_grid, newdf0, row.names=NULL)
u$delete()
if (is_parallel) {
# Delete STARTED file
if (file.exists(STARTED_filepath)) {
unlink(STARTED_filepath)
}
# Return result
return(list(irow=irow, newdf1=newdf1))
}
self$add_result_of_one(irow=irow, newdf1=newdf1)
invisible(self)
},
add_result_of_one = function(irow, newdf1, save_output=self$save_output) {
if (nrow(self$outrawdf) == 0) {
# If outrawdf not yet created, created blank df with
# correct names and size
self$outrawdf <- as.data.frame(
matrix(data=NA,
nrow=nrow(self$rungrid) * self$batches,
ncol=ncol(newdf1)
)
)
colnames(self$outrawdf) <- colnames(newdf1)
for (i in 1:ncol(self$outrawdf)) {class(self$outrawdf[,i]) <- class(newdf1[1,i])}
}
self$outrawdf[((irow-1)*self$batches+1):(irow*self$batches), ] <- newdf1
if (save_output) {
if (file.exists(paste0(self$folder_path,"/data_cat.csv"))) { # append new row
write.table(x=newdf1, file=paste0(self$folder_path,"/data_cat.csv"),
append=T, sep=",", col.names=F)
} else { #create file
self$create_output_folder()
write.table(x=newdf1, file=paste0(self$folder_path,"/data_cat.csv"),
append=F, sep=",", col.names=T)
}
}
self$completed_runs[irow] <- TRUE
},
postprocess_outdf = function(save_output=self$save_output) {
self$outdf <- self$outrawdf
self$outdf$rmse <- sqrt(ifelse(self$outdf$mse>=0, self$outdf$mse, 1e-16))
self$outdf$prmse <- sqrt(ifelse(self$outdf$pvar>=0, self$outdf$pvar, 1e-16))
self$enddf <- self$outdf[self$outdf$batch == self$batches,]
# Want to get mean of these columns across replicates
meanColNames <- c("mse","pvar","pamv","rmse","prmse","pred_intwerror",
"actual_intwerror", "actual_intwvar")
# Use these as ID, exclude repl, seed, and num and time
splitColNames <- c("func","func_string","func_num","D","L","b",
"reps","batches",
"force_old","force_pvar","force2",
"n0","obj", "batch", "n", "Group","package",
"selection_method", "design", "des_func",
"actual_des_func_num", "alpha_des", "weight_const",
"error_power")
self$meandf <- plyr::ddply(
self$outdf,
splitColNames,
function(tdf){
colMeans(tdf[,meanColNames])
}
)
# Get warning if any NA in self$outdf[,meanColNames]
# Give message so it's clear where it comes from
if (any(apply(self$outdf[,meanColNames], 2, is.nan))) {
message(paste0("Some values in $outdf are NaN,",
" warning comes from making meanlogdf #92538"))
}
self$meanlogdf <- plyr::ddply(
self$outdf,
splitColNames,
function(tdf){
exp(colMeans(log(tdf[,meanColNames])))
}
)
self$endmeandf <- plyr::ddply(
self$enddf,
splitColNames,
function(tdf){
c(
colMeans(tdf[,meanColNames])
, setNames(c(summary(tdf$actual_intwerror),
sd(tdf$actual_intwerror)),
paste("actual_intwerror",
c("Min", "Q1","Med","Mean","Q3","Max","sd"),
sep = '_'))
, setNames(c(summary(tdf$actual_intwvar),
sd(tdf$actual_intwvar)),
paste("actual_intwvar",
c("Min", "Q1","Med","Mean","Q3","Max","sd"),
sep = '_'))
)
}
)
if (self$save_output) {write.csv(self$outdf, paste0(self$folder_path,"/data.csv"))}
if (self$save_output) {self$save_self()}
invisible(self)
},
plot_MSE_over_batch = function(save_output = self$save_output, legend_labels=NULL) {
if (save_output) {
png(filename = paste0(self$folder_path,"/plotMSE.png"),
width = 480, height = 480)
}
p <- ggplot(data=self$outdf, aes(x=batch, y=mse, group = interaction(num,Group), colour = Group)) +
geom_line() +
geom_line(inherit.aes = F, data=self$meanlogdf,
aes(x=batch, y=mse, colour = Group, size=3, alpha=.5)) +
geom_point() +
scale_y_continuous(trans="log", breaks = base_breaks()) + #scale_y_log10() +
xlab("Batch") + ylab("MSE") + guides(size=FALSE, alpha=FALSE)
if (!is.null(legend_labels)) {
p <- p + scale_color_hue(labels=legend_labels)
}
print(p)
if (save_output) {dev.off()}
invisible(self)
},
plot_AWE_over_batch = function(save_output = self$save_output) {
if (save_output) {
png(filename = paste0(self$folder_path,"/plot_actual_intwerror.png"),
width = 480, height = 480)
}
print(
ggplot(data=self$outdf, aes(x=batch, y=actual_intwerror,
group = interaction(num,Group),
colour = Group)) +
geom_line() +
geom_line(inherit.aes = F,
data=self$meanlogdf, aes(x=batch, y=actual_intwerror,
colour = Group, size=3, alpha=.5)
) +
geom_point() +
# scale_y_log10(breaks = base_breaks()) + #pretty(self$outdf$actual_intwerror, n=5)) +
scale_y_continuous(trans="log", breaks = base_breaks()) +
#pretty(self$outdf$actual_intwerror, n=5)) +
xlab("Batch") + ylab("actual_intwerror") + guides(size=FALSE, alpha=FALSE)
)
if (save_output) {dev.off()}
invisible(self)
},
plot_AWE_over_group = function(save_output = self$save_output, boxpl=TRUE, logy=TRUE) {
if (save_output) {
png(filename = paste0(self$folder_path,"/plot_actual_intwerror_boxplot.png"),
width = 480, height = 480)
}
p1 <- ggplot(data=self$enddf,
aes(x=Group, y=actual_intwerror, colour = Group)
)# + geom_jitter(width=.1)
if (boxpl) {p1 <- p1 + geom_boxplot()}
p1 <- p1 + geom_jitter(width=.1)
if (logy) {
p1 <- p1 + #scale_y_log10() +
scale_y_continuous(trans="log", breaks = base_breaks())
}
print(p1)
if (save_output) {dev.off()}
invisible(self)
},
plot_MSE_PVar = function(save_output = self$save_output) {
if (save_output) {
png(filename = paste0(self$folder_path,"/plotMSEPVar.png"),
width = 480, height = 480)
}
print(
ggplot(data=self$outdf, aes(x=mse, y=pvar, group = interaction(num,Group), colour = Group)) +
geom_line() + # Line for each rep
geom_line(inherit.aes=F, data=self$meanlogdf, aes(x=mse, y=pvar, size=4, colour=Group), alpha=.5
) +# Line for mean
geom_point() + # Points for each rep
geom_point(inherit.aes=F, data=self$enddf,
aes(x=mse, y=pvar, size=4, colour=Group)
) + # Big points at end
geom_abline(intercept = 0, slope = 1) + # y=x line, expected for good model
xlab("MSE") + ylab("PVar") + guides(size=FALSE) +
scale_x_log10() + scale_y_log10()
)
if (save_output) {dev.off()}
invisible(self)
},
plot_RMSE_PRMSE = function(save_output = self$save_output) {
if (save_output) {
png(filename = paste0(self$folder_path,"/plotRMSEPRMSE.png"),
width = 480, height = 480)
}
print(
ggplot(data=self$outdf, aes(x=rmse, y=prmse, group = interaction(num,Group), colour = Group)) +
geom_line() + # Line for each rep
geom_line(inherit.aes=F, data=self$meanlogdf,
aes(x=rmse, y=prmse, size=4, colour = Group), alpha=.5
) +# Line for mean
geom_point() + # Points for each rep
geom_point(inherit.aes=F, data=self$enddf, aes(x=rmse, y=prmse, size=4, colour = Group)
) + # Big points at end
geom_abline(intercept = 0, slope = 1) + # y=x line, expected for good model
xlab("RMSE") + ylab("PRMSE") + guides(size=FALSE) +
scale_x_log10() + scale_y_log10()
)
if (save_output) {dev.off()}
invisible(self)
},
plot = function(save_output = self$save_output) {
self$plot_MSE_PVar(save_output=save_output)
self$plot_RMSE_PRMSE(save_output=save_output)
self$plot_MSE_over_batch(save_output=save_output)
self$plot_AWE_over_batch(save_output=save_output)
invisible(self)
},
plot_run_times = function() {
print(
ggplot2::ggplot(self$outrawdf) +
ggplot2::geom_segment(
ggplot2::aes(x=start_time, xend=end_time,
y=run_number, yend=run_number)) +
ggplot2::xlab("Start and end time") +
ggplot2::ylab("Run number")
)
invisible(self)
},
save_self = function(object_name="object") { # Save compare R6 object
file_path <- paste0(self$folder_path,"/",object_name,".rds")
cat("Saving to ", file_path, "\n")
# self$create_save_folder_if_nonexistent()
self$create_output_folder()
saveRDS(object = self, file = file_path)
invisible(self)
},
# create_save_folder_if_nonexistent = function() {
# if (!dir.exists(self$folder_path)) {
# dir.create(self$folder_path)
# }
# },
delete_save_folder_if_empty = function() {
if (length(list.files(path=self$folder_path, all.files = TRUE, no.. = TRUE)) == 0) {
unlink(self$folder_path, recursive = TRUE)
} else {
# stop("Folder is not empty")
}
invisible(self)
},
recover_parallel_temp_save = function(save_if_any_recovered=TRUE) {
# Read in and save
any_recovered <- FALSE
for (ii in 1:nrow(self$rungrid)) {
# Check for file
file_ii <- paste0(self$folder_path,"/parallel_temp_output_",ii,".rds")
if (file.exists(file_ii)) {
# Read in
oneout <- readRDS(file=file_ii)
do.call(self$add_result_of_one, oneout)
# Delete it
unlink(file_ii)
any_recovered <- TRUE
}
}
if (any_recovered && save_if_any_recovered) {
self$save_self()
}
self$delete_save_folder_if_empty()
invisible(self)
},
parallel_efficiency = function() {
sum(self$enddf$time) /
as.numeric(max(self$enddf$end_time) - min(self$enddf$start_time),
unit='secs')
}
# load = function() {
# self$outdf = read.csv()
# self$postprocess_outdf()
# invisible(self)
# }
)
)
if (F) {
ca1 <- compare.adaptR6$new(func=gaussian1, D=2, L=3, n0=6)$run_all()$plot()
ca1$run()
ca1 <- compare.adaptR6$new(func=add_null_dims(banana,2), D=4, L=4,
obj=c("nonadapt", "grad","gradpvaralpha"),
batches=10, reps=5, n0=10)$run_all()$plot()
ca1 <- compare.adaptR6$new(func=banana, D=2, L=4,
obj=c("nonadapt", "grad","gradpvaralpha"),
batches=20, reps=3, n0=10, package=c("laGP")
)$run_all()$plot()
# For desirability
ca1 <- compare.adaptR6$new(func=gaussian1, D=2, L=3, n0=6, obj="desirability",
selection_method=c('max_des', 'SMED'),
des_func=c('des_func_relmax', NA))$run_all()$plot()
ca1 <- compare.adaptR6$new(func=banana, D=2, L=4, n0=20,
obj=c("func","desirability"),
selection_method=c('SMED', 'max_des_red'),
des_func=c('NA', 'des_func_relmax'), alpha_des=1e3,
actual_des_func=c('NA',
'get_actual_des_func_relmax(f=banana, fmin=0, fmax=1)'),
package="laGP")$run_all()$plot()
ca1 <- compare.adaptR6$new(func=banana, reps=3, batches=3, D=2, L=4, n0=20,
obj=c("func","desirability"),
selection_method=c('SMED', 'max_des_red'),
des_func=c('NA', 'des_func_relmax'), alpha_des=1e3,
actual_des_func=c(get_actual_des_func_relmax(f=banana, fmin=0, fmax=1)),
package="laGP")$run_all()$plot()
ca1 <- compare.adaptR6$new(func=banana, reps=10, batches=10, D=2, L=4, n0=20,
obj=c("func","desirability"),
selection_method=c('SMED', 'max_des_red'),
des_func=c('NA', 'des_func_relmax'), alpha_des=1e3,
actual_des_func=c(get_actual_des_func_relmax(f=banana, fmin=0, fmax=1)),
package="laGP")$run_all()$plot()
ca1 <- compare.adaptR6$new(func=banana, reps=2, batches=5, D=2, L=4, n0=20,
obj=c("func","desirability"), selection_method=c('SMED', 'max_des_red'),
des_func=c('NA', 'des_func_relmax'), alpha_des=1e3,
actual_des_func=c(get_actual_des_func_relmax(f=banana, fmin=0, fmax=1)),
package="laGP_GauPro")$run_all()$plot()
ca1 <- compare.adaptR6$new(func=borehole, reps=2, batches=5, D=8, b=4, L=8,
n0=20, obj=c("func","desirability"),
selection_method=c('SMED', 'max_des_red'),
des_func=c('NA', 'des_func_relmax'), alpha_des=1e2,
actual_des_func=c(actual_des_func_relmax_borehole),
package="laGP_GauPro")$run_all()$plot()
ca1 <- compare.adaptR6$new(func_string='otl',func=OTL_Circuit, reps=2,
batches=5, D=6, b=4, L=8, n0=20,
obj=c("func","desirability"),
selection_method=c('SMED', 'max_des_red'),
des_func=c('NA', 'des_func_relmax'), alpha_des=1e3,
actual_des_func=NULL, package="laGP_GauPro"
)$run_all()$plot()
ca1 <- compare.adaptR6$new(func=banana, reps=2, batches=2, D=2, L=2, n0=15,
obj=c("nonadapt","func","desirability"),
selection_method=c("nonadapt",'SMED', 'max_des_red'),
des_func=c('NA','NA', 'des_func_relmax'), alpha_des=1e3,
actual_des_func='get_actual_des_func_relmax(f=banana, fmin=0, fmax=1)',
package="laGP_GauPro", seed=33123)$run_all()$plot()
ca1$plot_AWE_over_batch()
# Show summary of actual_intwerror
plyr::ddply(ca1$enddf, .(Group), function(grp) {summary(grp$actual_intwerror)})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.