Add a new counting mode for contexts.*

In (co)vlmc models, a content may be valid and still have "descendants" in the context tree. The default reporting mode in contexts.* for those contexts is to count all occurences in the time series, even if some of them are matched by longer contexts. With counts="local", this default behaviour is replaced yb one in which only proper matches are attached to a given context.

R/covlmc_contexts.R

@@ -95,6 +95,11 @@ covlmc_context_extractor <- function(path, ct, vals, control, is_leaf, p_summary
 #' @param hsize if TRUE, adds a `hsize` column to the result data frame that
 #'   gives for each context the size of the history of covariates used by the model.
 #' @param ct a fitted covlmc model.
+#' @param counts specifies how the counts reported by `frequency` are computed.
+#'   The default value `"desc"` includes both counts that are specific to the
+#'   context (if any) and counts from the descendants of the context in the
+#'   tree. When `counts = "local"` the counts include only the number of times
+#'   the context appears without being the last part of a longer context.
 #' @details The default result for `type="auto"` (or `type="list"`),
 #'   `frequency=NULL` and `model=NULL` is the list of all contexts.
 #'
@@ -112,9 +117,11 @@ covlmc_context_extractor <- function(path, ct, vals, control, is_leaf, p_summary
 #' contexts(m_cov, model = "coef")
 #' contexts(m_cov, model = "full")
 #' @export
-contexts.covlmc <- function(ct, type = c("auto", "list", "data.frame"), reverse = TRUE, frequency = NULL, model = NULL, hsize = FALSE, ...) {
+contexts.covlmc <- function(ct, type = c("auto", "list", "data.frame"), reverse = TRUE, frequency = NULL,
+                            counts = c("desc", "local"), model = NULL, hsize = FALSE, ...) {
   type <- match.arg(type)
-  if (is.null(model) && !hsize) {
+  counts <- match.arg(counts)
+  if (is.null(model) && !hsize && counts == "desc") {
     NextMethod()
   } else {
     assertthat::assert_that(type %in% c("auto", "data.frame"))
@@ -124,7 +131,7 @@ contexts.covlmc <- function(ct, type = c("auto", "list", "data.frame"), reverse
     if (!is.null(model)) {
       assertthat::assert_that(model %in% c("coef", "full"))
     }
-    control <- list(frequency = frequency, model = model, hsize = hsize)
+    control <- list(frequency = frequency, counts = counts, model = model, hsize = hsize)
     preres <- contexts_extractor(ct, reverse, covlmc_context_extractor, control, no_summary)
     rownames(preres) <- 1:nrow(preres)
     preres

R/ctx_tree_contexts.R

@@ -15,6 +15,17 @@ frequency_context_extractor <-
           res <-
             cbind(res, data.frame(freq_by_val, check.names = FALSE))
         }
+        if (!is_leaf && isTRUE(control$counts == "local")) {
+          ## remove sub counts
+          for (child in ct$children) {
+            if (!is.null(child[["f_by"]])) {
+              res$freq <- res$freq - sum(child[["f_by"]])
+              if (control$frequency == "detailed") {
+                res[, -(1:2)] <- res[, -(1:2)] - child[["f_by"]]
+              }
+            }
+          }
+        }
         res
       }
     } else {

R/vlmc_contexts.R

@@ -28,6 +28,11 @@ vlmc_context_extractor <-
 #'   `cutoff=NULL` does not include those values. Setting `cutoff` to `quantile`
 #'   adds the cut off values in quantile scale, while `cutoff="native"` adds
 #'   them in the native scale.
+#' @param counts specifies how the counts reported by `frequency` are computed.
+#'   The default value `"desc"` includes both counts that are specific to the
+#'   context (if any) and counts from the descendants of the context in the
+#'   tree. When `counts = "local"` the counts include only the number of times
+#'   the context appears without being the last part of a longer context.
 #' @details The default result for `type="auto"` (or `type="list"`),
 #'   `frequency=NULL` and `cutoff=NULL` is the list of all contexts.
 #'
@@ -56,9 +61,11 @@ vlmc_context_extractor <-
 #' contexts(model, frequency = "total")
 #' contexts(model, cutoff = "quantile")
 #' @export
-contexts.vlmc <- function(ct, type = c("auto", "list", "data.frame"), reverse = TRUE, frequency = NULL, cutoff = NULL, ...) {
+contexts.vlmc <- function(ct, type = c("auto", "list", "data.frame"), reverse = TRUE, frequency = NULL,
+                          counts = c("desc", "local"), cutoff = NULL, ...) {
   type <- match.arg(type)
-  if (is.null(cutoff)) {
+  counts <- match.arg(counts)
+  if (is.null(cutoff) && counts == "desc") {
     NextMethod()
   } else {
     assertthat::assert_that(type %in% c("auto", "data.frame"))
@@ -68,7 +75,7 @@ contexts.vlmc <- function(ct, type = c("auto", "list", "data.frame"), reverse =
     if (!is.null(cutoff)) {
       assertthat::assert_that(cutoff %in% c("quantile", "native"))
     }
-    control <- list(frequency = frequency, p_value = !is.null(cutoff))
+    control <- list(frequency = frequency, counts = counts, p_value = !is.null(cutoff))
     preres <- contexts_extractor(ct, reverse, vlmc_context_extractor, control, vlmc_parent_summary)
     if (!is.null(cutoff)) {
       if ((cutoff == "quantile")) {