Merge

DESCRIPTION

@@ -2,7 +2,7 @@ Package: ggpp
 Type: Package
 Title: Grammar Extensions to 'ggplot2'
 Version: 0.5.0.9000
-Date: 2023-01-28
+Date: 2023-01-30
 Authors@R:
     c(
     person("Pedro J.", "Aphalo", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-3385-972X")),

NEWS.md

@@ -16,6 +16,7 @@ editor_options:
 `stat_dens1d_filter_g()` to allow separate control of kept observations or
 labels in each tail (1D) or in each quadrant (2D) of the density distribution,
 still using an estimate of the local density computed from the whole data set.
+-   Improv unit test coverage.
 
 # ggpp 0.5.0
 

R/stat-dens1d-labels.r

@@ -41,14 +41,15 @@
 #'   \code{keep.these} is controlled with arguments passed to \code{keep.number}
 #'   and \code{keep.fraction}. \code{keep.number} sets the maximum number of
 #'   observations selected, whenever \code{keep.fraction} results in fewer
-#'   observations selected, it is obeyed. If `xintercept` is a finite value
+#'   observations selected, it is obeyed. If \code{xintercept} is a finite value
 #'   within the \emph{x} range of the data and \code{pool.along} is passed
-#'   \code{"none"} the data as are split into two groups and \code{keep.number}
-#'   and \code{keep.fraction} are applied separately to each tail with density
-#'   still computed jointly from all observations. If the length of
-#'   \code{keep.number} and \code{keep.fraction} is one, this value is used for
-#'   both tails, if their length is two, the first value is use for the left
-#'   tail and the second value for the right tail.
+#'   \code{"none"} the data are split into two groups and \code{keep.number} and
+#'   \code{keep.fraction} are applied separately to each tail with density still
+#'   computed jointly from all observations. If the length of \code{keep.number}
+#'   and \code{keep.fraction} is one, half this value is used each tail, if
+#'   their length is two, the first value is use for the left tail and the
+#'   second value for the right tail (or if using \code{orientation = "y"} the
+#'   lower and upper tails, respectively).
 #'
 #' @note Which points are kept and which not depends on how dense and flexible
 #'   is the density curve estimate. This depends on the values passed as
@@ -324,10 +325,15 @@ dens1d_labs_compute_fun <-
         keep.fraction <- rep_len(keep.fraction, length.out = 2)
       }
       if (length(keep.number) != 2L) {
+        if (length(keep.number) == 1L) {
+          keep.number <- keep.number %/% 2
+        }
         keep.number <- rep_len(keep.number, length.out = 2)
       }
       num.rows <- sapply(selectors, sum) # selectors are logical
     } else {
+      keep.fraction <- keep.fraction[[1]] # can be a vector or a list
+      keep.number <- keep.number[[1]]
       num.rows <- nrow(data)
       selectors <- list(all = rep.int(TRUE, times = num.rows))
     }

R/stat-dens2d-labels.r

@@ -8,16 +8,16 @@
 #'   to \code{rownames(data)}, with a message.
 #'
 #' @details \code{stat_dens2d_labels()} is designed to work together with
-#'   geometries from packages 'ggrepel'. To avoid text labels being plotted over
-#'   unlabelled points the corresponding rows in data need to be retained but
+#'   geometries from package 'ggrepel'. To avoid text labels being plotted over
+#'   unlabelled points all the rows in data need to be retained but
 #'   labels replaced with the empty character string, \code{""}. Function
 #'   \code{\link{stat_dens2d_filter}} cannot be used with the repulsive geoms
-#'   from 'ggrepel' because it drops the observations.
+#'   from 'ggrepel' because it drops observations.
 #'
 #'   \code{stat_dens2d_labels()} can be useful also in other situations, as the
 #'   substitution character string can be set by the user by passing an argument
 #'   to \code{label.fill}. If this argument is \code{NULL} the unselected rows
-#'   are filtered out.
+#'   are filtered out identically as by \code{stat_dens2d_filter}.
 #'
 #'   The local density of observations in 2D (\emph{x} and \emph{y}) is computed
 #'   with function \code{\link[MASS]{kde2d}} and used to select observations,
@@ -29,9 +29,9 @@
 #'   passing a suitable argument to \code{keep.these}. Logical and integer
 #'   vectors function as indexes to rows in \code{data}, while a character
 #'   vector is compared to values in the variable mapped to the \code{label}
-#'   aesthetic. A function passed as argument to keep.these will receive as
-#'   argument the values in the variable mapped to \code{label} and should
-#'   return a character, logical or numeric vector as described above.
+#'   aesthetic. A function passed as argument to \code{keep.these} will receive
+#'   as its first argument the values in the variable mapped to \code{label} and
+#'   should return a character, logical or numeric vector as described above.
 #'
 #'   How many labels are retained intact in addition to those in
 #'   \code{keep.these} is controlled with arguments passed to \code{keep.number}
@@ -301,6 +301,9 @@ dens2d_labs_compute_fun <-
         keep.fraction <- rep_len(keep.fraction, length.out = 2)
       }
       if (length(keep.number) != 2L) {
+        if (length(keep.number) == 1L) {
+          keep.number <- keep.number %/% 2
+        }
         keep.number <- rep_len(keep.number, length.out = 2)
       }
       num.rows <- sapply(selectors, sum) # selectors are logical
@@ -311,6 +314,9 @@ dens2d_labs_compute_fun <-
         keep.fraction <- rep_len(keep.fraction, length.out = 2)
       }
       if (length(keep.number) != 2L) {
+        if (length(keep.number) == 1L) {
+          keep.number <- keep.number %/% 2
+        }
         keep.number <- rep_len(keep.number, length.out = 2)
       }
       num.rows <- sapply(selectors, sum) # selectors are logical
@@ -323,10 +329,15 @@ dens2d_labs_compute_fun <-
         keep.fraction <- rep_len(keep.fraction, length.out = 4)
       }
       if (length(keep.number) != 4L) {
+        if (length(keep.number) == 1L) {
+          keep.number <- keep.number %/% 4
+        }
         keep.number <- rep_len(keep.number, length.out = 4)
       }
       num.rows <- sapply(selectors, sum) # selectors are logical
     } else {
+      keep.fraction <- keep.fraction[[1]] # can be a vector or a list
+      keep.number <- keep.number[[1]]
       num.rows <- nrow(data)
       selectors <- list(all = rep.int(TRUE, times = num.rows))
     }

tests/testthat/test-stat-d1d-flt.R

@@ -544,7 +544,7 @@ test_that("labels_x_params", {
                                         geom_point() +
                                         stat_dens1d_labels(colour = "red",
                                                            keep.fraction = 1,
-                                                           keep.number = 3,
+                                                           keep.number = 6,
                                                            pool.along = "none")
           )
           vdiffr::expect_doppelganger("stat_d1d_lbl_keep_frac_x09",
@@ -673,7 +673,7 @@ test_that("labels_y_params", {
                                 geom_point() +
                                 stat_dens1d_labels(colour = "red",
                                                    keep.fraction = 1,
-                                                   keep.number = 3,
+                                                   keep.number = 6,
                                                    pool.along = "none",
                                                    orientation = "y")
   )

tests/testthat/test-stat-d2d-flt.R

@@ -597,7 +597,7 @@ test_that("labels_params", {
                                 geom_point() +
                                 stat_dens2d_labels(colour = "red",
                                                    keep.fraction = 1,
-                                                   keep.number = 3,
+                                                   keep.number = 12,
                                                    pool.along = "none")
   )