removed examples for non exported functions for CRAN + more tests

NEWS.md

@@ -1,6 +1,8 @@
-# brmsmargins devel
+# brmsmargins 0.1.1
 
 * Fixed a bug preventing predictions integrating out random effects for mixed effects models with a random intercept only (reported in Issue#1). Thanks to @ajnafa for reporting.
+* Added support for Gamma and Beta regression models.
+* More extensive testing added.
 
 # brmsmargins 0.1.0
 

R/builders.R

@@ -34,9 +34,6 @@ utils::globalVariables(c("Block", "Row", "Col"))
 
 #' @rdname builders
 #' @importFrom data.table as.data.table
-#' @examples
-#' brmsmargins:::.namesL(1, 3)
-#' brmsmargins:::tab2matR(matrix(brmsmargins:::.namesL(1, 3), 1))
 .namesL <- function(block, number) {
   n <- expand.grid(Block = block,
                    Row = seq_len(number),
@@ -87,8 +84,6 @@ utils::globalVariables(c("group", "coef", "id"))
 utils::globalVariables(c("Number"))
 
 #' @rdname builders
-#' @examples
-#' brmsmargins:::.namesZ(1, 3, NULL)
 .namesZ <- function(block, number, dpar) {
   n <- expand.grid(Block = block,
                    Number = seq_len(number))

R/utils.R

@@ -19,17 +19,19 @@
 #'   exact window used in human readable format.
 #' @keywords internal
 #' @importFrom extraoperators %e%
-#' @examples
-#' brmsmargins:::.percent(1:10, window = NULL)
-#' brmsmargins:::.percent(1:10, window = c(3, 5))
-#' brmsmargins:::.percent(1:10, window = c(2, 6), within = FALSE)
 .percent <- function(x, window = NULL, within = TRUE) {
   if (isTRUE(is.null(window))) {
     window <- NA_real_
     pi <- NA_real_
     lab <- NA_character_
   } else {
-    stopifnot(isTRUE(is.numeric(window)) && identical(length(window), 2L))
+    if (isFALSE(isTRUE(is.numeric(window)) &&
+                  isTRUE(identical(length(window), 2L)))) {
+      stop(sprintf("window must be a numeric vector with length 2, but found a %s vector of length %d",
+                   paste(class(window), collapse = "; "), length(window)))
+    }
+
+    window <- as.numeric(window)
     if (isTRUE(within)) {
       lab <- sprintf("[%s, %s]",
                      as.character(min(window)),
@@ -98,28 +100,32 @@
 #' @importFrom stats median
 #' @references
 #' Kruschke, J. K. (2018).
-#' \doi{10.1177/2F2515245918771304}
+#' \doi{10.1177/2515245918771304}
 #' \dQuote{Rejecting or accepting parameter values in Bayesian estimation}
 #' @examples
 #'
 #' bsummary(rnorm(1000))
 #'
 #' bsummary(rnorm(1000), ROPE = c(-.5, .5), MID = c(-1, 1))
 bsummary <- function(x, CI = 0.99, CIType = "HDI", ROPE = NULL, MID = NULL) {
+  if (isFALSE(is.numeric(x))) {
+    stop(sprintf("to be summarized x must be numeric, but %s class was found",
+         paste(class(x), collapse = "; ")))
+  }
   ropes <- .percent(x, window = ROPE, within = TRUE)
   mids <- .percent(x, window = MID, within = FALSE)
 
   m <- mean(x, na.rm = TRUE)
   mdn <- median(x, na.rm = TRUE)
   cis <- bayestestR::ci(x, ci = CI, method = CIType)
   out <- data.table(
-    M = m,
-    Mdn = mdn,
-    LL = cis$CI_low,
-    UL = cis$CI_high,
-    PercentROPE = ropes$Percent,
-    PercentMID = mids$Percent,
-    CI = CI,
+    M = as.numeric(m),
+    Mdn = as.numeric(mdn),
+    LL = as.numeric(cis$CI_low),
+    UL = as.numeric(cis$CI_high),
+    PercentROPE = as.numeric(ropes$Percent),
+    PercentMID = as.numeric(mids$Percent),
+    CI = as.numeric(CI),
     CIType = CIType,
     ROPE = ropes$Label,
     MID = mids$Label)

tests/testthat/test-bsummary.R

@@ -0,0 +1,59 @@
+test_that("bsummary errors if invalid input", {
+  expect_error(bsummary(letters[1:5]))
+})
+
+test_that("bsummary works", {
+  x <- bsummary(1:100)
+
+  ## check types
+  expect_s3_class(x, "data.table")
+  expect_type(x$M, "double")
+  expect_type(x$Mdn, "double")
+  expect_type(x$LL, "double")
+  expect_type(x$UL, "double")
+  expect_type(x$PercentROPE, "double")
+  expect_type(x$PercentMID, "double")
+  expect_type(x$CI, "double")
+  expect_type(x$CIType, "character")
+  expect_type(x$ROPE, "character")
+  expect_type(x$MID, "character")
+
+  ## check values
+  expect_equal(x$M, 50.5)
+  expect_equal(x$Mdn, 50.5)
+  expect_equal(x$LL, 1)
+  expect_equal(x$UL, 100)
+  expect_equal(x$PercentROPE, NA_real_)
+  expect_equal(x$PercentMID, NA_real_)
+  expect_equal(x$CI, 0.99)
+  expect_equal(x$CIType, "HDI")
+  expect_equal(x$ROPE, NA_character_)
+  expect_equal(x$MID, NA_character_)
+})
+
+test_that("bsummary works with ROPEs and MIDs", {
+  x <- bsummary((-50:60) / 100, ROPE = c(-.5, .5), MID = c(-1, 1))
+
+  ## check types
+  expect_s3_class(x, "data.table")
+  expect_type(x$M, "double")
+  expect_type(x$Mdn, "double")
+  expect_type(x$LL, "double")
+  expect_type(x$UL, "double")
+  expect_type(x$PercentROPE, "double")
+  expect_type(x$PercentMID, "double")
+  expect_type(x$CI, "double")
+  expect_type(x$CIType, "character")
+  expect_type(x$ROPE, "character")
+  expect_type(x$MID, "character")
+
+  ## check values
+  expect_equal(x$M, 0.05)
+  expect_equal(x$Mdn, 0.05)
+  expect_true(x$PercentROPE > 50)
+  expect_equal(x$PercentMID, 0)
+  expect_equal(x$CI, 0.99)
+  expect_equal(x$CIType, "HDI")
+  expect_equal(x$ROPE, "[-0.5, 0.5]")
+  expect_equal(x$MID, "[-Inf, -1] | [1, Inf]")
+})

tests/testthat/test-builders.R

@@ -0,0 +1,16 @@
+test_that(".namesL creates proper names that can be converted to a matrix", {
+  expect_equal(
+    brmsmargins:::.namesL(1, 1),
+    "L_1[1,1]")
+
+  expect_equal(
+    dim(brmsmargins:::tab2matR(
+      matrix(brmsmargins:::.namesL(1, 3), 1))),
+    c(3L, 3L))
+})
+
+test_that(".namesZ creates proper names", {
+  expect_equal(
+    brmsmargins:::.namesZ(1, 3, NULL),
+    c("Z_1_1", "Z_1_2", "Z_1_3"))
+})

tests/testthat/test-dot-checktab.R

@@ -0,0 +1,11 @@
+test_that(".checktab returns a non zero character string if invalid input", {
+  x <- brmsmargins:::.checktab(1:5)
+  expect_type(x, "character")
+  expect_true(nzchar(x))
+})
+
+test_that(".checktab returns an empty character string if invalid input", {
+  x <- brmsmargins:::.checktab(mtcars)
+  expect_type(x, "character")
+  expect_false(nzchar(x))
+})

tests/testthat/test-dot-links.R

@@ -0,0 +1,59 @@
+test_that(".links returns correct values with identity link and fixedonly", {
+  x <- brmsmargins:::.links(
+    link = "identity", effects = "fixedonly", backtrans = "response")
+
+  expect_type(x, "list")
+  expect_equal(x$scale, "response")
+  expect_equal(x$ilink, "identity")
+  expect_equal(x$ilinknum, -9)
+})
+
+test_that(".links returns correct values with logit link and fixedonly", {
+  x <- brmsmargins:::.links(
+    link = "logit", effects = "fixedonly", backtrans = "response")
+
+  expect_type(x, "list")
+  expect_equal(x$scale, "response")
+  expect_equal(x$ilink, "identity")
+  expect_equal(x$ilinknum, -9)
+})
+
+test_that(".links returns correct values with identity link and integrateoutRE", {
+  x <- brmsmargins:::.links(
+    link = "identity", effects = "integrateoutRE", backtrans = "response")
+
+  expect_type(x, "list")
+  expect_equal(x$scale, "linear")
+  expect_equal(x$ilink, "identity")
+  expect_equal(x$ilinknum, -9)
+})
+
+test_that(".links returns correct values with logit link and integrateoutRE", {
+  x <- brmsmargins:::.links(
+    link = "logit", effects = "integrateoutRE", backtrans = "response")
+
+  expect_type(x, "list")
+  expect_equal(x$scale, "linear")
+  expect_equal(x$ilink, "invlogit")
+  expect_equal(x$ilinknum, 0)
+})
+
+test_that(".links returns correct values with log link and integrateoutRE", {
+  x <- brmsmargins:::.links(
+    link = "log", effects = "integrateoutRE", backtrans = "response")
+
+  expect_type(x, "list")
+  expect_equal(x$scale, "linear")
+  expect_equal(x$ilink, "exp")
+  expect_equal(x$ilinknum, 1)
+})
+
+test_that(".links returns correct values with sqrt link and integrateoutRE", {
+  x <- brmsmargins:::.links(
+    link = "sqrt", effects = "integrateoutRE", backtrans = "response")
+
+  expect_type(x, "list")
+  expect_equal(x$scale, "linear")
+  expect_equal(x$ilink, "square")
+  expect_equal(x$ilinknum, 2)
+})

tests/testthat/test-dot-percent.R

@@ -0,0 +1,49 @@
+test_that(".percent returns NA values when window is NULL", {
+  x <- brmsmargins:::.percent(1:10, window = NULL)
+
+  ## check types
+  expect_type(x, "list")
+  expect_type(x$Window, "double")
+  expect_type(x$Percent, "double")
+  expect_type(x$Label, "character")
+
+  ## check values
+  expect_equal(x$Window, NA_real_)
+  expect_equal(x$Percent, NA_real_)
+  expect_equal(x$Label, NA_character_)
+})
+
+test_that(".percent returns NA values when within is TRUE", {
+  x <- brmsmargins:::.percent(1:10, window = c(3, 5))
+
+  ## check types
+  expect_type(x, "list")
+  expect_type(x$Window, "double")
+  expect_type(x$Percent, "double")
+  expect_type(x$Label, "character")
+
+  ## check values
+  expect_equal(x$Window, c(3, 5))
+  expect_equal(x$Percent, 30)
+  expect_equal(x$Label, "[3, 5]")
+})
+
+test_that(".percent returns NA values when within is FALSE", {
+  x <- brmsmargins:::.percent(1:10, window = c(2, 6), within = FALSE)
+
+  ## check types
+  expect_type(x, "list")
+  expect_type(x$Window, "double")
+  expect_type(x$Percent, "double")
+  expect_type(x$Label, "character")
+
+  ## check values
+  expect_equal(x$Window, c(2, 6))
+  expect_equal(x$Percent, 70)
+  expect_equal(x$Label, "[-Inf, 2] | [6, Inf]")
+})
+
+test_that(".percent errors if window is not valid", {
+  expect_error(brmsmargins:::.percent(1:10, window = c(2)))
+  expect_error(brmsmargins:::.percent(1:10, window = c("b", "c")))
+})