fix docs and imports etc

NAMESPACE

@@ -103,6 +103,8 @@ importFrom(TraMineR,seqlegend)
 importFrom(TraMineR,seqlength)
 importFrom(TraMineR,seqplot)
 importFrom(TraMineR,seqstatf)
+importFrom(dplyr,across)
+importFrom(dplyr,all_of)
 importFrom(future,multisession)
 importFrom(future,plan)
 importFrom(future,sequential)
@@ -124,15 +126,19 @@ importFrom(graphics,strwidth)
 importFrom(graphics,text)
 importFrom(methods,hasArg)
 importFrom(numDeriv,jacobian)
+importFrom(rlang,":=")
 importFrom(rstan,optimizing)
 importFrom(rstantools,rstan_config)
 importFrom(stats,BIC)
 importFrom(stats,cmdscale)
+importFrom(stats,coef)
 importFrom(stats,complete.cases)
 importFrom(stats,logLik)
 importFrom(stats,model.matrix)
+importFrom(stats,predict)
 importFrom(stats,rnorm)
 importFrom(stats,runif)
+importFrom(stats,update)
 importFrom(stats,vcov)
 importFrom(utils,menu)
 useDynLib(seqHMM, .registration = TRUE)

R/average_marginal_prediction.R

@@ -16,6 +16,9 @@
 average_marginal_prediction <- function(
     model, variable, values, marginalize_B_over = "sequences", newdata = NULL, 
     nsim = 0, probs = c(0.025, 0.5, 0.975)) {
+  # avoid warnings of NSEs
+  cluster <- state <- estimate <- state_from <- state_to <- time_var <- 
+    channel <- observation <- NULL
   stopifnot_(
     inherits(model, "nhmm") || inherits(model, "mnhmm"),
     "Argument {.arg model} must be a {.cls nhmm} or {.cls mnhmm} object."
@@ -106,7 +109,7 @@ average_marginal_prediction <- function(
     estimate = unlist(pred$pi)
   ) |> 
     dplyr::group_by(cluster, state) |>
-    summarise(estimate = mean(estimate))
+    dplyr::summarise(estimate = mean(estimate))
 
   A <- data.frame(
     cluster = rep(model$cluster_names, each = S^2 * T * N),

R/estimate_nhmm.R

@@ -9,6 +9,7 @@
 #' an `stslist` object (see [TraMineR::seqdef()]) containing the 
 #' sequences. In case of multichannel data, `observations` should be a vector 
 #' of response variable names in `data`, or a list of `stslist` objects.
+#' @param n_states A positive integer defining the number of hidden states.
 #' @param initial_formula of class [formula()] for the
 #' initial state probabilities.
 #' @param transition_formula of class [formula()] for the

R/forwardBackward.R

@@ -16,6 +16,7 @@
 #' @param as_data_frame If `TRUE` (default), the output is returned as a 
 #' data.frame. Otherwise, a list of array(s) is returned. Ignored if 
 #' `log_space` is `FALSE`, in which case list of arrays is always returned.
+#' @param ... Ignored.
 #' @return If `as_data_frame` is `TRUE` a `data.frame` with 
 #' log-values of forward and backward probabilities. If `FALSE` or 
 #' `log_space = FALSE`, a list with components

R/get_coefs.R

@@ -8,6 +8,7 @@
 #' estimates are returned.
 #' @param probs Vector defining the quantiles of interest. Default is 
 #' `c(0.025, 0.5, 0.975)`.
+#' @param ... Ignored.
 #' @rdname coef
 #' @export
 coef.nhmm <- function(object, nsim = 0, probs = c(0.025, 0.5, 0.975), ...) {

R/get_probs.R

@@ -2,12 +2,15 @@
 #' or MNHMM
 #' 
 #' @param model An object of class `nhmm` or `mnhmm`.
+#' @param newdata An optional data frame containing the new data to be used in 
+#' computing the probabilities.
 #' @param nsim Non-negative integer defining the number of samples from the 
 #' normal approximation of the model parameters used in 
 #' computing the approximate quantiles of the estimates. If `0`, only point 
 #' estimates are returned.
 #' @param probs Vector defining the quantiles of interest. Default is 
 #' `c(0.025, 0.5, 0.975)`.
+#' @param ... Ignored.
 #' @rdname get_probs
 #' @export
 get_probs <- function(model, ...) {

R/hidden_paths.R

@@ -7,7 +7,8 @@
 #' @param model A hidden Markov model.
 #' @param respect_void If `TRUE` (default), states at the time points
 #' corresponding to `TraMineR`'s void in the observed sequences are set to void
-#' in the hidden state sequences as well.#'
+#' in the hidden state sequences as well.
+#' @param ... Ignored.
 #' @return The most probable paths of hidden states as an `stslist` object
 #' (see [seqdef()]). The log-probability is included as an attribute 
 #' `log_prop`.

R/most_probable_cluster.R

@@ -22,11 +22,14 @@ most_probable_cluster <- function(x, type = "viterbi", hp) {
 posterior_cluster_probabilities <- function(x) {
   pp <- posterior_probs(x, as_data_frame = FALSE)
   posterior_cluster_probabilities <- matrix(0, x$n_sequences, x$n_clusters)
-  n_states <- rep(x$n_states, length.out = x$n_channels)
+  n_states <- rep(x$n_states, length.out = x$n_clusters)
   p <- 0
   for (i in seq_len(x$n_clusters)) {
     posterior_cluster_probabilities[, i] <- 
-      colSums(pp[(p + 1):(p + n_states[i]), 1, ])
+      colSums(array(
+        pp[(p + 1):(p + n_states[i]), 1, ], 
+        dim = c(n_states[i], x$n_sequences)
+      ))
     p <- p + n_states[i]
   }
   dimnames(posterior_cluster_probabilities) <- list(

R/plot.amp.R

@@ -1,12 +1,14 @@
 #' Visualize Average Marginal Effects
 #' 
-#' @importFrom ggplot2 ggplot aes geom_pointrange geom_ribbon geom_line facet_wrap
-#' @param x Output from [amp()].
+#' @param x Output from [average_marginal_prediction()].
+#' @param type Type of plot to create. One of `"initial"`, `"transition"`,
+#'  `"emission"`, or `"cluster"`.
 #' @param alpha Transparency level for [ggplot2::geom_ribbon()].
 plot.amp <- function(x, type, probs = c(0.025, 0.975), alpha = 0.25) {
   type <- match.arg(type, c("initial", "transition", "emission", "cluster"))
 
-  cluster <- time <- state <- state_from <- state_to <- observation <- NULL
+  cluster <- time <- state <- state_from <- state_to <- observation <- 
+    estimate <- NULL
   stopifnot_(
     checkmate::test_numeric(
       x = probs, lower = 0, upper = 1, any.missing = FALSE, min.len = 2L, 
@@ -17,6 +19,10 @@ plot.amp <- function(x, type, probs = c(0.025, 0.975), alpha = 0.25) {
   )
   lwr <- paste0("q", 100 * probs[1])
   upr <- paste0("q", 100 * probs[2])
+  stopifnot_(
+    all(c(lwr, upr) %in% names(x$initial)),
+    "The probabilities in {.arg probs} are not available in the {.arg x}."
+  )
   if (type == "initial") {
     p <- ggplot(x$initial, aes(estimate, state)) + 
       geom_pointrange(aes(ymin = .data[[lwr]], ymax = .data[[upr]]))

R/posterior_probs.R

@@ -10,6 +10,7 @@
 #' non-homogenous models.
 #' @param as_data_frame If `TRUE` (default), the output is returned as a 
 #' data.frame. Otherwise, a 3d array is returned.
+#' @param ... Ignored.
 #' @return Posterior probabilities. In case of multiple observations,
 #' these are computed independently for each sequence.
 #' @examples

R/print.R

@@ -77,7 +77,7 @@ print.mhmm <- function(x, digits = 3, ...) {
       cat("\nNumber of clusters:", x$n_clusters)
     }
   }
-  cat("Coefficients :\n")
+  cat("\nCoefficients :\n")
   print(x$coefficients, digits = digits, ...)
 
   if (attr(x, "type") != "lcm") {

R/seqHMM-deprecated.R

@@ -8,28 +8,3 @@
 #' 
 #' @name seqHMM-deprecated
 NULL
-
-#' Defunct function(s) in the seqHMM package
-#'
-#' These functions are no longer available in the seqHMM package.
-#' 
-#' @name seqHMM-defunct
-fit_hmm <- function(
-    model, em_step = TRUE, global_step = FALSE, local_step = FALSE,
-    control_em = list(), control_global = list(), control_local = list(), 
-    lb, ub, threads = 1, log_space = FALSE, ...) {
-  .Defunct("fit_model", package = "seqHMM")
-}
-#' @name seqHMM-defunct
-fit_mhmm <- function(
-    model, em_step = TRUE, global_step = FALSE, local_step = FALSE,
-    control_em = list(), control_global = list(), control_local = list(), 
-    lb, ub, threads = 1, log_space = FALSE, ...) {
-  .Defunct("fit_model", package = "seqHMM")
-}
-#' @name seqHMM-defunct
-trim_hmm <- function(
-    model, maxit = 0, return_loglik = FALSE, zerotol = 1e-8, 
-    verbose = TRUE, ...) {
-  .Defunct("trim_model", package = "seqHMM")
-}

R/seqHMM-package.R

@@ -30,12 +30,15 @@
 #' @importFrom RcppParallel RcppParallelLibs CxxFlags
 #' @importFrom Rcpp loadModule evalCpp
 #' @importFrom Matrix .bdiag
-#' @importFrom stats logLik cmdscale complete.cases model.matrix BIC rnorm runif vcov
+#' @importFrom stats logLik cmdscale complete.cases model.matrix BIC rnorm runif vcov predict update coef
 #' @importFrom TraMineR alphabet seqstatf seqdef seqlegend seqdist seqdistmc seqplot seqlength is.stslist
 #' @importFrom grDevices col2rgb rainbow
 #' @importFrom graphics barplot par plot plot.new polygon strwidth text
 #' @importFrom methods hasArg
 #' @importFrom utils menu
+#' @importFrom ggplot2 ggplot aes geom_pointrange geom_ribbon geom_line facet_wrap
+#' @importFrom rlang :=
+#' @importFrom dplyr across all_of
 #' @references Helske S. and Helske J. (2019). Mixture Hidden Markov Models for Sequence Data: The seqHMM Package in R,
 #' Journal of Statistical Software, 88(3), 1-32. doi:10.18637/jss.v088.i03
 "_PACKAGE"

R/utilities.R

@@ -185,7 +185,7 @@ stop_ <- function(message, ..., call = rlang::caller_env()) {
 #' @param f A formula object.
 #' @noRd
 intercept_only <- function(f) {
-  identical(deparse(stats::update(f, 0 ~ .)), "0 ~ 1")
+  identical(deparse(update(f, 0 ~ .)), "0 ~ 1")
 }
 #' Create obsArray for Various C++ functions
 #'