From d92bde1634ad7090013c873ac02c8bb545609c4e Mon Sep 17 00:00:00 2001 From: unknown Date: Sat, 18 Nov 2023 12:05:04 +0100 Subject: [PATCH] tests anova should be complete --- R/FDistribution.R | 6 +- man/ANOVA-class.Rd | 14 ++- man/BinomialDataDistribution-class.Rd | 11 +-- man/ChiSquaredDataDistribution-class.Rd | 6 +- man/NestedModels-class.Rd | 12 +++ man/Pearson2xK-class.Rd | 2 +- man/ZSquared-class.Rd | 3 +- man/cumulative_distribution_function.Rd | 12 +-- man/probability_density_function.Rd | 12 +-- tests/testthat/test_ANOVA.R | 115 ++++++++++++++++++++++++ tests/testthat/test_ChiSquared.R | 2 +- 11 files changed, 156 insertions(+), 39 deletions(-) diff --git a/R/FDistribution.R b/R/FDistribution.R index 274ef438..aeeed322 100644 --- a/R/FDistribution.R +++ b/R/FDistribution.R @@ -19,7 +19,7 @@ #' @exportClass NestedModels setClass("NestedModels", representation( p_inner = "numeric", - p_outer = "numeric"), + p_outer = "numeric"), contains = "DataDistribution") @@ -73,6 +73,8 @@ NestedModels <- function(p_inner, p_outer) { #' @rdname ANOVA-class #' @export ANOVA <- function(n_groups) { + if (n_groups < 0 || abs(n_groups - round(n_groups)) > sqrt(.Machine$double.eps)) + stop("The number of groups must be a natural number.") new("ANOVA", p_outer = n_groups, p_inner = 1L) } @@ -158,7 +160,7 @@ setMethod("simulate", signature("NestedModels", "numeric"), setMethod("print", signature('NestedModels'), function(x, ...) { glue::glue( - "{class(x)[1]}" + "{class(x)[1]}" ) }) diff --git a/man/ANOVA-class.Rd b/man/ANOVA-class.Rd index f40441f8..820bdb16 100644 --- a/man/ANOVA-class.Rd +++ b/man/ANOVA-class.Rd @@ -4,20 +4,32 @@ \name{ANOVA-class} \alias{ANOVA-class} \alias{ANOVA} +\alias{get_tau_ANOVA} \title{Analysis of Variance} \usage{ ANOVA(n_groups) + +get_tau_ANOVA(means, common_sd = 1) } \arguments{ \item{n_groups}{number of groups to be compared} + +\item{means}{vector denoting the mean per group} + +\item{common_sd}{standard deviation of the groups} } \description{ ANOVA is used to test whether there is a significant difference between the means of groups. -The sample size which \code{adoptr} returns is the total sample size, +The sample size which \code{adoptr} returns is the group wise sample size. +The function \code{get_tau_ANOVA} is used to obtain a parameter \eqn{\tau}, +which is used in the same way as \eqn{\theta} to describe the difference of +means between the groups. } \examples{ model <- ANOVA(3L) +H1 <- PointMassPrior(get_tau_ANOVA(c(0.4, 0.8, 0.5)), 1) + } \seealso{ see \code{\link{probability_density_function}} and diff --git a/man/BinomialDataDistribution-class.Rd b/man/BinomialDataDistribution-class.Rd index 58ddd176..d6059ba2 100644 --- a/man/BinomialDataDistribution-class.Rd +++ b/man/BinomialDataDistribution-class.Rd @@ -1,13 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/BinomialDistribution.R, R/FDistribution.R +% Please edit documentation in R/BinomialDistribution.R \docType{class} \name{Binomial-class} \alias{Binomial-class} \alias{Binomial} \alias{quantile,Binomial-method} \alias{simulate,Binomial,numeric-method} -\alias{quantile,NestedModels-method} -\alias{simulate,NestedModels,numeric-method} \title{Binomial data distribution} \usage{ Binomial(rate_control, two_armed = TRUE) @@ -15,10 +13,6 @@ Binomial(rate_control, two_armed = TRUE) \S4method{quantile}{Binomial}(x, probs, n, theta, ...) \S4method{simulate}{Binomial,numeric}(object, nsim, n, theta, seed = NULL, ...) - -\S4method{quantile}{NestedModels}(x, probs, n, theta, ...) - -\S4method{simulate}{NestedModels,numeric}(object, nsim, n, theta, seed = NULL, ...) } \arguments{ \item{rate_control}{assumed response rate in control group} @@ -62,9 +56,6 @@ All priors have to be defined for the rate difference \ifelse{html}{\out{rE - rC}}{\eqn{r_E - r_C}}. } \details{ -Note that \code{simulate} for class \code{Binomial} simulates the - normal approximation of the test statistic. - Note that \code{simulate} for class \code{Binomial} simulates the normal approximation of the test statistic. } diff --git a/man/ChiSquaredDataDistribution-class.Rd b/man/ChiSquaredDataDistribution-class.Rd index 121d3435..3bf9c1f2 100644 --- a/man/ChiSquaredDataDistribution-class.Rd +++ b/man/ChiSquaredDataDistribution-class.Rd @@ -27,7 +27,7 @@ ChiSquared(df, multiplier = 1) \item{...}{further optional arguments} -\item{object}{object of class \code{Binomial}} +\item{object}{object of class \code{ChiSquared}} \item{nsim}{number of simulation runs} @@ -43,10 +43,6 @@ alternative is that there exists a pair of groups with differing rates. \code{ZSquared} implements the square of a normally distributed random variable with mean \eqn{\mu} and standard deviation \eqn{\sigma^2}. } -\details{ -Note that \code{simulate} for class \code{ChiSquared} simulates the - normal approximation of the test statistic. -} \examples{ datadist <- ChiSquared(df=4) diff --git a/man/NestedModels-class.Rd b/man/NestedModels-class.Rd index 9a26ff19..dee1e36e 100644 --- a/man/NestedModels-class.Rd +++ b/man/NestedModels-class.Rd @@ -4,9 +4,15 @@ \name{NestedModels-class} \alias{NestedModels-class} \alias{NestedModels} +\alias{quantile,NestedModels-method} +\alias{simulate,NestedModels,numeric-method} \title{F-Distribution} \usage{ NestedModels(p_inner, p_outer) + +\S4method{quantile}{NestedModels}(x, probs, n, theta, ...) + +\S4method{simulate}{NestedModels,numeric}(object, nsim, n, theta, seed = NULL, ...) } \arguments{ \item{p_inner}{number of independent variables in smaller model} @@ -20,6 +26,12 @@ NestedModels(p_inner, p_outer) \item{theta}{distribution parameter} \item{...}{further optional arguments} + +\item{object}{object of class \code{NestedModels}} + +\item{nsim}{number of simulation runs} + +\item{seed}{random seed} } \description{ Implements the F-distribution used for an ANOVA or for the comparison of the fit of two diff --git a/man/Pearson2xK-class.Rd b/man/Pearson2xK-class.Rd index 3f152214..4ddd96c5 100644 --- a/man/Pearson2xK-class.Rd +++ b/man/Pearson2xK-class.Rd @@ -20,7 +20,7 @@ get_tau_Pearson2xK(p_vector) When we test for homogeneity of rates in a k-armed trial with binary endpoints, the test statistic is chi-squared distributed with \eqn{k-1} degrees of freedom under the null. Under the alternative, the statistic is chi-squared distributed with a non-centrality parameter \eqn{\lambda}. The function \code{get_tau_Pearson2xk} then computes \eqn{\tau}, such that \eqn{\lambda} is given -as \eqn{n/k \cdot \tau}, where \eqn{n} is the number of subjects per group. In \code{adoptr}, \eqn{\tau} is used in the same way as \eqn{\theta} +as \eqn{n \cdot \tau}, where \eqn{n} is the number of subjects per group. In \code{adoptr}, \eqn{\tau} is used in the same way as \eqn{\theta} in the case of the normally distributed test statistic. } \examples{ diff --git a/man/ZSquared-class.Rd b/man/ZSquared-class.Rd index 9a0fda51..ab314544 100644 --- a/man/ZSquared-class.Rd +++ b/man/ZSquared-class.Rd @@ -12,7 +12,7 @@ ZSquared(two_armed = TRUE) get_tau_ZSquared(mu, sigma = 1) } \arguments{ -\item{two_armed}{logical indicating if a two-aremd trial is regarded} +\item{two_armed}{logical indicating if a two-armed trial is regarded} \item{mu}{mean of Z} @@ -23,6 +23,7 @@ Implementation of \eqn{Z^2}, where \eqn{Z} is normally distributed with mean \eq \eqn{\sigma^2}. \eqn{Z^2} is chi-squared distributed with \eqn{1} degree of freedom and non-centrality parameter \eqn{(\mu/\sigma)^2}. The function \code{get_tau_ZSquared} computes the factor \eqn{\tau=(\mu/\sigma)^2}, such that \eqn{\tau} is the equivalent of \eqn{\theta} in the normally distributed case. +The square of a normal distribution \eqn{Z^2} can be used for two-sided hypothesis testing. } \examples{ zsquared <- ZSquared(FALSE) diff --git a/man/cumulative_distribution_function.Rd b/man/cumulative_distribution_function.Rd index b6ed7fa9..13a66dc7 100644 --- a/man/cumulative_distribution_function.Rd +++ b/man/cumulative_distribution_function.Rd @@ -48,12 +48,6 @@ If the distribution is \code{\link{Binomial}}, Then, the mean is assumed to be \ifelse{html}{\out{√ n theta}}{\eqn{\sqrt{n} theta}}. -If the distribution is \code{\link{Binomial}}, - \ifelse{html}{\out{theta}}{\eqn{theta}} denotes the rate difference between - intervention and control group. - Then, the mean is assumed to be - \ifelse{html}{\out{√ n theta}}{\eqn{\sqrt{n} theta}}. - If the distribution is \code{\link{Normal}}, then the mean is assumed to be \ifelse{html}{\out{√ n theta}}{\eqn{\sqrt{n} theta}}. @@ -61,11 +55,11 @@ If the distribution is \code{\link{Normal}}, then \examples{ cumulative_distribution_function(Binomial(.1, TRUE), 1, 50, .3) -cumulative_distribution_function(Pearson2xK(3),1,30,get_tau_Pearson2xK(c(0.3,0.4,0.7,0.2))) -cumulative_distribution_function(ZSquared(4),1,35,get_tau_ZSquared(0.4)) +cumulative_distribution_function(Pearson2xK(3), 1, 30, get_tau_Pearson2xK(c(0.3,0.4,0.7,0.2))) +cumulative_distribution_function(ZSquared(4), 1, 35, get_tau_ZSquared(0.4)) -cumulative_distribution_function(Binomial(.1, TRUE), 1, 50, .3) +probability_density_function(ANOVA(3), 1, 30, get_tau_ANOVA(c(0.3, 0.4, 0.7, 0.2))) cumulative_distribution_function(Normal(), 1, 50, .3) diff --git a/man/probability_density_function.Rd b/man/probability_density_function.Rd index 081ad551..21f5f69e 100644 --- a/man/probability_density_function.Rd +++ b/man/probability_density_function.Rd @@ -48,12 +48,6 @@ If the distribution is \code{\link{Binomial}}, Then, the mean is assumed to be \ifelse{html}{\out{√ n theta}}{\eqn{\sqrt{n} theta}}. -If the distribution is \code{\link{Binomial}}, - \ifelse{html}{\out{theta}}{\eqn{theta}} denotes the rate difference between - intervention and control group. - Then, the mean is assumed to be - \ifelse{html}{\out{√ n theta}}{\eqn{\sqrt{n} theta}}. - If the distribution is \code{\link{Normal}}, then the mean is assumed to be \ifelse{html}{\out{√ n theta}}{\eqn{\sqrt{n} theta}}. @@ -61,11 +55,11 @@ If the distribution is \code{\link{Normal}}, then \examples{ probability_density_function(Binomial(.2, FALSE), 1, 50, .3) -probability_density_function(Pearson2xK(3),1,30,get_tau_Pearson2xK(c(0.3,0.4,0.7,0.2))) -probability_density_function(ZSquared(4),1,35,get_tau_ZSquared(0.4)) +probability_density_function(Pearson2xK(3), 1, 30, get_tau_Pearson2xK(c(0.3, 0.4, 0.7, 0.2))) +probability_density_function(ZSquared(4), 1, 35, get_tau_ZSquared(0.4)) -probability_density_function(Binomial(.2, FALSE), 1, 50, .3) +probability_density_function(ANOVA(3), 1, 30, get_tau_ANOVA(c(0.3, 0.4, 0.7, 0.2))) probability_density_function(Normal(), 1, 50, .3) diff --git a/tests/testthat/test_ANOVA.R b/tests/testthat/test_ANOVA.R index 388fb785..590eb9a5 100644 --- a/tests/testthat/test_ANOVA.R +++ b/tests/testthat/test_ANOVA.R @@ -1,2 +1,117 @@ context("F-distribution") +test_that("Constructors work", { + + expect_true( + NestedModels(4, 5)@p_inner == 4 & + NestedModels(4, 5)@p_outer ==5 + ) + + expect_true( + ANOVA(6)@p_inner == 1 & + ANOVA(6)@p_outer == 6 + ) + + expect_error( + NestedModels(2.3, 1) + ) + + expect_error( + NestedModels(2, -1) + ) + + expect_error( + ANOVA(3.4) + ) + + expect_error( + ANOVA(-6) + ) +}) + +test_that("thetas and ncps are correctly computed", { + + + # ANOVA + p_vec <- c(0.8, 0.15, 0.3, 0.96) + n <- 52 + sigma <- 2 + dist <- ANOVA(length(p_vec)) + + real_ncp <- n * (sum((p_vec - mean(p_vec))^2)) / sigma^2 + ncp_calc <- (n * (dist@p_outer - dist@p_inner + 1)) * get_tau_ANOVA(p_vec, sigma) + + expect_equal( + real_ncp, ncp_calc + ) + +}) + +test_that("pdf is defined correctly", { + + dist <- ANOVA(3) + x <- seq(0.1, 5, by = 0.1) + n <- 42 + p_vec <- c(0.3, 0.4, 0.5) + theta <- get_tau_ANOVA(p_vec) + real_ncp <- n * (sum((p_vec - mean(p_vec))^2)) + expect_equal( + probability_density_function(dist, x, n, theta), + stats::df(x, 2, 3 * n - 3, ncp = real_ncp) + ) + +}) + +test_that("cdf is defined correctly", { + + dist <- ANOVA(3) + x <- seq(0.1, 5, by = 0.1) + n <- 32 + p_vec <- c(0.2, 0.4, 0.5) + theta <- get_tau_ANOVA(p_vec) + real_ncp <- n * (sum((p_vec - mean(p_vec))^2)) + expect_equal( + cumulative_distribution_function(dist, x, n, theta), + stats::pf(x, 2, 3 * n - 3, ncp = real_ncp) + ) +}) + +test_that("quantile is defined correctly", { + + dist <- ANOVA(4) + x <- seq(0.1, 5, by = 0.1) + n <- 22 + p_vec <- c(0.2, 0.4, 0.7, 0.36) + theta <- get_tau_ANOVA(p_vec) + real_ncp <- n * (sum((p_vec - mean(p_vec))^2)) + expect_equal( + cumulative_distribution_function(dist, x, n, theta), + stats::pf(x, 3, 4 * n - 4, ncp = real_ncp) + ) +}) + +test_that("simulate respects seed", { + + expect_equal( + simulate(ANOVA(3), 10, 10, 0.2, seed = 42), + simulate(ANOVA(3), 10, 10, 0.2, seed = 42), + tolerance = 1e-6, scale = 1) + + set.seed(42) + + expect_true( + all(simulate(ANOVA(4), 10, 12, 1.1) != simulate(ANOVA(4), 10, 12, 1.1))) +}) + +test_that("show_method", { + + expect_equal( + capture.output(show(NestedModels(4, 5))), + "NestedModels " + ) + + expect_equal( + capture.output(show(ANOVA(4))), + "ANOVA " + ) +}) diff --git a/tests/testthat/test_ChiSquared.R b/tests/testthat/test_ChiSquared.R index 5b7ff750..cea72678 100644 --- a/tests/testthat/test_ChiSquared.R +++ b/tests/testthat/test_ChiSquared.R @@ -39,7 +39,7 @@ test_that('constructors work', { ) }) -test_that('thetas are correctly computed', { +test_that('thetas and ncps are correctly computed', { # theoretical ncp and calculated ncp are equal # Pearson2xK