## ----cdk-knit-opts, include = FALSE------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 6, fig.height = 4, fig.align = "center" ) ## ----setup-------------------------------------------------------------------- library(MetaHunt) set.seed(1) ## ----cdk-simulate------------------------------------------------------------- m <- 30; G <- 20; K_true <- 3 x <- seq(0, 1, length.out = G) basis <- rbind(sin(pi * x), cos(pi * x), x) W <- data.frame(w1 = rnorm(m), w2 = rnorm(m)) beta <- cbind(c(1, -0.8), c(-0.5, 1.2), c(0, 0)) pi_true <- exp(as.matrix(W) %*% beta); pi_true <- pi_true / rowSums(pi_true) F_hat <- pi_true %*% basis + matrix(rnorm(m * G, sd = 0.05), m, G) ## ----cdk-elbow---------------------------------------------------------------- elbow <- reconstruction_error_curve(F_hat, K_range = 2:6, dfspa_args = list(denoise = FALSE)) plot(elbow$K, elbow$error, type = "b", xlab = "K", ylab = "reconstruction error", main = "Reconstruction error vs K", ylim = c(0, max(elbow$error, na.rm = TRUE) * 1.05)) ## ----cdk-cv------------------------------------------------------------------- cv <- cv_error_curve(F_hat, W, K_range = 2:6, n_folds = 4, dfspa_args = list(denoise = FALSE), seed = 1) plot(cv$K, cv$cv_error, type = "b", xlab = "K", ylab = "CV prediction error", main = "CV prediction error vs K", ylim = c(0, max(cv$cv_error, na.rm = TRUE) * 1.05)) ## ----cdk-bypass--------------------------------------------------------------- fit_no <- metahunt(F_hat, W, K = K_true, dfspa_args = list(denoise = FALSE)) fit_no ## ----cdk-dfspa-knobs---------------------------------------------------------- fit_no <- metahunt(F_hat, W, K = K_true, dfspa_args = list(denoise = FALSE)) fit_manual <- metahunt(F_hat, W, K = K_true, dfspa_args = list(N = 0.5 * log(nrow(F_hat)), Delta = 0.4)) ## ----cdk-select-denoising, warning = FALSE------------------------------------ tune <- select_denoising_params(F_hat, W, K = K_true, n_folds = 4, seed = 1) tune$best