From 741e28e2beea7b62987ebf68d6590c83cf0f0454 Mon Sep 17 00:00:00 2001
From: Mlen-Too Wesley <mlen.too.wesley@gmail.com>
Date: Mon, 25 Nov 2024 14:59:51 -0500
Subject: [PATCH] Add test scripts for custom censored distributions

Add separate test scripts for each custom censored distribution.

* Add `tests/testthat/test-normal_censored.R` for `normal_censored` distribution.
* Add `tests/testthat/test-lognormal_censored.R` for `lognormal_censored` distribution.
* Add `tests/testthat/test-student_censored.R` for `student_censored` distribution.
* Add `tests/testthat/test-gamma_censored.R` for `gamma_censored` distribution.
* Add `tests/testthat/test-exponential_censored.R` for `exponential_censored` distribution.
* Add `tests/testthat/test-weibull_censored.R` for `weibull_censored` distribution.
* Add `tests/testthat/test-pareto_censored.R` for `pareto_censored` distribution.
* Add `tests/testthat/test-beta_censored.R` for `beta_censored` distribution.
* Delete `tests/testthat/test-censored.R`.

---

For more details, open the [Copilot Workspace session](https://copilot-workspace.githubnext.com/mtwesley/greta.censored?shareId=XXXX-XXXX-XXXX-XXXX).
---
 tests/testthat/test-beta_censored.R        |  45 ++++++++
 tests/testthat/test-censored.R             | 127 ---------------------
 tests/testthat/test-exponential_censored.R |  40 +++++++
 tests/testthat/test-gamma_censored.R       |  43 +++++++
 tests/testthat/test-lognormal_censored.R   |  43 +++++++
 tests/testthat/test-normal_censored.R      |  43 +++++++
 tests/testthat/test-pareto_censored.R      |  44 +++++++
 tests/testthat/test-student_censored.R     |  48 ++++++++
 tests/testthat/test-weibull_censored.R     |  43 +++++++
 9 files changed, 349 insertions(+), 127 deletions(-)
 create mode 100644 tests/testthat/test-beta_censored.R
 delete mode 100644 tests/testthat/test-censored.R
 create mode 100644 tests/testthat/test-exponential_censored.R
 create mode 100644 tests/testthat/test-gamma_censored.R
 create mode 100644 tests/testthat/test-lognormal_censored.R
 create mode 100644 tests/testthat/test-normal_censored.R
 create mode 100644 tests/testthat/test-pareto_censored.R
 create mode 100644 tests/testthat/test-student_censored.R
 create mode 100644 tests/testthat/test-weibull_censored.R

diff --git a/tests/testthat/test-beta_censored.R b/tests/testthat/test-beta_censored.R
new file mode 100644
index 0000000..b570576
--- /dev/null
+++ b/tests/testthat/test-beta_censored.R
@@ -0,0 +1,45 @@
+# Test script for beta_censored distribution
+
+library(greta)
+library(testthat)
+
+test_that("beta_censored distribution works correctly", {
+  # Simulate data
+  set.seed(505)
+  n <- 100
+  true_alpha <- 2
+  true_beta <- 5
+  y <- rbeta(n, shape1 = true_alpha, shape2 = true_beta)
+
+  # Introduce interval censoring between 0.2 and 0.8
+  lower_bound <- 0.2
+  upper_bound <- 0.8
+  is_censored <- y > lower_bound & y < upper_bound
+  y_obs <- y
+  y_obs[is_censored] <- NA  # Interval censored data
+
+  # Data preparation
+  y_greta <- as_data(ifelse(is.na(y_obs), 0, y_obs))  # Placeholder for censored data
+  is_censored_greta <- as_data(as.numeric(is_censored))
+
+  # Define the model
+  alpha <- variable(lower = 0)
+  beta <- variable(lower = 0)
+
+  distribution(y_greta) <- beta_censored(
+    alpha = alpha,
+    beta = beta,
+    is_censored = is_censored_greta,
+    censoring_type = "interval",
+    lower = lower_bound,
+    upper = upper_bound,
+    dim = n
+  )
+
+  # Model fitting
+  m <- model(alpha, beta)
+  draws <- mcmc(m, n_samples = 1000)
+
+  # Output results
+  summary(draws)
+})
diff --git a/tests/testthat/test-censored.R b/tests/testthat/test-censored.R
deleted file mode 100644
index aef8fae..0000000
--- a/tests/testthat/test-censored.R
+++ /dev/null
@@ -1,127 +0,0 @@
-test_that("exponential_censored_distribution initializes correctly", {
-  rate <- as.greta_array(1)
-  is_censored <- as.greta_array(0)
-  dist <- exponential_censored_distribution$new(rate, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "exponential_censored_distribution")
-})
-
-test_that("exponential_censored function works", {
-  rate <- as.greta_array(1)
-  is_censored <- as.greta_array(0)
-  dist <- exponential_censored(rate, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "distribution_node")
-})
-
-test_that("normal_censored_distribution initializes correctly", {
-  mean <- as.greta_array(0)
-  sd <- as.greta_array(1)
-  is_censored <- as.greta_array(0)
-  dist <- normal_censored_distribution$new(mean, sd, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "normal_censored_distribution")
-})
-
-test_that("normal_censored function works", {
-  mean <- as.greta_array(0)
-  sd <- as.greta_array(1)
-  is_censored <- as.greta_array(0)
-  dist <- normal_censored(mean, sd, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "distribution_node")
-})
-
-test_that("lognormal_censored_distribution initializes correctly", {
-  meanlog <- as.greta_array(0)
-  sdlog <- as.greta_array(1)
-  is_censored <- as.greta_array(0)
-  dist <- lognormal_censored_distribution$new(meanlog, sdlog, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "lognormal_censored_distribution")
-})
-
-test_that("lognormal_censored function works", {
-  meanlog <- as.greta_array(0)
-  sdlog <- as.greta_array(1)
-  is_censored <- as.greta_array(0)
-  dist <- lognormal_censored(meanlog, sdlog, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "distribution_node")
-})
-
-test_that("student_censored_distribution initializes correctly", {
-  df <- as.greta_array(3)
-  loc <- as.greta_array(0)
-  scale <- as.greta_array(1)
-  is_censored <- as.greta_array(0)
-  dist <- student_censored_distribution$new(df, loc, scale, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "student_censored_distribution")
-})
-
-test_that("student_censored function works", {
-  df <- as.greta_array(3)
-  loc <- as.greta_array(0)
-  scale <- as.greta_array(1)
-  is_censored <- as.greta_array(0)
-  dist <- student_censored(df, loc, scale, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "distribution_node")
-})
-
-test_that("gamma_censored_distribution initializes correctly", {
-  shape <- as.greta_array(2)
-  rate <- as.greta_array(1)
-  is_censored <- as.greta_array(0)
-  dist <- gamma_censored_distribution$new(shape, rate, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "gamma_censored_distribution")
-})
-
-test_that("gamma_censored function works", {
-  shape <- as.greta_array(2)
-  rate <- as.greta_array(1)
-  is_censored <- as.greta_array(0)
-  dist <- gamma_censored(shape, rate, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "distribution_node")
-})
-
-test_that("weibull_censored_distribution initializes correctly", {
-  shape <- as.greta_array(2)
-  scale <- as.greta_array(1)
-  is_censored <- as.greta_array(0)
-  dist <- weibull_censored_distribution$new(shape, scale, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "weibull_censored_distribution")
-})
-
-test_that("weibull_censored function works", {
-  shape <- as.greta_array(2)
-  scale <- as.greta_array(1)
-  is_censored <- as.greta_array(0)
-  dist <- weibull_censored(shape, scale, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "distribution_node")
-})
-
-test_that("pareto_censored_distribution initializes correctly", {
-  scale <- as.greta_array(1)
-  alpha <- as.greta_array(2)
-  is_censored <- as.greta_array(0)
-  dist <- pareto_censored_distribution$new(scale, alpha, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "pareto_censored_distribution")
-})
-
-test_that("pareto_censored function works", {
-  scale <- as.greta_array(1)
-  alpha <- as.greta_array(2)
-  is_censored <- as.greta_array(0)
-  dist <- pareto_censored(scale, alpha, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "distribution_node")
-})
-
-test_that("beta_censored_distribution initializes correctly", {
-  alpha <- as.greta_array(2)
-  beta <- as.greta_array(2)
-  is_censored <- as.greta_array(0)
-  dist <- beta_censored_distribution$new(alpha, beta, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "beta_censored_distribution")
-})
-
-test_that("beta_censored function works", {
-  alpha <- as.greta_array(2)
-  beta <- as.greta_array(2)
-  is_censored <- as.greta_array(0)
-  dist <- beta_censored(alpha, beta, is_censored, "right", 0, 1, dim = c(1, 1))
-  expect_s3_class(dist, "distribution_node")
-})
diff --git a/tests/testthat/test-exponential_censored.R b/tests/testthat/test-exponential_censored.R
new file mode 100644
index 0000000..d57c753
--- /dev/null
+++ b/tests/testthat/test-exponential_censored.R
@@ -0,0 +1,40 @@
+# Test script for exponential_censored distribution
+
+library(greta)
+library(testthat)
+
+test_that("exponential_censored distribution works correctly", {
+  # Simulate data
+  set.seed(202)
+  n <- 100
+  true_rate <- 0.5
+  y <- rexp(n, rate = true_rate)
+
+  # Introduce left censoring at y < 0.5
+  censoring_threshold <- 0.5
+  is_censored <- y < censoring_threshold
+  y_obs <- ifelse(is_censored, censoring_threshold, y)
+
+  # Data preparation
+  y_greta <- as_data(y_obs)
+  is_censored_greta <- as_data(as.numeric(is_censored))
+
+  # Define the model
+  rate <- variable(lower = 0)
+
+  distribution(y_greta) <- exponential_censored(
+    rate = rate,
+    is_censored = is_censored_greta,
+    censoring_type = "left",
+    lower = NULL,
+    upper = NULL,
+    dim = n
+  )
+
+  # Model fitting
+  m <- model(rate)
+  draws <- mcmc(m, n_samples = 1000)
+
+  # Output results
+  summary(draws)
+})
diff --git a/tests/testthat/test-gamma_censored.R b/tests/testthat/test-gamma_censored.R
new file mode 100644
index 0000000..0417bea
--- /dev/null
+++ b/tests/testthat/test-gamma_censored.R
@@ -0,0 +1,43 @@
+# Test script for gamma_censored distribution
+
+library(greta)
+library(testthat)
+
+test_that("gamma_censored distribution works correctly", {
+  # Simulate data
+  set.seed(101)
+  n <- 100
+  true_shape <- 2
+  true_rate <- 1
+  y <- rgamma(n, shape = true_shape, rate = true_rate)
+
+  # Introduce right censoring at y > 3
+  censoring_threshold <- 3
+  is_censored <- y > censoring_threshold
+  y_obs <- ifelse(is_censored, censoring_threshold, y)
+
+  # Data preparation
+  y_greta <- as_data(y_obs)
+  is_censored_greta <- as_data(as.numeric(is_censored))
+
+  # Define the model
+  shape <- variable(lower = 0)
+  rate <- variable(lower = 0)
+
+  distribution(y_greta) <- gamma_censored(
+    shape = shape,
+    rate = rate,
+    is_censored = is_censored_greta,
+    censoring_type = "right",
+    lower = NULL,
+    upper = NULL,
+    dim = n
+  )
+
+  # Model fitting
+  m <- model(shape, rate)
+  draws <- mcmc(m, n_samples = 1000)
+
+  # Output results
+  summary(draws)
+})
diff --git a/tests/testthat/test-lognormal_censored.R b/tests/testthat/test-lognormal_censored.R
new file mode 100644
index 0000000..6d9c6ef
--- /dev/null
+++ b/tests/testthat/test-lognormal_censored.R
@@ -0,0 +1,43 @@
+# Test script for lognormal_censored distribution
+
+library(greta)
+library(testthat)
+
+test_that("lognormal_censored distribution works correctly", {
+  # Simulate data
+  set.seed(456)
+  n <- 100
+  true_meanlog <- 0.5
+  true_sdlog <- 0.75
+  y <- rlnorm(n, meanlog = true_meanlog, sdlog = true_sdlog)
+
+  # Introduce left censoring at y < 1
+  censoring_threshold <- 1
+  is_censored <- y < censoring_threshold
+  y_obs <- ifelse(is_censored, censoring_threshold, y)
+
+  # Data preparation
+  y_greta <- as_data(y_obs)
+  is_censored_greta <- as_data(as.numeric(is_censored))
+
+  # Define the model
+  meanlog <- variable()
+  sdlog <- variable(lower = 0)
+
+  distribution(y_greta) <- lognormal_censored(
+    meanlog = meanlog,
+    sdlog = sdlog,
+    is_censored = is_censored_greta,
+    censoring_type = "left",
+    lower = NULL,
+    upper = NULL,
+    dim = n
+  )
+
+  # Model fitting
+  m <- model(meanlog, sdlog)
+  draws <- mcmc(m, n_samples = 1000)
+
+  # Output results
+  summary(draws)
+})
diff --git a/tests/testthat/test-normal_censored.R b/tests/testthat/test-normal_censored.R
new file mode 100644
index 0000000..439d5d8
--- /dev/null
+++ b/tests/testthat/test-normal_censored.R
@@ -0,0 +1,43 @@
+# Test script for normal_censored distribution
+
+library(greta)
+library(testthat)
+
+test_that("normal_censored distribution works correctly", {
+  # Simulate data
+  set.seed(123)
+  n <- 100
+  true_mean <- 2
+  true_sd <- 1
+  y <- rnorm(n, mean = true_mean, sd = true_sd)
+
+  # Introduce right censoring at y > 3
+  censoring_threshold <- 3
+  is_censored <- y > censoring_threshold
+  y_obs <- ifelse(is_censored, censoring_threshold, y)
+
+  # Data preparation
+  y_greta <- as_data(y_obs)
+  is_censored_greta <- as_data(as.numeric(is_censored))
+
+  # Define the model
+  mean <- variable()
+  sd <- variable(lower = 0)
+
+  distribution(y_greta) <- normal_censored(
+    mean = mean,
+    sd = sd,
+    is_censored = is_censored_greta,
+    censoring_type = "right",
+    lower = NULL,
+    upper = NULL,
+    dim = n
+  )
+
+  # Model fitting
+  m <- model(mean, sd)
+  draws <- mcmc(m, n_samples = 1000)
+
+  # Output results
+  summary(draws)
+})
diff --git a/tests/testthat/test-pareto_censored.R b/tests/testthat/test-pareto_censored.R
new file mode 100644
index 0000000..3eb1df3
--- /dev/null
+++ b/tests/testthat/test-pareto_censored.R
@@ -0,0 +1,44 @@
+# Test script for pareto_censored distribution
+
+library(greta)
+library(testthat)
+
+test_that("pareto_censored distribution works correctly", {
+  # Simulate data
+  set.seed(404)
+  n <- 100
+  true_scale <- 1
+  true_alpha <- 2.5
+  library(VGAM)  # For rpareto
+  y <- rpareto(n, scale = true_scale, shape = true_alpha)
+
+  # Introduce left censoring at y < 2
+  censoring_threshold <- 2
+  is_censored <- y < censoring_threshold
+  y_obs <- ifelse(is_censored, censoring_threshold, y)
+
+  # Data preparation
+  y_greta <- as_data(y_obs)
+  is_censored_greta <- as_data(as.numeric(is_censored))
+
+  # Define the model
+  scale <- variable(lower = 0)
+  alpha <- variable(lower = 0)
+
+  distribution(y_greta) <- pareto_censored(
+    scale = scale,
+    alpha = alpha,
+    is_censored = is_censored_greta,
+    censoring_type = "left",
+    lower = NULL,
+    upper = NULL,
+    dim = n
+  )
+
+  # Model fitting
+  m <- model(scale, alpha)
+  draws <- mcmc(m, n_samples = 1000)
+
+  # Output results
+  summary(draws)
+})
diff --git a/tests/testthat/test-student_censored.R b/tests/testthat/test-student_censored.R
new file mode 100644
index 0000000..0ba84e4
--- /dev/null
+++ b/tests/testthat/test-student_censored.R
@@ -0,0 +1,48 @@
+# Test script for student_censored distribution
+
+library(greta)
+library(testthat)
+
+test_that("student_censored distribution works correctly", {
+  # Simulate data
+  set.seed(789)
+  n <- 100
+  true_df <- 5
+  true_loc <- 0
+  true_scale <- 1
+  y <- rt(n, df = true_df) * true_scale + true_loc
+
+  # Introduce interval censoring between -1 and 1
+  lower_bound <- -1
+  upper_bound <- 1
+  is_censored <- y > lower_bound & y < upper_bound
+  y_obs <- y
+  y_obs[is_censored] <- NA  # Interval censored data
+
+  # Data preparation
+  y_greta <- as_data(ifelse(is.na(y_obs), 0, y_obs))  # Placeholder for censored data
+  is_censored_greta <- as_data(as.numeric(is_censored))
+
+  # Define the model
+  df <- variable(lower = 1)
+  loc <- variable()
+  scale <- variable(lower = 0)
+
+  distribution(y_greta) <- student_censored(
+    df = df,
+    loc = loc,
+    scale = scale,
+    is_censored = is_censored_greta,
+    censoring_type = "interval",
+    lower = lower_bound,
+    upper = upper_bound,
+    dim = n
+  )
+
+  # Model fitting
+  m <- model(df, loc, scale)
+  draws <- mcmc(m, n_samples = 1000)
+
+  # Output results
+  summary(draws)
+})
diff --git a/tests/testthat/test-weibull_censored.R b/tests/testthat/test-weibull_censored.R
new file mode 100644
index 0000000..60eb73b
--- /dev/null
+++ b/tests/testthat/test-weibull_censored.R
@@ -0,0 +1,43 @@
+# Test script for weibull_censored distribution
+
+library(greta)
+library(testthat)
+
+test_that("weibull_censored distribution works correctly", {
+  # Simulate data
+  set.seed(303)
+  n <- 100
+  true_shape <- 1.5
+  true_scale <- 1
+  y <- rweibull(n, shape = true_shape, scale = true_scale)
+
+  # Introduce right censoring at y > 2
+  censoring_threshold <- 2
+  is_censored <- y > censoring_threshold
+  y_obs <- ifelse(is_censored, censoring_threshold, y)
+
+  # Data preparation
+  y_greta <- as_data(y_obs)
+  is_censored_greta <- as_data(as.numeric(is_censored))
+
+  # Define the model
+  shape <- variable(lower = 0)
+  scale <- variable(lower = 0)
+
+  distribution(y_greta) <- weibull_censored(
+    shape = shape,
+    scale = scale,
+    is_censored = is_censored_greta,
+    censoring_type = "right",
+    lower = NULL,
+    upper = NULL,
+    dim = n
+  )
+
+  # Model fitting
+  m <- model(shape, scale)
+  draws <- mcmc(m, n_samples = 1000)
+
+  # Output results
+  summary(draws)
+})