use predict in get_probs, fix bugs

helske · Sep 8, 2024 · 7630082 · 7630082
1 parent ec5270e
commit 7630082
Show file tree

Hide file tree

Showing 32 changed files with 229 additions and 289 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -17,3 +17,4 @@ vignettes/jss.cls
 ^\.github$
 ^codecov\.yml$
 ^.covrignore
+^\.covrignore$
diff --git a/.covrignore b/.covrignore
@@ -4,4 +4,3 @@ R/ssp-deprecated.R
 R/ssplot-deprecated.R
 R/ssplotM-deprecated.R
 R/SSplotter-deprecated.R
-
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -27,6 +27,10 @@ jobs:
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
       R_KEEP_PKG_SOURCE: yes
+      # this sets the env variable to true or false depending on whether the
+      # commit message contains text 'run-extended'
+      SEQHMM_EXTENDED_TESTS: ${{contains(github.event.head_commit.message, 'run-extended')}}
+
 
     steps:
       - uses: actions/checkout@v3

diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml
@@ -4,47 +4,61 @@ on:
   push:
     branches: [main, stan]
   pull_request:
-    branches: [main, master]
+    branches: [main, stan]
+
+name: test-coverage.yaml
 
-name: test-coverage
+permissions: read-all
 
 jobs:
   test-coverage:
     runs-on: ubuntu-latest
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      # this sets the env variable to true or false depending on whether the
+      # commit message contains text 'run-extended'
+      SEQHMM_EXTENDED_TESTS: ${{contains(github.event.head_commit.message, 'run-extended')}}
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-r@v2
         with:
           use-public-rspm: true
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: any::covr
+          extra-packages: any::covr, any::xml2
           needs: coverage
 
       - name: Test coverage
         run: |
-          covr::codecov(
+          cov <- covr::package_coverage(
             quiet = FALSE,
             clean = FALSE,
-            install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package")
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
           )
+          covr::to_cobertura(cov)
         shell: Rscript {0}
 
+      - uses: codecov/codecov-action@v4
+        with:
+          fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }}
+          file: ./cobertura.xml
+          plugin: noop
+          disable_search: true
+          token: ${{ secrets.CODECOV_TOKEN }}
+
       - name: Show testthat output
         if: always()
         run: |
           ## --------------------------------------------------------------------
-          find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+          find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
         shell: bash
 
       - name: Upload test results
         if: failure()
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
         with:
           name: coverage-test-failures
           path: ${{ runner.temp }}/package
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -36,7 +36,7 @@ LinkingTo:
     rstan (>= 2.18.1),
     StanHeaders (>= 2.18.0)
 Depends:
-    R (>= 3.5.0)
+    R (>= 4.1.0)
 Imports:
     checkmate,
     cli,

diff --git a/R/average_marginal_prediction.R b/R/average_marginal_prediction.R
@@ -66,7 +66,7 @@ average_marginal_prediction <- function(
     )
   } else {
     stopifnot_(
-      is.null(model$data),
+      !is.null(model$data),
       "Model does not contain original data and argument {.arg newdata} is 
       {.var NULL}."
     )

diff --git a/R/build_hmm.R b/R/build_hmm.R
@@ -56,7 +56,7 @@
 #'   "joblessness", "school", "training"
 #' )
 #' mvad_scodes <- c("EM", "FE", "HE", "JL", "SC", "TR")
-#' mvad_seq <- seqdef(mvad, 17:86,
+#' mvad_seq <- seqdef(mvad, 15:86,
 #'   alphabet = mvad_alphabet, states = mvad_scodes,
 #'   labels = mvad_labels, xtstep = 6
 #' )

diff --git a/R/build_lcm.R b/R/build_lcm.R
@@ -83,7 +83,7 @@
 #'   "joblessness", "school", "training"
 #' )
 #' mvad_scodes <- c("EM", "FE", "HE", "JL", "SC", "TR")
-#' mvad_seq <- seqdef(mvad, 17:86,
+#' mvad_seq <- seqdef(mvad, 15:86,
 #'   alphabet = mvad_alphabet, states = mvad_scodes,
 #'   labels = mvad_labels, xtstep = 6
 #' )

diff --git a/R/build_mm.R b/R/build_mm.R
@@ -44,7 +44,7 @@
 #'   "joblessness", "school", "training"
 #' )
 #' mvad_scodes <- c("EM", "FE", "HE", "JL", "SC", "TR")
-#' mvad_seq <- seqdef(mvad, 17:86,
+#' mvad_seq <- seqdef(mvad, 15:86,
 #'   alphabet = mvad_alphabet,
 #'   states = mvad_scodes, labels = mvad_labels, xtstep = 6,
 #'   cpal = colorpalette[[6]]

diff --git a/R/build_mmm.R b/R/build_mmm.R
@@ -62,7 +62,7 @@
 #'   "joblessness", "school", "training"
 #' )
 #' mvad_scodes <- c("EM", "FE", "HE", "JL", "SC", "TR")
-#' mvad_seq <- seqdef(mvad, 17:86,
+#' mvad_seq <- seqdef(mvad, 15:86,
 #'   alphabet = mvad_alphabet, states = mvad_scodes,
 #'   labels = mvad_labels, xtstep = 6
 #' )

diff --git a/R/build_mnhmm.R b/R/build_mnhmm.R
@@ -30,6 +30,6 @@ build_mnhmm <- function(
     nobs = attr(out$observations, "nobs"),
     df = out$extras$n_pars,
     type = paste0(out$extras$multichannel, "mnhmm_", out$extras$model_type),
-    intercept_only = intercept_only
+    intercept_only = out$extras$intercept_only
   )
 }
