Add lbf_variable to results exported

stephenslab · Mar 19, 2024 · cf62fff · cf62fff
1 parent 29d49d7
commit cf62fff
Show file tree

Hide file tree

Showing 4 changed files with 10 additions and 2 deletions.
diff --git a/R/ibss_algorithm.R b/R/ibss_algorithm.R
@@ -209,6 +209,12 @@ SuSiE <- R6Class("SuSiE",
         function(l) private$SER[[l]]$lbf
       )
     },
+    lbf_variable = function() {
+      do.call(rbind, lapply(
+        seq(1, private$L),
+        function(l) private$SER[[l]]$lbf_variable
+      ))
+    },
     pip_history = function() {
       lapply(
         seq(

diff --git a/R/mvsusie_utils.R b/R/mvsusie_utils.R
@@ -124,6 +124,7 @@ report_susie_model <- function(d, m, estimate_prior_variance = TRUE) {
     b2 = b2,
     KL = m$kl,
     lbf = m$lbf,
+    lbf_variable = m$lbf_variable,
     V = m$prior_variance,
     sigma2 = d$residual_variance,
     elbo = m$get_objective(dump = TRUE),

diff --git a/R/single_effect_model.R b/R/single_effect_model.R
@@ -196,6 +196,7 @@ SingleEffectModel <- function(base) {
         }
       },
       lbf = function() private$lbf_single_effect,
+      lbf_variable = function() private$.lbf,
       kl = function() private$.kl,
       vbxxb = function() private$.vbxxb,
       bxxb = function() private$.bxxb

diff --git a/tests/testthat/test_susie_regression.R b/tests/testthat/test_susie_regression.R
@@ -116,7 +116,7 @@ test_that("customized initialization interface", with(simulate_multivariate(r=3)
     # let's just test of null is null ...
     null_weight = 0.2
     m_init = create_mixture_prior(R = ncol(y),null_weight = null_weight, max_mixture_len=-1)
-    expect_equal(m_init$prior_variance$pi[1], null_weight)
+    expect_equal(unname(m_init$prior_variance$pi[1]), null_weight)
 }))
 
 test_that("mvsusieR is identical to susieR (RSS)", with(simulate_univariate(summary = T), {
@@ -200,5 +200,5 @@ test_that("customized initialization interface (RSS)", with(simulate_multivariat
   # let's just test of null is null ...
   null_weight = 0.2
   m_init = create_mixture_prior(R = ncol(y),null_weight = null_weight, max_mixture_len=-1)
-  expect_equal(m_init$prior_variance$pi[1], null_weight)
+  expect_equal(unname(m_init$prior_variance$pi[1]), null_weight)
 }))