Revise tests and functions to ensure coverage

Added unit tests for code that was not being tested Made small edits to package code to ensure that tests are seen by 'covr'. Locally I get coverage > 80% for all functions and overall coverage near 94%.
aphalo · Mar 11, 2023 · 9859851 · 9859851
1 parent e7e0f1a
commit 9859851
Show file tree

Hide file tree

Showing 7 changed files with 112 additions and 66 deletions.
diff --git a/R/annotate.r b/R/annotate.r
@@ -71,34 +71,6 @@ annotate <-
             npcx = NULL, npcy = NULL, label = NULL, ...,
             na.rm = FALSE)
   {
-    # functions from ggplot2, needed here but not exported
-    compact <- function (x)
-    {
-      null <- vapply(x, is.null, logical(1))
-      x[!null]
-    }
-
-    new_data_frame <- function (x = list(), n = NULL) {
-      if (length(x) != 0 && is.null(names(x))) {
-        rlang::abort("Elements must be named")
-      }
-      lengths <- vapply(x, length, integer(1))
-      if (is.null(n)) {
-        n <- if (length(x) == 0 || min(lengths) == 0)
-          0
-        else max(lengths)
-      }
-      for (i in seq_along(x)) {
-        if (lengths[i] == n)
-          next
-        if (lengths[i] != 1) {
-          rlang::abort("Elements must equal the number of rows or 1")
-        }
-        x[[i]] <- rep(x[[i]], n)
-      }
-      tibble::as_tibble(x)
-    }
-
     if (inherits(label, what = c("data.frame", "gg", "grob"))) {
       label <- list(label)
     }

diff --git a/R/position-nudge-dodge2.R b/R/position-nudge-dodge2.R
@@ -16,23 +16,23 @@ position_dodge2nudge <-
     direction <- rlang::arg_match(direction)
     kept.origin <- rlang::arg_match(kept.origin)
 
+    fun_one <- function(x) {1}
+
     ggplot2::ggproto(NULL, PositionDodgeAndNudge,
                      x = x,
                      y = y,
                      .fun_x = switch(direction,
-                                     none = function(x) {1},
+                                     none = fun_one,
                                      split = sign,
-                                     split.y = function(x) {1},
+                                     split.y = fun_one,
                                      split.x = sign,
-                                     center = sign,
-                                     function(x) {1}),
+                                     center = sign),
                      .fun_y = switch(direction,
-                                     none = function(x) {1},
+                                     none = fun_one,
                                      split = sign,
-                                     split.x = function(x) {1},
+                                     split.x = fun_one,
                                      split.y = sign,
-                                     center = sign,
-                                     function(x) {1}),
+                                     center = sign),
                      kept.origin = kept.origin,
                      width = width,
                      preserve = rlang::arg_match(preserve),

diff --git a/R/utilities.R b/R/utilities.R
@@ -23,3 +23,39 @@ parse_safe <- function(text) {
   }
   out
 }
+
+
+# function from ggplot2, needed in annotate() but not exported
+compact <- function (x)
+{
+  null <- vapply(x, is.null, logical(1))
+  x[!null]
+}
+
+# function from ggplot2 (not current), needed in annotate() but not exported
+new_data_frame <- function (x = list(), n = NULL) {
+  if (length(x) != 0 && is.null(names(x))) {
+    rlang::abort("Elements must be named")
+  }
+  lengths <- vapply(x, length, integer(1))
+  if (is.null(n)) {
+    n <- if (length(x) == 0 || min(lengths) == 0)
+      0
+    else max(lengths)
+  }
+  for (i in seq_along(x)) {
+    if (lengths[i] == n)
+      next
+    if (lengths[i] != 1) {
+      rlang::abort("Elements must equal the number of rows or 1")
+    }
+    x[[i]] <- rep(x[[i]], n)
+  }
+  tibble::as_tibble(x)
+}
+
+# Used in annotations to ensure printed even when no
+# global data
+# copied from ggplot2's utilities.r
+dummy_data <- function() new_data_frame(list(x = NA), n = 1)
+
diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf
diff --git a/tests/testthat/test-annotate.R b/tests/testthat/test-annotate.R
@@ -1,36 +1,6 @@
 context("annotate")
 # tests copied from 'ggplot2' to ensure that pass through is working as expected
 
