Address comments

R/decision1S.R

@@ -1,6 +1,6 @@
 #' Decision Function for 1 Sample Designs
 #'
-#' The function sets up a 1 sample one-sided decision function with an
+#' The function sets up a 1 sample decision function with an
 #' arbitrary number of conditions.
 #'
 #' @param pc Vector of critical cumulative probabilities.
@@ -28,7 +28,7 @@
 #'
 #' \deqn{\Pi_i H_i(P(\theta \leq q_{c,i}) - p_{c,i} ).}
 #'
-#' For the case of a boolen vector given to `lower.tail` the
+#' For the case of a boolean vector given to `lower.tail` the
 #' direction of each decision aligns respectively, and a two-sided
 #' decision function is created.
 #'
@@ -133,9 +133,9 @@
 #'
 #' @export
 decision1S <- function(pc = 0.975, qc = 0, lower.tail = TRUE) {
-  assert_numeric(pc)
-  assert_numeric(qc, len = length(pc))
-  assert_logical(lower.tail)
+  assert_numeric(pc, lower = 0, upper = 1, any.missing = FALSE, finite = TRUE)
+  assert_numeric(qc, len = length(pc), any.missing = FALSE)
+  assert_logical(lower.tail, any.missing = FALSE)
   assert_true(length(lower.tail) == 1L || length(lower.tail) == length(pc))
   lower.tail <- scalar_if_same(lower.tail)
 
@@ -182,6 +182,7 @@ create_decision1S_1sided <- function(pc, qc, lower.tail) {
 
   atomic_fun <- create_decision1S_atomic(pc, qc, lower.tail)
   attr_name <- if (lower.tail) "lower" else "upper"
+  attr_compl_name <- if (lower.tail) "upper" else "lower"
 
   fun <- function(mix, dist = FALSE) {
     test <- atomic_fun(mix, dist)
@@ -192,6 +193,9 @@ create_decision1S_1sided <- function(pc, qc, lower.tail) {
     test
   }
   attr(fun, attr_name) <- atomic_fun
+  attr(fun, attr_compl_name) <- function(mix, ...) {
+    return(TRUE)
+  }
   attr(fun, "lower.tail") <- lower.tail
 
   class(fun) <- c("decision1S", "decision1S_1sided", "function")

R/decision2S.R

@@ -1,6 +1,6 @@
 #' Decision Function for 2 Sample Designs
 #'
-#' The function sets up a 2 sample one-sided decision function with an
+#' The function sets up a 2 sample decision function with an
 #' arbitrary number of conditions on the difference distribution.
 #'
 #' @param pc Vector of critical cumulative probabilities of the
@@ -35,7 +35,7 @@
 #' otherwise. For `lower.tail=FALSE` differences must be greater
 #' than the given quantiles `qc`.
 #'
-#' For the case of a boolen vector given to `lower.tail` the
+#' For the case of a boolean vector given to `lower.tail` the
 #' direction of each decision aligns respectively, and a two-sided
 #' decision function is created.
 #'
@@ -140,9 +140,9 @@ decision2S <- function(
   lower.tail = TRUE,
   link = c("identity", "logit", "log")
 ) {
-  assert_numeric(pc)
-  assert_numeric(qc, len = length(pc))
-  assert_logical(lower.tail)
+  assert_numeric(pc, lower = 0, upper = 1, any.missing = FALSE, finite = TRUE)
+  assert_numeric(qc, len = length(pc), any.missing = FALSE)
+  assert_logical(lower.tail, any.missing = FALSE)
   assert_true(length(lower.tail) == 1L || length(lower.tail) == length(pc))
   lower.tail <- scalar_if_same(lower.tail)
   link <- match.arg(link)
@@ -198,6 +198,7 @@ create_decision2S_1sided <- function(pc, qc, lower.tail, link) {
 
   atomic_fun <- create_decision2S_atomic(pc, qc, lower.tail, link)
   attr_name <- if (lower.tail) "lower" else "upper"
+  attr_compl_name <- if (lower.tail) "upper" else "lower"
 
   fun <- function(mix1, mix2, dist = FALSE) {
     test <- atomic_fun(mix1, mix2, dist)
@@ -208,6 +209,9 @@ create_decision2S_1sided <- function(pc, qc, lower.tail, link) {
     test
   }
   attr(fun, attr_name) <- atomic_fun
+  attr(fun, attr_compl_name) <- function(mix1, mix2, ...) {
+    return(TRUE)
+  }
   attr(fun, "link") <- link
   attr(fun, "lower.tail") <- lower.tail
   class(fun) <- c("decision2S", "decision2S_1sided", "function")

tests/testthat/test-decision1S.R

@@ -8,6 +8,9 @@ test_that("decision1S works for lower sided", {
   expect_true(has_lower(dec))
   expect_false(has_upper(dec))
 
+  # Complementary attribute is still present for consistency:
+  expect_function(attr(dec, "upper"))
+
   expect_class(dec, c("decision1S", "decision1S_1sided", "function"))
   expect_class(lower(dec), c("decision1S_atomic", "function"))
 
@@ -30,6 +33,9 @@ test_that("decision1S works for upper sided", {
   expect_false(has_lower(dec))
   expect_true(has_upper(dec))
 
+  # Complementary attribute is still present for consistency:
+  expect_function(attr(dec, "lower"))
+
   expect_class(dec, c("decision1S", "decision1S_1sided", "function"))
   expect_class(upper(dec), c("decision1S_atomic", "function"))
 

tests/testthat/test-decision2S.R

@@ -8,6 +8,9 @@ test_that("decision2S works for lower sided", {
   expect_true(has_lower(decLower))
   expect_false(has_upper(decLower))
 
+  # Complementary attribute is still present for consistency:
+  expect_function(attr(decLower, "upper"))
+
   expect_class(decLower, c("decision2S", "decision2S_1sided", "function"))
   expect_class(lower(decLower), c("decision2S_atomic", "function"))
 
@@ -34,6 +37,9 @@ test_that("decision2S works for upper sided", {
   expect_false(has_lower(decUpper))
   expect_true(has_upper(decUpper))
 
+  # Complementary attribute is still present for consistency:
+  expect_function(attr(decUpper, "lower"))
+
   expect_class(decUpper, c("decision2S", "decision2S_1sided", "function"))
   expect_class(upper(decUpper), c("decision2S_atomic", "function"))