Commit 91aae74c authored by Johannes Boog's avatar Johannes Boog
Browse files

[bugfix] add residuals to bo-object

parent 688ec59d
......@@ -207,6 +207,7 @@ cal_bayesOpt <- function(par_init,
par_init <- BO_init$min
X <- BO_init$values
errs <- BO_init$objective_values
residuals_df <- BO_init$objective_residuals
pred_mu <- BO_init$pred_mu
pred_mse <- BO_init$pred_mse
n0 <- length(errs)
......@@ -216,7 +217,6 @@ cal_bayesOpt <- function(par_init,
ogs6_out_ref = attributes(BO_init)$sim_data$ogs6_out_ref
objective_function = attributes(BO_init)$sim_data$objective_function
} else {
# check if par_df is already in the unit intervall
if (all(to01(par_init,
......@@ -234,6 +234,7 @@ cal_bayesOpt <- function(par_init,
kp <- NULL
errs <- NULL
n0 <- ncol(par_init[, -c(1:3)])
residuals_df <- NULL
}
# sanity checks on user functions
if (!all(c("ogs6_obj", "exp_data") %in% methods::formalArgs(objective_function))) {
......@@ -389,10 +390,22 @@ cal_bayesOpt <- function(par_init,
residuals_l <- c(residuals_l, res_l)
# residua list to df
residuals_df <- tibble::tibble(iteration = seq(1:length(residuals_l)),
data = residuals_l) %>%
iter_old <- ifelse(is.null(residuals_df), 0,
residuals_df$iteration %>% unique() %>% length())
residuals_new_df <- tibble::tibble(
iteration = seq((iter_old+1),
(iter_old+length(residuals_l))),
data = residuals_l) %>%
tidyr::unnest(cols = data)
# attach to existing residuals
if(is.null(residuals_df)){
residuals_df <- residuals_new_df
}else{
residuals_df <- residuals_df %>%
dplyr::bind_rows(residuals_new_df)
}
X <- rbind(X, x_star)
# get parameter sample that yields min error
......
......@@ -305,16 +305,19 @@ cal_sample_parameters <- function(calibration_set,
#' @export
#'
#' @examples \dontrun{plot(bo)}
plot.BO <- function(bo) {
#TODO method dispatch does not work´
plot.BO <- function(bo, show_init_sample=F) {
# get length of initial sample
n_init <- length(bo$objective_values) - length(bo$pred_mu)
# define data for plotting
df <- dplyr::tibble(
iteration = 1:length(bo$pred_mu),
errs = bo$objective_values[(n_init + 1):length(bo$objective_values)],
pred = bo$pred_mu,
pred_s = bo$pred_mse,
kappa = bo$kappa
iteration = 1:length(bo$objective_values),
errs = bo$objective_values,
pred = c(rep(NA, n_init), bo$pred_mu),
pred_s = c(rep(NA, n_init),bo$pred_mse),
kappa = c(rep(NA, n_init), bo$kappa)
)
if(show_init_sample==F) df<-df[(n_init+1):nrow(df),]
df$reg <- df$pred - df$errs
df$norm_reg <- df$reg / df$pred_s
df$curMin <- 0
......@@ -356,6 +359,6 @@ plot.BO <- function(bo) {
ggplot2::labs(y = expression((hat(y) - y) / MSE),
title = "Normalized prediction error")
gridExtra::grid.arrange(ncol = 2, g1, g2, g3, g4)
gridExtra::grid.arrange(ncol = 2, g1, g2, g3, g4)
}
}
\ No newline at end of file
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment