--- title: "EFMBC Exmaple" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{example} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) knitr::opts_chunk$set(fig.width = 6, fig.height = 6) ``` ```{r setup} library(impala) library(BASS) library(mvBayes) library(fdasrvf) library(bayesplot) ``` Generate Example Data ```{r data} f <- function(x) { dnorm(seq(0, 1, length.out = 99), sin(2 * pi * x[1] ^ 2) / 4 - x[1] / 10 + 0.5, 0.05) * x[2] } n = 100 nt = 99 p = 3 x_train = matrix(runif(n * p), n) x_test = matrix(runif(1000 * p), 1000) e = rnorm(n * 99) y_train = matrix(0, n, nt) for (i in 1:n) { y_train[i, ] = f(x_train[i, ]) } y_test = matrix(0, 1000, nt) for (i in 1:1000) { y_test[i, ] = f(x_test[i, ]) } ``` Generate observation and align using EFDA framework ```{r efda} x_true = c(0.1028, 0.5930) ftilde_obs = f(x_true) gam_obs = seq(0, 1, length.out = nt) vv_obs = gam_to_v(gam_obs) tt = seq(0, 1, length.out = nt) out = multiple_align_functions(t(y_train), tt, ftilde_obs, 0.01) gam_train = out$warping_functions vv_train = gam_to_v(gam_train) ftilde_train = out$fn qtilde_train = out$qn matplot(tt, t(y_train), type = "l", col = "gray") lines(tt, ftilde_obs, col = "black") legend( x = 0, y = 8, legend = c("simulation", "experiment"), col = c("gray", "black"), lty = 1 ) matplot(tt, ftilde_train, type = "l", col = "gray") lines(tt, ftilde_obs, col = "black") legend( x = 0, y = 8, legend = c("simulation", "experiment"), col = c("gray", "black"), lty = 1 ) matplot(tt, gam_train, type = "l", col = "gray") lines(tt, gam_obs, col = "black") legend( x = 0, y = 8, legend = c("simulation", "experiment"), col = c("gray", "black"), lty = 1 ) matplot(tt, vv_train, type = "l", col = "gray") lines(tt, vv_obs, col = "black") legend( x = 0, y = 8, legend = c("simulation", "experiment"), col = c("gray", "black"), lty = 1 ) ``` Train Emulators ```{r emulators} emu_ftilde = mvBayes(bass, x_train, t(ftilde_train), nBasis=2) plot(emu_ftilde) emu_vv = mvBayes(bass, x_train, t(vv_train), nBasis=2) plot(emu_vv) ``` Run Calibration using Impala ```{r calibration} input_names = c("theta0", "theta1", "theta2") bounds = list() bounds[['theta0']] = c(0, 1) bounds[['theta1']] = c(0, 1) bounds[['theta2']] = c(0, 1) setup = CalibSetup(bounds, cf_bounds) model_ftilde = ModelmvBayes(emu_ftilde, input_names) model_vv = ModelmvBayes(emu_vv, input_names) setup = addVecExperiments(setup, t(ftilde_obs), model_ftilde, 0.01, 20, rep(1, nt)) setup = addVecExperiments(setup, t(vv_obs), model_vv, 0.01, 20, rep(1, nt)) setup = setTemperatureLadder(setup, 1.05 ^ (0:3)) setup = setMCMC(setup, 4000, 2000, 1, 10) out_cal = calibPool(setup) ``` Look at posteriors and chain diagnostics ```{r plots} uu = seq(2500, 4000, 2) theta = tran_unif(out_cal$theta[uu, 1, ], setup$bounds_mat, names(setup$bounds)) expnums = 1 cnt = 1 ftilde_pred_obs = vector(mode = "list", length = setup$nexp) gam_pred_obs = vector(mode = "list", length = setup$nexp) for (idx in expnums) { time_new = seq(0, 1, length.out = nt) fn = setup$models[[1]]$input_names parmat_array = matrix(0, length(theta[[fn[1]]]), length(fn)) for (i in 1:length(fn)) { parmat_array[, i] = theta[[fn[i]]] } ftilde_pred_obs[[idx]] = evalm(setup$models[[cnt]], theta) vv_pred_obs = evalm(setup$models[[cnt + 1]], theta) cnt = cnt + 2 gam_pred_obs[[idx]] = v_to_gam(t(vv_pred_obs)) matplot( time_new, ftilde_train, type = "l", col = "gray", lty = 1 ) matplot( time_new, t(ftilde_pred_obs[[idx]]), type = "l", col = "lightblue", lty = 1, add = TRUE ) lines(time_new, ftilde_obs, col = "black") legend( x = 0, y = 8, legend = c("simulation", "prediction", "experiment"), col = c("gray", "lightblue", "black"), lty = 1 ) matplot( time_new, vv_train, type = "l", col = "gray", lty = 1 ) matplot( time_new, t(vv_pred_obs), type = "l", col = "lightblue", lty = 1, add = TRUE ) lines(time_new, vv_obs, col = "black") legend( x = 0, y = 8, legend = c("simulation", "prediction", "experiment"), col = c("gray", "lightblue", "black"), lty = 1 ) matplot( time_new, gam_train, type = "l", col = "gray", lty = 1 ) matplot( time_new, gam_pred_obs[[idx]], type = "l", col = "lightblue", lty = 1, add = TRUE ) lines(time_new, gam_obs, col = "black") legend( x = 0, y = 8, legend = c("simulation", "prediction", "experiment"), col = c("gray", "lightblue", "black"), lty = 1 ) } samps = data.frame(theta) mcmc_pairs(samps, off_diag_fun="hex", diag_fun = "dens") mcmc_hist(samps) mcmc_trace(samps) plot(out_cal$llik, type="l", main="Log-Likelihood") # misaligned prediction for (idx in expnums){ obspred = matrix(0, nt, length(uu)) for (j in 1:length(uu)){ obspred[,j] = warp_f_gamma(ftilde_pred_obs[[idx]][j,], time_new, invertGamma(gam_pred_obs[[idx]][,j])) } matplot( time_new, t(y_train), type = "l", col = "gray", lty = 1 ) matplot( time_new, obspred, type = "l", col = "lightblue", lty = 1, add = TRUE ) lines(time_new, ftilde_obs, col = "black") legend( x = 0, y = 8, legend = c("simulation", "prediction", "experiment"), col = c("gray", "lightblue", "black"), lty = 1 ) } ```