diff --git a/R/build_nhmm.R b/R/build_nhmm.R
@@ -17,6 +17,6 @@ build_nhmm <- function(
     nobs = attr(out$observations, "nobs"),
     df = out$extras$n_pars,
     type = paste0(out$extras$multichannel, "nhmm_", out$extras$model_type),
-    intercept_only = intercept_only
+    intercept_only = out$extras$intercept_only
   )
 }
diff --git a/R/estimate_mnhmm.R b/R/estimate_mnhmm.R
@@ -24,18 +24,19 @@
 #' @examples
 #' data("mvad", package = "TraMineR")
 #' 
-#' mvad_alphabet <-
-#'   c("employment", "FE", "HE", "joblessness", "school", "training")
-#' mvad_labels <- c("employment", "further education", "higher education",
-#'                  "joblessness", "school", "training")
-#' mvad_scodes <- c("EM", "FE", "HE", "JL", "SC", "TR")
-#' mvad_seq <- seqdef(mvad, 17:86, alphabet = mvad_alphabet,
-#'                    states = mvad_scodes, labels = mvad_labels, xtstep = 6,
-#'                    cpal = unname(colorpalette[[6]]))
+#' d <- reshape(mvad, direction = "long", varying = list(15:86), 
+#'   v.names = "activity")
 #' 
 #' \dontrun{
 #' set.seed(1)
-#' fit <- estimate_mnhmm(mvad_seq, n_states = 3, n_clusters = 2)
+#' fit <- estimate_mnhmm("activity", n_states = 3, n_clusters = 2,
+#'   data = d, time = "time", id = "id", 
+#'   cluster_formula = ~ male + catholic + gcse5eq + Grammar + 
+#'     funemp + fmpr + livboth + Belfast +
+#'   N.Eastern + Southern + S.Eastern + Western,
+#'   initial_formula = ~ 1, emission_formula =  ~ male + catholic + gcse5eq,
+#'   transition_formula = ~ male + gcse5eq, inits = "random"
+#'   )
 #' }
 estimate_mnhmm <- function(
     observations, n_states, n_clusters, initial_formula = ~1, 

diff --git a/R/estimate_nhmm.R b/R/estimate_nhmm.R
@@ -62,7 +62,7 @@
 #' mvad_labels <- c("employment", "further education", "higher education",
 #'                  "joblessness", "school", "training")
 #' mvad_scodes <- c("EM", "FE", "HE", "JL", "SC", "TR")
-#' mvad_seq <- seqdef(mvad, 17:86, alphabet = mvad_alphabet,
+#' mvad_seq <- seqdef(mvad, 15:86, alphabet = mvad_alphabet,
 #'                    states = mvad_scodes, labels = mvad_labels, xtstep = 6,
 #'                    cpal = unname(colorpalette[[6]]))
 #' 

diff --git a/R/fit_model.R b/R/fit_model.R
@@ -181,7 +181,7 @@
 #'   "joblessness", "school", "training"
 #' )
 #' mvad_scodes <- c("EM", "FE", "HE", "JL", "SC", "TR")
-#' mvad_seq <- seqdef(mvad, 17:86,
+#' mvad_seq <- seqdef(mvad, 15:86,
 #'   alphabet = mvad_alphabet,
 #'   states = mvad_scodes, labels = mvad_labels, xtstep = 6,
 #'   cpal = colorpalette[[6]]