-# Used in annotations to ensure printed even when no
-# global data
-# copied from ggplot2's utilities.r
-dummy_data <- function() new_data_frame(list(x = NA), n = 1)
-
-# Fast data.frame constructor and indexing
-# No checking, recycling etc. unless asked for
-# copied from ggplot2's performance.r
-new_data_frame <- function(x = list(), n = NULL) {
-  if (length(x) != 0 && is.null(names(x))) {
-    abort("Elements must be named")
-  }
-  lengths <- vapply(x, length, integer(1))
-  if (is.null(n)) {
-    n <- if (length(x) == 0 || min(lengths) == 0) 0 else max(lengths)
-  }
-  for (i in seq_along(x)) {
-    if (lengths[i] == n) next
-    if (lengths[i] != 1) {
-      abort("Elements must equal the number of rows or 1")
-    }
-    x[[i]] <- rep(x[[i]], n)
-  }
-
-  class(x) <- "data.frame"
-
-  attr(x, "row.names") <- .set_row_names(n)
-  x
-}
-
 test_that("dates in segment annotation work", {
   dt <- structure(list(month = structure(c(1364774400, 1377993600),
                                          class = c("POSIXct", "POSIXt"), tzone = "UTC"), total = c(-10.3,

diff --git a/tests/testthat/test-position_dodge2nudge.R b/tests/testthat/test-position_dodge2nudge.R
@@ -7,6 +7,13 @@ test_that("incorrect kept.origin used", {
   )
 })
 
+test_that("incorrect direction used", {
+  expect_error(
+    position_dodge2nudge(direction = "")
+    #, "`kept.origin` must be one of \"dodged\", \"original\", or \"none\", not \"\"."
+  )
+})
+
 test_that("correct kept.origin used", {
   position <- position_dodge2nudge(kept.origin = "dodged")
   expect_no_error(position)
@@ -22,3 +29,53 @@ test_that("test if correct arguments are assigned", {
   expect_identical(position$y, 0)
 })
 
+test_that("test if correct arguments are assigned with 'split.y'", {
+  position <- position_dodge2nudge(kept.origin = "none", direction = "split.y")
+  expect_false(position$reverse)
+  expect_identical(position$padding, 0.1)
+  expect_identical(position$preserve, "total")
+  expect_identical(position$width, 1)
+  expect_identical(position$x, 0)
+  expect_identical(position$y, 0)
+})
+
+test_that("test if correct arguments are assigned with 'split.x'", {
+  position <- position_dodge2nudge(kept.origin = "none", direction = "split.x")
+  expect_false(position$reverse)
+  expect_identical(position$padding, 0.1)
+  expect_identical(position$preserve, "total")
+  expect_identical(position$width, 1)
+  expect_identical(position$x, 0)
+  expect_identical(position$y, 0)
+})
+
+test_that("test if correct arguments are assigned with 'split'", {
+  position <- position_dodge2nudge(kept.origin = "none", direction = "split")
+  expect_false(position$reverse)
+  expect_identical(position$padding, 0.1)
+  expect_identical(position$preserve, "total")
+  expect_identical(position$width, 1)
+  expect_identical(position$x, 0)
+  expect_identical(position$y, 0)
+})
+
+test_that("test if correct arguments are assigned with 'none'", {
+  position <- position_dodge2nudge(kept.origin = "none", direction = "none")
+  expect_false(position$reverse)
+  expect_identical(position$padding, 0.1)
+  expect_identical(position$preserve, "total")
+  expect_identical(position$width, 1)
+  expect_identical(position$x, 0)
+  expect_identical(position$y, 0)
+})
+
+test_that("test if correct arguments are assigned with 'center'", {
+  position <- position_dodge2nudge(kept.origin = "none", direction = "center")
+  expect_false(position$reverse)
+  expect_identical(position$padding, 0.1)
+  expect_identical(position$preserve, "total")
+  expect_identical(position$width, 1)
+  expect_identical(position$x, 0)
+  expect_identical(position$y, 0)
+})
+
diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
@@ -41,3 +41,14 @@ test_that("parse_safe works with multi expressions", {
     expression(NA, 1, 2, a)
   )
 })
+
+test_that("new_data_frame", {
+  expect_is(new_data_frame(), "data.frame")
+  df <- new_data_frame(list(A = 1:2, B = letters[1:2]))
+  expect_is(df, "data.frame")
+  expect_named(df, c("A", "B"))
+  expect_equal(nrow(df), 2L)
+  expect_error(new_data_frame(list(1:2, letters[1:2])))
+  expect_error(new_data_frame(list(A = 1:2, B = letters[1:2]), n = 0))
+  expect_error(new_data_frame(list(A = 1:2, B = letters[1:2]), n = 10))
+})