Site model has the correct number of distributions depending on the g…

…amma site model, progress #50

R/get_gamma_site_model_n_distrs.R

@@ -2,16 +2,25 @@
 #' @inheritParams default_params_doc
 #' @return the number of distributrion a gamma site model has
 #' @examples
-#'   gamma_site_model <- create_gamma_site_model(prop_invariant = 0.5)
-#'
 #'   gamma_site_model <- create_gamma_site_model()
-#'   gamma_site_model_n_distrs <- get_gamma_site_model_n_distrs(
+#'   n_distrs <- get_gamma_site_model_n_distrs(
 #'     gamma_site_model
 #'    )
-#'   testit::assert(gamma_site_model_n_distrs == 1)
+#'   testit::assert(n_distrs == 0)
+#'
+#'   gamma_site_model <- create_gamma_site_model(
+#'     gamma_cat_count = 2,
+#'     gamma_shape_prior_distr = create_exp_distr()
+#'   )
+#'   n_distrs <- get_gamma_site_model_n_distrs(gamma_site_model)
+#'   testit::assert(n_distrs == 1)
 #' @author Richel J.C. Bilderbeek
 #' @export
 get_gamma_site_model_n_distrs <- function(gamma_site_model) {
   testit::assert(is_gamma_site_model(gamma_site_model))
-  1
+  if (gamma_site_model$gamma_cat_count < 2) {
+    0
+  } else {
+    1
+  }
 }

tests/testthat/test-get_gamma_site_model_n_distrs.R

@@ -2,18 +2,49 @@ context("test-get_gamma_site_model_n_distrs")
 
 test_that("use", {
 
-  # All gamme site models have one distribution?
+  expect_equal(
+    get_gamma_site_model_n_distrs(
+      create_gamma_site_model(gamma_cat_count = 0)
+    ),
+    0
+  )
+
+  expect_equal(
+    get_gamma_site_model_n_distrs(
+      create_gamma_site_model(gamma_cat_count = 1)
+    ),
+    0
+  )
+
+  # 1 distr with 0 params
+  expect_equal(
+    get_gamma_site_model_n_distrs(
+      create_gamma_site_model(
+        gamma_cat_count = 2,
+        gamma_shape_prior_distr = create_uniform_distr()
+      )
+    ),
+    1
+  )
 
+  # 1 distr with 1 param
   expect_equal(
     get_gamma_site_model_n_distrs(
-      create_gamma_site_model(gamma_shape_prior_distr = create_normal_distr())
+      create_gamma_site_model(
+        gamma_cat_count = 2,
+        gamma_shape_prior_distr = create_poisson_distr()
+      )
     ),
     1
   )
 
+  # 1 distr with 2 params
   expect_equal(
     get_gamma_site_model_n_distrs(
-      create_gamma_site_model(gamma_shape_prior_distr = create_uniform_distr())
+      create_gamma_site_model(
+        gamma_cat_count = 2,
+        gamma_shape_prior_distr = create_normal_distr()
+      )
     ),
     1
   )

tests/testthat/test-get_site_model_n_distrs.R

@@ -1,37 +1,84 @@
 context("get_site_model_n_distrs")
 
-test_that("use", {
+test_that("use, default gamma site model", {
 
-  # gamma_site_model$gamma_shape_prior_distr
   # rate_ac_prior_distr
   # rate_ag_prior_distr
   # rate_at_prior_distr
   # rate_cg_prior_distr
   # rate_gt_prior_distr
   testthat::expect_equal(
-    beautier:::get_site_model_n_distrs(create_gtr_site_model()),
-    6
+    beautier:::get_site_model_n_distrs(
+      create_gtr_site_model()),
+    5
   )
 
-  # gamma_site_model$gamma_shape_prior_distr
   # kappa_prior_distr
   testthat::expect_equal(
     beautier:::get_site_model_n_distrs(create_hky_site_model()),
-    2
+    1
   )
 
-  # gamma_site_model$gamma_shape_prior_distr
   # no other distributions
   testthat::expect_equal(
     beautier:::get_site_model_n_distrs(create_jc69_site_model()),
-    1
+    0
   )
 
-  # gamma_site_model$gamma_shape_prior_distr
   # kappa_1_prior_distr
   # kappa_2_prior_distr
   testthat::expect_equal(
     beautier:::get_site_model_n_distrs(create_tn93_site_model()),
+    2
+  )
+})
+
+test_that("use, gamma site model with 1 distr", {
+
+  gamma_site_model <- create_gamma_site_model(
+    gamma_cat_count = 2,
+    gamma_shape_prior_distr = create_normal_distr()
+  )
+
+  # rate_ac_prior_distr
+  # rate_ag_prior_distr
+  # rate_at_prior_distr
+  # rate_cg_prior_distr
+  # rate_gt_prior_distr
+  # gamma_site_model$gamma_shape_prior_distr
+  testthat::expect_equal(
+    beautier:::get_site_model_n_distrs(
+      create_gtr_site_model(
+        gamma_site_model = gamma_site_model
+      )),
+    6
+  )
+
+  # kappa_prior_distr
+  # gamma_site_model$gamma_shape_prior_distr
+  testthat::expect_equal(
+    beautier:::get_site_model_n_distrs(create_hky_site_model(
+      gamma_site_model = gamma_site_model
+    )),
+    2
+  )
+
+  # only:
+  # gamma_site_model$gamma_shape_prior_distr
+  testthat::expect_equal(
+    beautier:::get_site_model_n_distrs(create_jc69_site_model(
+      gamma_site_model = gamma_site_model
+    )),
+    1
+  )
+
+  # kappa_1_prior_distr
+  # kappa_2_prior_distr
+  # gamma_site_model$gamma_shape_prior_distr
+  testthat::expect_equal(
+    beautier:::get_site_model_n_distrs(create_tn93_site_model(
+      gamma_site_model = gamma_site_model
+    )),
     3
   )
 })

tests/testthat/test-get_site_models_n_distrs.R

@@ -2,9 +2,12 @@ context("get_site_models_n_distrs")
 
 test_that("use", {
 
-  site_model_0_distrs <- create_jc69_site_model()
-  site_model_1_distrs <- create_hky_site_model()
-  site_model_2_distrs <- create_tn93_site_model()
+  gamma_site_model <- create_gamma_site_model(gamma_cat_count = 2)
+  testit::assert(get_gamma_site_model_n_distrs(gamma_site_model) == 1)
+
+  site_model_0_distrs <- create_jc69_site_model(gamma_site_model = gamma_site_model)
+  site_model_1_distrs <- create_hky_site_model(gamma_site_model = gamma_site_model)
+  site_model_2_distrs <- create_tn93_site_model(gamma_site_model = gamma_site_model)
 
   testit::assert(beautier:::get_site_model_n_distrs(site_model_0_distrs) == 1)
   testit::assert(beautier:::get_site_model_n_distrs(site_model_1_distrs) == 2)