diff --git a/R/estimators.R b/R/estimators.R index 0bc1f94..d4540d8 100644 --- a/R/estimators.R +++ b/R/estimators.R @@ -1,3 +1,4 @@ +# nocov start #' Statistics and Estimators of the adestr package #' #' The \code{\link{Statistic}} class is a parent class for the classes @@ -508,6 +509,9 @@ setMethod("get_stagewise_estimators", signature("IntervalEstimator", "DataDistri }) +# nocov end + + setClass("SampleMean", contains = "PointEstimator") #' @rdname PointEstimator-class #' @export @@ -705,6 +709,7 @@ rb2_kv <- function(smean1, smean2, n1, n2, mu, sigma, two_armed, preimage, vectorInterface = TRUE)$integral / denom } +# nocov start newrb2_kv <- function(smean, n1, n2, mu, sigma, two_armed, preimage, tol = getOption("adestr_tol_inner", default = .adestr_options[["adestr_tol_inner"]]), maxEval = getOption("adestr_maxEval_inner", default = .adestr_options[["adestr_maxEval_inner"]]), @@ -772,7 +777,7 @@ crb2_kv <- function(smean1, smean2, n1, n2, mu, sigma, two_armed, preimage, absError = absError, vectorInterface = TRUE)$integral / denom } - +# nocov end pseudorb2_kv <- function(design, smean1, smean2, n1, n2, mu, sigma, two_armed, tol = getOption("adestr_tol_inner", default = .adestr_options[["adestr_tol_inner"]]), maxEval = getOption("adestr_maxEval_inner", default = .adestr_options[["adestr_maxEval_inner"]]), @@ -939,7 +944,7 @@ adoptr_alpha_shifted_design_kv <- function(design, shiftc1f, shiftc1e, shiftc2){ } pr_es1 + pr_es2 } - +# nocov start setClass("LinearShiftRepeatedPValue", slots = c(wc1f="numeric", wc1e="numeric", wc2="numeric"), contains = "VirtualPValue") #' @rdname PValue-class #' @param wc1f slope of futility boundary change. @@ -973,6 +978,7 @@ rp2_kv <- function(design, smean1, smean2, n1, n2, sigma, two_armed, wc1f=0, wc1 shiftc1e = diff*wc1e, shiftc2 = diff*wc2) } +# nocov end p_ml <- function(design, smean, n, mu, sigma, two_armed, tol = getOption("adestr_tol_inner", default = .adestr_options[["adestr_tol_inner"]]), maxEval = getOption("adestr_maxEval_inner", default = .adestr_options[["adestr_maxEval_inner"]]), absError = getOption("adestr_absError_inner", default = .adestr_options[["adestr_absError_inner"]]), ...) { design <- TwoStageDesignWithCache(design) diff --git a/R/n2c2_helpers.R b/R/n2c2_helpers.R index 4dd7834..fbbc0c2 100644 --- a/R/n2c2_helpers.R +++ b/R/n2c2_helpers.R @@ -16,7 +16,7 @@ n2_preimage <- function(design, sigma = 1, two_armed = FALSE, smean_scale = FALS xs[i] <- zf } else{ sgn <- sign(ns[i] - ns[i-1L]) - if (sgn>0){ + if (sgn>0){ # nocov start root <- uniroot( function(x) { (ns[i] - 1L + sgn * .Machine$double.eps^.6) - n2_extrapol(design, x) @@ -24,7 +24,7 @@ n2_preimage <- function(design, sigma = 1, two_armed = FALSE, smean_scale = FALS c(x_candidates[csum[i-1L]], x_candidates[csum[i-1L]] + stepsize), tol = .Machine$double.eps^.6 ) - } else { + } else { # nocov end root <- uniroot( function(x) { (ns[i] + sgn * .Machine$double.eps^.6) - n2_extrapol(design, x) @@ -99,6 +99,8 @@ get_c2_extrapol_function <- function(design){ design@c2_pivots )) } + +# nocov start get_n2_extrapol_function <- function(design){ if (length(design@n2_pivots)>1){ h <- (design@c1e - design@c1f) / 2 @@ -110,3 +112,4 @@ get_n2_extrapol_function <- function(design){ return(\(x) design@n2_pivots) } } +# nocov end diff --git a/tests/testthat/test_dsmean.R b/tests/testthat/test_dsmean.R index ddcd4af..0b529c5 100644 --- a/tests/testthat/test_dsmean.R +++ b/tests/testthat/test_dsmean.R @@ -14,7 +14,22 @@ test_that("density of MLE sums up to one (normal distribution, one-armed)", tolerance=1e-2 ) }) - +test_that("density of MLE sums up to one (normal distribution, one-armed) (exact=TRUE)", + { + expect_equal( + dsmean( + Normal(two_armed = FALSE), + designad, + .x <- seq(-2, 2, .h <- .01), + 0, + 1, + exact = TRUE, + combine_components = TRUE + ) |> sum() * .h, + 1, + tolerance=1e-2 + ) + }) test_that("density of MLE sums up to one (t distribution, one-armed)", { @@ -33,6 +48,23 @@ test_that("density of MLE sums up to one (t distribution, one-armed)", ) }) +test_that("density of MLE sums up to one (t distribution, one-armed) (exact=TRUE)", + { + expect_equal( + dsmean( + Student(two_armed = FALSE), + designad, + .x <- seq(-2, 2, .h <- .001), + 0, + 1, + exact = TRUE, + combine_components = TRUE + ) |> sum() * .h, + 1, + tolerance = 1e-2 + ) + }) + test_that("density of MLE sums up to one (normal distribution, two-armed, treatment group)", { @@ -46,6 +78,18 @@ test_that("density of MLE sums up to one (normal distribution, two-armed, treatm tolerance = 1e-2) }) +test_that("density of MLE sums up to one (normal distribution, two-armed, treatment group) (exact=TRUE)", + { + expect_equal(dsmeanT(Normal(), + designad, + .x <- seq(-2, 2, .h <- .01), + 0, + 1, + exact = TRUE) |> sum() * .h, + 1, + tolerance = 1e-2) + }) + test_that("density of MLE sums up to one (t distribution, two-armed, treatment group)", { expect_equal(dsmeanT(Student(), @@ -58,7 +102,17 @@ test_that("density of MLE sums up to one (t distribution, two-armed, treatment g tolerance = 1e-2) }) - +test_that("density of MLE sums up to one (t distribution, two-armed, treatment group) (exact=TRUE)", + { + expect_equal(dsmeanT(Student(), + designad, + .x <- seq(-2, 2, .h <- .1), + 0, + 1, + exact = TRUE) |> sum()*.h, + 1, + tolerance = 1e-2) + }) diff --git a/tests/testthat/test_evaluate_estimator.R b/tests/testthat/test_evaluate_estimator.R index 2761488..bd5bfa2 100644 --- a/tests/testthat/test_evaluate_estimator.R +++ b/tests/testthat/test_evaluate_estimator.R @@ -16,6 +16,127 @@ test_that("MSE of sample mean can be calculated without error.", }) +test_that("evaluate_estimator works on lists without error.", + { + expect_error( + evaluate_estimator( + score = list(Bias(), Variance()), + estimator = SampleMean(), + data_distribution = Normal(), + design = designad, + mu = c(0.3), + sigma = 1, + exact = FALSE + ) + , + NA + ) + }) + + + +test_that("Bias of sample mean can be calculated without error.", + { + expect_error( + evaluate_estimator( + score = Bias(), + estimator = SampleMean(), + data_distribution = Normal(), + design = designad, + mu = c(0.3), + sigma = 1, + exact = FALSE + ) + , + NA + ) + }) + +test_that("Coverage of NaiveCI can be calculated without error.", + { + expect_error( + evaluate_estimator( + score = Coverage(), + estimator = NaiveCI(), + data_distribution = Normal(), + design = designad, + mu = c(0.3), + sigma = 1, + exact = FALSE + ) + , + NA + ) + expect_error( + evaluate_estimator( + score = SoftCoverage(), + estimator = NaiveCI(), + data_distribution = Normal(), + design = designad, + mu = c(0.3), + sigma = 1, + exact = FALSE + ) + , + NA + ) + }) + + + +test_that("TestAgreement of NaiveCI can be calculated", + { + expect_lt( + evaluate_estimator( + score = TestAgreement(), + estimator = NaiveCI(), + data_distribution = Normal(), + design = designad, + mu = c(0.3), + sigma = 1, + exact = FALSE + )@results$`Agreement with test decision` + , + 1 + ) + }) + +test_that("TestAgreement of NaivePValue can be calculated", + { + expect_lt( + evaluate_estimator( + score = TestAgreement(), + estimator = NaivePValue(), + data_distribution = Normal(), + design = designad, + mu = c(0.3), + sigma = 1, + exact = FALSE + )@results$`Agreement with test decision` + , + 1 + ) + }) + + +test_that("Centrality of SampleMean wrt. NaiveCI can be calculated", + { + expect_equal( + evaluate_estimator( + score = Centrality(interval = NaiveCI()), + estimator = SampleMean(), + data_distribution = Normal(), + design = designad, + mu = c(0.3), + sigma = 1, + exact = FALSE + )@results$Centrality + , + 0 + ) + }) + + diff --git a/tests/testthat/test_integrals.R b/tests/testthat/test_integrals.R index 3fc2a2a..dd4795e 100644 --- a/tests/testthat/test_integrals.R +++ b/tests/testthat/test_integrals.R @@ -11,6 +11,20 @@ test_that("integral over sample space is equal to 1 for case: known variance, on tolerance=1e-5 ) }) +test_that("integral over sample space is equal to 1 for case: known variance, one-armed (exact=TRUE)", + { + expect_equal( + int_kv( + design = designad, + mu = .3, + sigma = 2.1, + two_armed = FALSE, + exact = TRUE + )$overall_integral$integral, + 1, + tolerance=1e-5 + ) + }) test_that("integral over sample space is equal to 1 for case: unknown variance, one-armed", { expect_equal( @@ -23,6 +37,19 @@ test_that("integral over sample space is equal to 1 for case: unknown variance, tolerance=1e-3 ) }) +test_that("integral over sample space is equal to 1 for case: unknown variance, one-armed (exact=TRUE)", + { + expect_equal( + int_uv( + design = designad, + mu = 0.3, + sigma = 2.1, + two_armed = FALSE, + exact=TRUE)$overall_integral$integral, + 1, + tolerance=1e-3 + ) + }) test_that("integral over sample space is equal to 1 for case: known variance, two-armed", { expect_equal( @@ -35,6 +62,19 @@ test_that("integral over sample space is equal to 1 for case: known variance, tw tolerance=1e-5 ) }) +test_that("integral over sample space is equal to 1 for case: known variance, two-armed (exact=TRUE)", + { + expect_equal( + int_kv( + design = designad, + mu = .3, + sigma = 2.1, + two_armed = TRUE, + exact=TRUE)$overall_integral$integral, + 1, + tolerance=1e-5 + ) + }) test_that("integral over sample space is equal to 1 for case: unknown variance, two-armed", { expect_equal( @@ -47,6 +87,19 @@ test_that("integral over sample space is equal to 1 for case: unknown variance, tolerance=1e-5 ) }) +test_that("integral over sample space is equal to 1 for case: unknown variance, two-armed (exact=TRUE)", + { + expect_equal( + int_uv( + design = designad, + mu = .3, + sigma = 2.1, + two_armed = TRUE, + exact=TRUE)$overall_integral$integral, + 1, + tolerance=1e-5 + ) + }) test_that("integral over sample space is equal to 1 for case: known variance, two-armed, full sampling distribution", { expect_equal( @@ -58,6 +111,18 @@ test_that("integral over sample space is equal to 1 for case: known variance, tw tolerance=1e-5 ) }) +test_that("integral over sample space is equal to 1 for case: known variance, two-armed, full sampling distribution (exact=TRUE)", + { + expect_equal( + int_kv_full( + design = designad, + mu = .3, + sigma = 2.1, + exact=TRUE)$overall_integral$integral, + 1, + tolerance=1e-5 + ) + }) test_that("integral over sample space is equal to 1 for case: unknown variance, two-armed, full sampling distribution", { expect_equal( diff --git a/tests/testthat/test_prior_integral.R b/tests/testthat/test_prior_integral.R index fbc7c74..cdc9375 100644 --- a/tests/testthat/test_prior_integral.R +++ b/tests/testthat/test_prior_integral.R @@ -46,6 +46,15 @@ test_that("Calculating MSE wrt. a non-degenerate-prior is roughly the same as wr } ) +test_that("get_pdf works.", +{ + expect_equal( + get_pdf(NormalPrior())(0), dnorm(0) + ) + expect_equal( + get_pdf(UniformPrior())(0), dunif(0, min=-1, max=1) + ) +})