first pass at pcens stan tests

inst/stan/functions/primary_censored_dist.stan

@@ -174,7 +174,7 @@ real primary_censored_dist_cdf(real d, int dist_id, array[] real params,
                                array[] real primary_params) {
   real result;
   if (d <= 0 || d >= D) {
-  return 0;
+    return 0;
   }
 
   array[size(params) + size(primary_params) + 1] real theta =

tests/testthat/test-stan-rpd-primarycensoreddist.R

@@ -0,0 +1,114 @@
+skip_on_cran()
+skip_on_os("windows")
+skip_on_os("mac")
+
+test_that("Stan primary_censored_dist_cdf matches R pprimarycensoreddist", {
+  d <- seq(0, 10, by = 0.5)
+  dist_id <- 1 # Lognormal
+  params <- c(0, 1) # meanlog, sdlog
+  pwindow <- 1
+  D <- Inf
+  primary_dist_id <- 1 # Uniform
+  primary_params <- numeric(0)
+
+  stan_cdf <- sapply(
+    d, primary_censored_dist_cdf, dist_id, params, pwindow, D,
+    primary_dist_id, primary_params
+  )
+  r_cdf <- pprimarycensoreddist(
+    d, plnorm,
+    pwindow = pwindow, D = D, meanlog = params[1], sdlog = params[2]
+  )
+
+  expect_equal(stan_cdf, r_cdf, tolerance = 1e-6)
+})
+
+test_that(
+  "Stan primary_censored_dist_lcdf matches R pprimarycensoreddist with
+   log.p = TRUE",
+  {
+    d <- seq(0, 10, by = 0.5)
+    dist_id <- 1 # Lognormal
+    params <- c(0, 1) # meanlog, sdlog
+    pwindow <- 1
+    D <- Inf
+    primary_dist_id <- 1 # Uniform
+    primary_params <- numeric(0)
+
+    stan_lcdf <- sapply(
+      d, primary_censored_dist_lcdf, dist_id, params, pwindow, D,
+      primary_dist_id, primary_params
+    )
+    r_lcdf <- log(
+      pprimarycensoreddist(
+        d, plnorm,
+        pwindow = pwindow, D = D, meanlog = params[1],
+        sdlog = params[2]
+      )
+    )
+
+    expect_equal(stan_lcdf, r_lcdf, tolerance = 1e-6)
+  }
+)
+
+test_that("Stan primary_censored_dist_pmf matches R dprimarycensoreddist", {
+  d <- 0:10
+  dist_id <- 1 # Lognormal
+  params <- c(0, 1) # meanlog, sdlog
+  pwindow <- 1
+  swindow <- 1
+  D <- Inf
+  primary_dist_id <- 1 # Uniform
+  primary_params <- numeric(0)
+
+  stan_pmf <- sapply(d, primary_censored_dist_pmf, dist_id, params, pwindow, swindow, D, primary_dist_id, primary_params)
+  r_pmf <- dprimarycensoreddist(d, plnorm, pwindow = pwindow, swindow = swindow, D = D, meanlog = params[1], sdlog = params[2])
+
+  expect_equal(stan_pmf, r_pmf, tolerance = 1e-6)
+})
+
+test_that("Stan primary_censored_dist_lpmf matches R dprimarycensoreddist with log = TRUE", {
+  d <- 0:10
+  dist_id <- 1 # Lognormal
+  params <- c(0, 1) # meanlog, sdlog
+  pwindow <- 1
+  swindow <- 1
+  D <- Inf
+  primary_dist_id <- 1 # Uniform
+  primary_params <- numeric(0)
+
+  stan_lpmf <- sapply(d, primary_censored_dist_lpmf, dist_id, params, pwindow, swindow, D, primary_dist_id, primary_params)
+  r_lpmf <- dprimarycensoreddist(d, plnorm, pwindow = pwindow, swindow = swindow, D = D, meanlog = params[1], sdlog = params[2], log = TRUE)
+
+  expect_equal(stan_lpmf, r_lpmf, tolerance = 1e-6)
+})
+
+test_that("Stan primary_censored_sone_pmf_vectorized matches R dprimarycensoreddist", {
+  max_delay <- 10
+  dist_id <- 1 # Lognormal
+  params <- c(0, 1) # meanlog, sdlog
+  pwindow <- 1
+  D <- Inf
+  primary_dist_id <- 1 # Uniform
+  primary_params <- numeric(0)
+
+  stan_pmf <- primary_censored_sone_pmf_vectorized(max_delay, D, dist_id, params, pwindow, primary_dist_id, primary_params)
+  r_pmf <- dprimarycensoreddist(1:max_delay, plnorm, pwindow = pwindow, swindow = 1, D = D, meanlog = params[1], sdlog = params[2])
+
+  expect_equal(stan_pmf, r_pmf, tolerance = 1e-6)
+})
+
+test_that("Stan primary_censored_sone_lpmf_vectorized matches R dprimarycensoreddist with log = TRUE", {
+  max_delay <- 10
+  dist_id <- 1 # Lognormal
+  params <- c(0, 1) # meanlog, sdlog
+  pwindow <- 1
+  D <- Inf
+  primary_dist_id <- 1 # Uniform
+  primary_params <- numeric(0)
+
+  stan_lpmf <- primary_censored_sone_lpmf_vectorized(max_delay, D, dist_id, params, pwindow, primary_dist_id, primary_params)
+  r_lpmf <- dprimarycensoreddist(1:max_delay, plnorm, pwindow = pwindow, swindow = 1, D = D, meanlog = params[1], sdlog = params[2], log = TRUE)
+
+  expect_equal(stan_lpmf, r_lpmf, tolerance = 1e-6)
+})