From 5a56bff2d5b0fcff7a5e21c65e98ff865c1dd54e Mon Sep 17 00:00:00 2001 From: Jouni Helske Date: Fri, 8 Nov 2024 08:58:22 +0200 Subject: [PATCH] boostrap method to type --- R/bootstrap.R | 28 +++++++++++++++++----------- R/fit_mnhmm.R | 2 ++ R/fit_nhmm.R | 2 +- man/bootstrap.Rd | 6 +++--- 4 files changed, 23 insertions(+), 15 deletions(-) diff --git a/R/bootstrap.R b/R/bootstrap.R index 4f402ca..4f45055 100644 --- a/R/bootstrap.R +++ b/R/bootstrap.R @@ -67,7 +67,7 @@ permute_clusters <- function(model, pcp_mle) { #' #' @param model An `nhmm` or `mnhmm` object. #' @param B number of bootstrap samples. -#' @param method Either `"nonparametric"` or `"parametric"`, to define whether +#' @param type Either `"nonparametric"` or `"parametric"`, to define whether #' nonparametric or parametric bootstrap should be used. The former samples #' sequences with replacement, whereas the latter simulates new datasets based #' on the model. @@ -84,9 +84,9 @@ bootstrap_coefs <- function(model, ...) { #' @rdname bootstrap #' @export bootstrap_coefs.nhmm <- function(model, B = 1000, - method = c("nonparametric", "parametric"), + type = c("nonparametric", "parametric"), verbose = FALSE, ...) { - method <- match.arg(method) + type <- match.arg(type) stopifnot_( checkmate::test_int(x = B, lower = 0L), "Argument {.arg B} must be a single positive integer." @@ -96,13 +96,15 @@ bootstrap_coefs.nhmm <- function(model, B = 1000, gamma_pi <- replicate(B, gammas_mle$pi, simplify = FALSE) gamma_A <- replicate(B, gammas_mle$A, simplify = FALSE) gamma_B <- replicate(B, gammas_mle$B, simplify = FALSE) + lambda <- model$estimation_results$lambda if (verbose) pb <- utils::txtProgressBar(min = 0, max = B, style = 3) - if (method == "nonparametric") { + if (type == "nonparametric") { out <- future.apply::future_lapply( seq_len(B), function(i) { mod <- bootstrap_model(model) - fit <- fit_nhmm(mod, init, init_sd = 0, restarts = 0, ...) + fit <- fit_nhmm(mod, init, init_sd = 0, restarts = 0, lambda = lambda, + ...) if (verbose) utils::setTxtProgressBar(pb, i) permute_states(fit$gammas, gammas_mle) } @@ -123,7 +125,8 @@ bootstrap_coefs.nhmm <- function(model, B = 1000, mod <- simulate_nhmm( N, T_, M, S, formula_pi, formula_A, formula_B, data = d, time, id, init)$model - fit <- fit_nhmm(mod, init, init_sd = 0, restarts = 0, ...) + fit <- fit_nhmm(mod, init, init_sd = 0, restarts = 0, lambda = lambda, + ...) if (verbose) utils::setTxtProgressBar(pb, i) fit$gammas <- permute_states(fit$gammas, gammas_mle) } @@ -137,9 +140,9 @@ bootstrap_coefs.nhmm <- function(model, B = 1000, #' @rdname bootstrap #' @export bootstrap_coefs.mnhmm <- function(model, B = 1000, - method = c("nonparametric", "parametric"), + type = c("nonparametric", "parametric"), verbose = FALSE, ...) { - method <- match.arg(method) + type <- match.arg(type) stopifnot_( checkmate::test_int(x = B, lower = 0L), "Argument {.arg B} must be a single positive integer." @@ -151,12 +154,14 @@ bootstrap_coefs.mnhmm <- function(model, B = 1000, gamma_A <- replicate(B, gammas_mle$A, simplify = FALSE) gamma_B <- replicate(B, gammas_mle$B, simplify = FALSE) gamma_omega <- replicate(B, gammas_mle$omega, simplify = FALSE) + lambda <- model$estimation_results$lambda D <- model$n_clusters if (verbose) pb <- utils::txtProgressBar(min = 0, max = B, style = 3) - if (method == "nonparametric") { + if (type == "nonparametric") { for (i in seq_len(B)) { mod <- bootstrap_model(model) - fit <- fit_mnhmm(mod, init, init_sd = 0, restarts = 0, ...) + fit <- fit_mnhmm(mod, init, init_sd = 0, restarts = 0, lambda = lambda, + ...) fit <- permute_clusters(fit, pcp_mle) for (j in seq_len(D)) { out <- permute_states( @@ -189,7 +194,8 @@ bootstrap_coefs.mnhmm <- function(model, B = 1000, mod <- simulate_mnhmm( N, T_, M, S, D, formula_pi, formula_A, formula_B, formula_omega, data = d, time, id, init)$model - fit <- fit_mnhmm(mod, init, init_sd = 0, restarts = 0, ...) + fit <- fit_mnhmm(mod, init, init_sd = 0, restarts = 0, lambda = lambda, + ...) fit <- permute_clusters(fit, pcp_mle) for (j in seq_len(D)) { out <- permute_states( diff --git a/R/fit_mnhmm.R b/R/fit_mnhmm.R index c34dc1f..6ce6a81 100644 --- a/R/fit_mnhmm.R +++ b/R/fit_mnhmm.R @@ -274,5 +274,7 @@ fit_mnhmm <- function(model, inits, init_sd, restarts, lambda, method, all_solutions = all_solutions, time = end_time - start_time ) + + model$estimation_results$lambda <- lambda model } diff --git a/R/fit_nhmm.R b/R/fit_nhmm.R index 3c78411..bb892c2 100644 --- a/R/fit_nhmm.R +++ b/R/fit_nhmm.R @@ -306,6 +306,6 @@ fit_nhmm <- function(model, inits, init_sd, restarts, lambda, method, x_abs_change = out$absolute_x_change ) } - + model$estimation_results$lambda <- lambda model } diff --git a/man/bootstrap.Rd b/man/bootstrap.Rd index 23d3867..8bba5d9 100644 --- a/man/bootstrap.Rd +++ b/man/bootstrap.Rd @@ -11,7 +11,7 @@ bootstrap_coefs(model, ...) \method{bootstrap_coefs}{nhmm}( model, B = 1000, - method = c("nonparametric", "parametric"), + type = c("nonparametric", "parametric"), verbose = FALSE, ... ) @@ -19,7 +19,7 @@ bootstrap_coefs(model, ...) \method{bootstrap_coefs}{mnhmm}( model, B = 1000, - method = c("nonparametric", "parametric"), + type = c("nonparametric", "parametric"), verbose = FALSE, ... ) @@ -31,7 +31,7 @@ bootstrap_coefs(model, ...) \item{B}{number of bootstrap samples.} -\item{method}{Either \code{"nonparametric"} or \code{"parametric"}, to define whether +\item{type}{Either \code{"nonparametric"} or \code{"parametric"}, to define whether nonparametric or parametric bootstrap should be used. The former samples sequences with replacement, whereas the latter simulates new datasets based on the model.}