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) +})