fix lfactor for categorical responses,run-extended

ropensci · Sep 19, 2023 · d439a45 · d439a45
1 parent c0a0c4b
commit d439a45
Show file tree

Hide file tree

Showing 5 changed files with 100 additions and 29 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,7 @@
+# dynamite 1.4.6
+
+  * Fixed the construction of latent factors for categorical responses.
+
 # dynamite 1.4.5
 
   * The `get_data()` method for `dynamitefit` objects now correctly uses the previously defined priors instead of the default ones.

diff --git a/R/dynamite.R b/R/dynamite.R
@@ -1063,7 +1063,6 @@ parse_lfactor <- function(lfactor_def, resp, families) {
   out <- list()
   if (!is.null(lfactor_def)) {
     valid_channels <- resp
-    # default, use all channels except categorical
     if (is.null(lfactor_def$responses)) {
       lfactor_def$responses <- valid_channels
     } else {
@@ -1083,7 +1082,7 @@ parse_lfactor <- function(lfactor_def, resp, families) {
     out$has_lfactor <- TRUE
     out$responses <- lfactor_def$responses
     out$noncentered_psi <- lfactor_def$noncentered_psi
-    n_channels <- length(resp)
+    n_channels <- length(lfactor_def$responses)
     out$nonzero_lambda <- lfactor_def$nonzero_lambda
     stopifnot_(
       length(out$nonzero_lambda) %in% c(1L, n_channels),

diff --git a/R/stanblocks.R b/R/stanblocks.R
@@ -416,11 +416,21 @@ create_transformed_parameters <- function(idt, backend,
   }
   lfactor_text <- ""
   psis <- mvars$lfactor_def$responses
+  psis <- lapply(psis, function(x) {
+    y <- cvars[[x]]
+    ifelse_(
+    is_categorical(y$family),
+    y$categories[-y$S],
+    y$y)
+    })
+  n_y <- lengths(psis)
+  psis <- unlist(psis)
   P <- length(psis)
   if (P > 0L) {
     if (mvars$lfactor_def$noncentered_psi) {
+      nz_lambda <- rep(mvars$lfactor_def$nonzero_lambda, times = n_y)
       tau_psi <- ifelse(
-        mvars$lfactor_def$nonzero_lambda,
+        nz_lambda,
         paste0("tau_psi_", psis, " * "),
         ""
       )
@@ -579,8 +589,18 @@ create_model <- function(idt, backend, cg, cvars, cgvars, mvars, threading) {
   }
   lfactor_text <- ""
   psis <- mvars$lfactor_def$responses
+  psis <- lapply(psis, function(x) {
+    y <- cvars[[x]]
+    ifelse_(
+      is_categorical(y$family),
+      y$categories[-y$S],
+      y$y)
+  })
+  n_y <- lengths(psis)
+  psis <- unlist(psis)
   P <- length(psis)
   if (P > 0L) {
+    nz_lambda <- rep(mvars$lfactor_def$nonzero_lambda, times = n_y)
     omega1 <- paste0("omega_raw_psi_1_", psis, collapse = ", ")
     if (mvars$lfactor_def$correlated) {
       L_prior <- mvars$common_priors
@@ -592,10 +612,10 @@ create_model <- function(idt, backend, cg, cvars, cgvars, mvars, threading) {
           .indent = idt(c(1, 1))
         )
       } else {
-        if (any(mvars$lfactor_def$nonzero_lambda)) {
+        if (any(nz_lambda)) {
           tau <- paste0(
             ifelse(
-              mvars$lfactor_def$nonzero_lambda,
+              nz_lambda,
               paste0("tau_psi_", psis),
               "1"
             ),
@@ -639,10 +659,10 @@ create_model <- function(idt, backend, cg, cvars, cgvars, mvars, threading) {
           .indent = idt(1)
         )
       } else {
-        if (any(mvars$lfactor_def$nonzero_lambda)) {
+        if (any(nz_lambda)) {
           tau <- paste0(
             ifelse(
-              mvars$lfactor_def$nonzero_lambda,
+              nz_lambda,
               paste0("tau_psi_", psis),
               "1"
             ),

diff --git a/codemeta.json b/codemeta.json
@@ -2,16 +2,19 @@
   "@context": "https://doi.org/10.5063/schema/codemeta-2.0",
   "@type": "SoftwareSourceCode",
   "identifier": "dynamite",
-  "description": "Easy-to-use and efficient interface for Bayesian inference of complex panel (time series) data using dynamic multivariate panel models by the Authors (2022). The package supports joint modeling of multiple measurements per individual, time-varying and time-invariant effects, and a wide range of discrete and continuous distributions. Estimation of these dynamic multivariate panel models is carried out via 'Stan'. For an in-depth tutorial of the package, see the package vignette.",
+  "description": "Easy-to-use and efficient interface for Bayesian inference of complex panel (time series) data using dynamic multivariate panel models by Helske and Tikka (2022) <doi:10.31235/osf.io/mdwu5>. The package supports joint modeling of multiple measurements per individual, time-varying and time-invariant effects, and a wide range of discrete and continuous distributions. Estimation of these dynamic multivariate panel models is carried out via 'Stan'. For an in-depth tutorial of the package, see (Tikka and Helske, 2023) <arxiv:2302.01607>.",
   "name": "dynamite: Bayesian Modeling and Causal Inference for Multivariate\n    Longitudinal Data",
+  "relatedLink": ["https://docs.ropensci.org/dynamite/", "https://CRAN.R-project.org/package=dynamite"],
+  "codeRepository": "https://github.com/ropensci/dynamite/",
+  "issueTracker": "https://github.com/ropensci/dynamite/issues/",
   "license": "https://spdx.org/licenses/GPL-3.0",
-  "version": "1.4.2",
+  "version": "1.4.5",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",
     "url": "https://r-project.org"
   },
-  "runtimePlatform": "R version 4.2.1 (2022-06-23 ucrt)",
+  "runtimePlatform": "R version 4.3.0 (2023-04-21 ucrt)",
   "provider": {
     "@id": "https://cran.r-project.org",
     "@type": "Organization",
@@ -21,26 +24,26 @@
   "author": [
     {
       "@type": "Person",
-      "givenName": "XXXX",
-      "familyName": "XXXX",
-      "email": "xxxx",
-      "@id": "https://orcid.org/XXXX"
+      "givenName": "Santtu",
+      "familyName": "Tikka",
+      "email": "[email protected]",
+      "@id": "https://orcid.org/0000-0003-4039-4342"
     },
     {
       "@type": "Person",
-      "givenName": "XXXX",
-      "familyName": "XXXX",
-      "email": "xxxx",
-      "@id": "https://orcid.org/XXXX"
+      "givenName": "Jouni",
+      "familyName": "Helske",
+      "email": "[email protected]",
+      "@id": "https://orcid.org/0000-0001-7130-793X"
     }
   ],
   "maintainer": [
     {
       "@type": "Person",
-      "givenName": "XXXX",
-      "familyName": "XXXX",
-      "email": "xxxx",
-      "@id": "https://orcid.org/XXXX"
+      "givenName": "Santtu",
+      "familyName": "Tikka",
+      "email": "[email protected]",
+      "@id": "https://orcid.org/0000-0003-4039-4342"
     }
   ],
   "softwareSuggestions": [
@@ -304,30 +307,75 @@
     },
     "SystemRequirements": null
   },
-  "fileSize": "5064.821KB",
+  "fileSize": "5081.692KB",
   "citation": [
+    {
+      "@type": "CreativeWork",
+      "datePublished": "2023",
+      "author": [
+        {
+          "@type": "Person",
+          "givenName": "Santtu",
+          "familyName": "Tikka"
+        },
+        {
+          "@type": "Person",
+          "givenName": "Jouni",
+          "familyName": "Helske"
+        }
+      ],
+      "name": "dynamite: An R Package for Dynamic Multivariate Panel Models",
+      "identifier": "10.48550/ARXIV.2302.01607",
+      "url": "https://arxiv.org/abs/2302.01607",
+      "@id": "https://doi.org/10.48550/ARXIV.2302.01607",
+      "sameAs": "https://doi.org/10.48550/ARXIV.2302.01607"
+    },
+    {
+      "@type": "CreativeWork",
+      "datePublished": "2022",
+      "author": [
+        {
+          "@type": "Person",
+          "givenName": "Santtu",
+          "familyName": "Tikka"
+        },
+        {
+          "@type": "Person",
+          "givenName": "Jouni",
+          "familyName": "Helske"
+        }
+      ],
+      "name": "Estimating Causal Effects from Panel Data with Dynamic\n    Multivariate Panel Models",
+      "url": "https://osf.io/preprints/socarxiv/mdwu5/"
+    },
     {
       "@type": "SoftwareSourceCode",
       "datePublished": "2022",
       "author": [
         {
           "@type": "Person",
-          "givenName": "XXXX",
-          "familyName": "XXXX"
+          "givenName": "Santtu",
+          "familyName": "Tikka"
         },
         {
           "@type": "Person",
-          "givenName": "XXXX",
-          "familyName": "XXXX"
+          "givenName": "Jouni",
+          "familyName": "Helske"
         }
       ],
       "name": "Bayesian Modeling and Causal Inference for Multivariate\n    Longitudinal Data",
       "url": "https://github.com/ropensci/dynamite",
       "description": "R package version 1.0.0"
     }
   ],
-  "codeRepository": "https://github.com/ropensci/dynamite",
   "releaseNotes": "https://github.com/ropensci/dynamite/blob/master/NEWS.md",
   "readme": "https://github.com/ropensci/dynamite/blob/main/README.md",
+  "contIntegration": ["https://github.com/ropensci/dynamite/actions", "https://app.codecov.io/gh/ropensci/dynamite?branch=main"],
+  "developmentStatus": "https://www.repostatus.org/#active",
+  "review": {
+    "@type": "Review",
+    "url": "https://github.com/ropensci/software-review/issues/554",
+    "provider": "https://ropensci.org"
+  },
   "keywords": ["bayesian-inference", "panel-data", "r", "r-package", "rstats", "stan", "statistical-models"]
 }
diff --git a/tests/testthat/test-edgecases.R b/tests/testthat/test-edgecases.R
@@ -323,7 +323,7 @@ test_that("latent factors are handled correctly", {
       obs(y3 ~ -1 + x3 + varying(~x1) + trials(trials), family = "binomial") +
       obs(y4 ~ x1 + varying(~ -1 + x2), family = "bernoulli") +
       splines(df = 5) +
-      lfactor(c("y2", "y3"), nonzero_lambda = c(TRUE, FALSE, FALSE)),
+      lfactor(c("y2", "y3"), nonzero_lambda = c(TRUE, FALSE)),
     NA
   )
   expect_equal(