From 6b01c0bc98d3a3de5cf0bb1fb09a38fad6806f7d Mon Sep 17 00:00:00 2001 From: JoFrhwld Date: Wed, 27 Sep 2023 14:30:23 -0400 Subject: [PATCH 1/5] refactored finiteness check into its on fn, new max size check --- R/data_checks.R | 33 ++++++++++++++++++++++++--------- 1 file changed, 24 insertions(+), 9 deletions(-) diff --git a/R/data_checks.R b/R/data_checks.R index 47fe193..28b746a 100644 --- a/R/data_checks.R +++ b/R/data_checks.R @@ -23,7 +23,7 @@ check_dim_size <- function(x, y, xname, yname){ } } -# check for minumum argument size +# check for minimum argument size check_min_size <- function(x, varname, min_size = 1){ if(length(x) < min_size){ cli::cli_abort( @@ -33,19 +33,34 @@ check_min_size <- function(x, varname, min_size = 1){ } } -# check the probabilities -check_probs <- function(probs) { +# check for maximum argument size +check_max_size <- function(x, varname, max_size = 1){ + if(length(x) > max_size){ + cli::cli_abort( + c("{.var {varname}} must have no more than {.val {max_size}} value{?s}.", + "i" = "{.var {varname}} has {.val {length(x)}} value{?s}") + ) + } +} - check_dim_class(probs, "probs") - check_min_size(probs, "probs", min_size = 1) +# check finite - if (!all(is.finite(probs))) { - non_finites <- unique(probs[which(!is.finite(probs))]) +check_finite <- function(x, varname){ + if(!all(is.finite(x))){ + non_finites <- unique(x[which(!is.finite(x))]) cli::cli_abort( - c("All {.var probs} must be finite.", - "i" = "{.var probs} included values of {.val {non_finites}}") + c("All values of {.var {varname}} must be finite.", + "i" = "{.var {varname}} included values of {.val {non_finites}}") ) } +} + +# check the probabilities +check_probs <- function(probs) { + + check_dim_class(probs, "probs") + check_min_size(probs, "probs", min_size = 1) + check_finite(probs, "probs") if (any(probs <= 0 | probs >= 1)) { n_less <- sum(probs <= 0) From a553b40e8a951b1ada706ffcb24485f3d290b492 Mon Sep 17 00:00:00 2001 From: JoFrhwld Date: Wed, 27 Sep 2023 14:31:00 -0400 Subject: [PATCH 2/5] checking and proecessing rangex and rangey --- R/data_checks.R | 69 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 69 insertions(+) diff --git a/R/data_checks.R b/R/data_checks.R index 28b746a..1723868 100644 --- a/R/data_checks.R +++ b/R/data_checks.R @@ -136,3 +136,72 @@ process_data <- function(x, xname, y, yname, probs){ ) } + +# process ranges + +expand_range <- function(x, mult = 0.25){ + data_range <- range(x) + range_diff <- diff(data_range) + out_range <- ((range_diff * mult) * c(-1, 1)) + data_range + return(out_range) +} + +process_ranges <- function(x, y, rangex, rangey, range_mult){ + is_def <- c(!is.null(rangex), !is.null(rangey)) + mult_def <- !is.null(range_mult) + + if(xor(is_def[1], is_def[2])){ + range_names = c("rangex", "rangey") + cli::cli_warn( + c("{.var {range_names[is_def]}} was defined but {.var {range_names[!is_def]}} was not.") + ) + } + + if(all(is_def) & mult_def){ + cli::cli_warn( + c("{.var rangey}, {.var rangey}, and {.var range_mult} all defined.", + "i" = "{.var range_mult} will be disregarded.") + ) + } + + if(!all(is_def) & mult_def){ + check_finite(range_mult, "range_mult") + check_max_size(range_mult, "range_mult", max_size = 1) + check_min_size(range_mult, "range_mult", min_size = 1) + } + + if(!is.null(rangex)){ + check_finite(rangex, "rangex") + check_min_size(rangex,"rangex", min_size = 2) + check_max_size(rangex, "rangex", max_size = 2) + } + + if(!is.null(rangey)){ + check_finite(rangey, "rangey") + check_min_size(rangey, "rangey", min_size = 2) + check_max_size(rangey, "rangey", max_size = 2) + } + + if(!any(c(is_def, mult_def))){ + cli::cli_abort( + c("None of {.var rangex}, {.var rangey}, or {.var range_mult} defined.", + "i" = "The range across dimensions for estimating the probability polygons must be defined.") + ) + } + + output <- list() + if(!is.null(rangex)){ + output$rangex <- rangex + }else{ + output$rangex <- expand_range(x, mult = range_mult) + } + + if(!is.null(rangey)){ + output$rangey <- rangey + }else{ + output$rangey <- expand_range(y, mult = range_mult) + } + + return(output) + +} From 3c9765fcae7d34cd76fea99bff627e601d74b533 Mon Sep 17 00:00:00 2001 From: JoFrhwld Date: Wed, 27 Sep 2023 14:31:52 -0400 Subject: [PATCH 3/5] rangex and rangey now passed explicitly, available as arguments to exported functions --- R/density_area.R | 72 ++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 57 insertions(+), 15 deletions(-) diff --git a/R/density_area.R b/R/density_area.R index 19bdd2b..e4d7de2 100644 --- a/R/density_area.R +++ b/R/density_area.R @@ -1,18 +1,11 @@ -expand_range <- function(x, mult = 0.25, ...){ - data_range <- range(x) - range_diff <- diff(data_range) - out_range <- ((range_diff * mult) * c(-1, 1)) + data_range - return(out_range) -} - get_isolines<- function(x, y, probs = 0.5, - range_mult = 0.25, + rangex, + rangey, ...) { - rangex = expand_range(x, range_mult) - rangey = expand_range(y, range_mult) + dots <- rlang::dots_list(...) tibble::tibble(x = x, y = y) |> ggdensity::get_hdr(probs = probs, @@ -75,11 +68,21 @@ get_isolines_safely <- function(...){ #' @param as_sf Should the returned values be [sf::sf]? Defaults to `FALSE`. #' @param as_list Should the returned value be a list? Defaults to `TRUE` to #' work well with tidyverse list columns +#' @param range_mult A multiplier to the range of `x` and `y` across which the +#' probability density will be estimated. +#' @param rangex,rangey Custom ranges across `x` and `y` ranges across which the +#' probability density will be estimated. #' @param ... Additional arguments to be passed to [ggdensity::get_hdr()] #' #' @returns A list of data frames, if `as_list=TRUE`, or just a data frame, #' if `as_list=FALSE` #' +#' @details +#' If both `rangex` and `rangey` are defined, `range_mult` will be disregarded. +#' If only one or the other of `rangex` and `rangey` are defined, `range_mult` +#' will be used to produce the range of the undefined one. +#' +#' #' @example inst/examples/density_polygon_example.R #' #' @importFrom dplyr .data @@ -92,11 +95,25 @@ density_polygons <- function(x, probs = 0.5, as_sf = FALSE, as_list = TRUE, + range_mult = 0.25, + rangex = NULL, + rangey = NULL, ...) { + dots <- rlang::dots_list(...) + + ### Capture variable names for name swap + xname <- deparse(substitute(x)) yname <- deparse(substitute(y)) + nameswap <- c("x", "y") + names(nameswap) <- vctrs::vec_as_names(c(xname, yname), + repair = "unique", + quiet = TRUE) + + ### process data + processed_data <- process_data(x=x, xname = xname, y=y, @@ -105,12 +122,22 @@ density_polygons <- function(x, list2env(processed_data, envir = environment()) - nameswap <- c("x", "y") - names(nameswap) <- vctrs::vec_as_names(c(xname, yname), - repair = "unique", - quiet = TRUE) + ### process ranges - isolines <- get_isolines_safely(x=x, y=y, probs=probs, ...) + processed_ranges <- process_ranges(x = x, + y = y, + rangex = rangex, + rangey = rangey, + range_mult = range_mult) + + list2env(processed_ranges, envir = environment()) + + isolines <- get_isolines_safely(x=x, + y=y, + probs=probs, + rangex = rangex, + rangey = rangey, + ...) isolines |> dplyr::mutate( @@ -179,8 +206,17 @@ density_polygons <- function(x, #' @param as_sf Should the returned values be [sf::sf]? Defaults to `FALSE`. #' @param as_list Should the returned value be a list? Defaults to `TRUE` to #' work well with tidyverse list columns +#' @param range_mult A multiplier to the range of `x` and `y` across which the +#' probability density will be estimated. +#' @param rangex,rangey Custom ranges across `x` and `y` ranges across which the +#' probability density will be estimated. #' @param ... Additional arguments to be passed to [ggdensity::get_hdr()] #' +#' @details +#' If both `rangex` and `rangey` are defined, `range_mult` will be disregarded. +#' If only one or the other of `rangex` and `rangey` are defined, `range_mult` +#' will be used to produce the range of the undefined one. +#' #' @example inst/examples/density_area_example.R #' #' @importFrom dplyr .data @@ -192,6 +228,9 @@ density_area <- function(x, probs = 0.5, as_sf = F, as_list = T, + range_mult = 0.25, + rangex = NULL, + rangey = NULL, ...) { density_polygons( x = x, @@ -199,6 +238,9 @@ density_area <- function(x, probs = probs, as_sf = T, as_list = F, + range_mult = range_mult, + rangex = rangex, + rangey = rangey, ... ) -> iso_poly_sf From 558a070531e539aa67cb3aa5e6d2faee7e1c7d07 Mon Sep 17 00:00:00 2001 From: JoFrhwld Date: Wed, 27 Sep 2023 14:32:06 -0400 Subject: [PATCH 4/5] new docs for the new arguments --- man/density_area.Rd | 23 ++++++++++++++++++++++- man/density_polygons.Rd | 22 +++++++++++++++++++++- 2 files changed, 43 insertions(+), 2 deletions(-) diff --git a/man/density_area.Rd b/man/density_area.Rd index 5cb9d55..5f0b427 100644 --- a/man/density_area.Rd +++ b/man/density_area.Rd @@ -4,7 +4,17 @@ \alias{density_area} \title{Density Area} \usage{ -density_area(x, y, probs = 0.5, as_sf = F, as_list = T, ...) +density_area( + x, + y, + probs = 0.5, + as_sf = F, + as_list = T, + range_mult = 0.25, + rangex = NULL, + rangey = NULL, + ... +) } \arguments{ \item{x, y}{Numeric data dimensions} @@ -16,11 +26,22 @@ density_area(x, y, probs = 0.5, as_sf = F, as_list = T, ...) \item{as_list}{Should the returned value be a list? Defaults to \code{TRUE} to work well with tidyverse list columns} +\item{range_mult}{A multiplier to the range of \code{x} and \code{y} across which the +probability density will be estimated.} + +\item{rangex, rangey}{Custom ranges across \code{x} and \code{y} ranges across which the +probability density will be estimated.} + \item{...}{Additional arguments to be passed to \code{\link[ggdensity:get_hdr]{ggdensity::get_hdr()}}} } \description{ A convenience function to get just the areas of density polygons. } +\details{ +If both \code{rangex} and \code{rangey} are defined, \code{range_mult} will be disregarded. +If only one or the other of \code{rangex} and \code{rangey} are defined, \code{range_mult} +will be used to produce the range of the undefined one. +} \examples{ library(densityarea) library(ggplot2) diff --git a/man/density_polygons.Rd b/man/density_polygons.Rd index bb04c35..14f13ff 100644 --- a/man/density_polygons.Rd +++ b/man/density_polygons.Rd @@ -4,7 +4,17 @@ \alias{density_polygons} \title{Density polygons} \usage{ -density_polygons(x, y, probs = 0.5, as_sf = FALSE, as_list = TRUE, ...) +density_polygons( + x, + y, + probs = 0.5, + as_sf = FALSE, + as_list = TRUE, + range_mult = 0.25, + rangex = NULL, + rangey = NULL, + ... +) } \arguments{ \item{x, y}{Numeric data dimensions} @@ -16,6 +26,12 @@ density_polygons(x, y, probs = 0.5, as_sf = FALSE, as_list = TRUE, ...) \item{as_list}{Should the returned value be a list? Defaults to \code{TRUE} to work well with tidyverse list columns} +\item{range_mult}{A multiplier to the range of \code{x} and \code{y} across which the +probability density will be estimated.} + +\item{rangex, rangey}{Custom ranges across \code{x} and \code{y} ranges across which the +probability density will be estimated.} + \item{...}{Additional arguments to be passed to \code{\link[ggdensity:get_hdr]{ggdensity::get_hdr()}}} } \value{ @@ -30,6 +46,10 @@ densities. \details{ When using \code{density_polygons()} together with tidyverse verbs, like \code{\link[dplyr:summarise]{dplyr::summarise()}}, \code{as_list} should be \code{TRUE}. + +If both \code{rangex} and \code{rangey} are defined, \code{range_mult} will be disregarded. +If only one or the other of \code{rangex} and \code{rangey} are defined, \code{range_mult} +will be used to produce the range of the undefined one. } \examples{ library(densityarea) From 05d7ce595f672c72e2728fc0b483f907fdb9745f Mon Sep 17 00:00:00 2001 From: JoFrhwld Date: Wed, 27 Sep 2023 14:48:26 -0400 Subject: [PATCH 5/5] new tests for range processing --- tests/testthat/test-test_range.R | 39 ++++++++++++++++++++++++++++++++ usethis_hist.R | 2 ++ 2 files changed, 41 insertions(+) create mode 100644 tests/testthat/test-test_range.R diff --git a/tests/testthat/test-test_range.R b/tests/testthat/test-test_range.R new file mode 100644 index 0000000..cc25c40 --- /dev/null +++ b/tests/testthat/test-test_range.R @@ -0,0 +1,39 @@ +set.seed(10) +alpha = rnorm(100) +beta = rnorm(100) + +test_that("warnings for redundant range settings", { + expect_warning( + density_polygons(alpha, beta, rangex = c(0, 1), rangey = c(0, 1), range_mult = 0.5) + ) + expect_warning( + density_area(alpha, beta, rangex = c(0, 1), rangey = c(0, 1), range_mult = 0.5) + ) +}) + +test_that("warnings for only one defined range", { + expect_warning( + density_polygons(alpha, beta, rangex = c(-2,2)) + ) + + expect_warning( + density_polygons(alpha, beta, rangey = c(-2,2)) + ) + + expect_warning( + density_area(alpha, beta, rangex = c(-2,2)) + ) + + expect_warning( + density_area(alpha, beta, rangey = c(-2,2)) + ) + +}) + +test_that("errors for invalid ranges", { + expect_error( + density_polygons(alpha, beta, rangex = 1, rangey = c(-2, 2), range_mult = NULL) + ) + +}) + diff --git a/usethis_hist.R b/usethis_hist.R index e50b68c..8cd9911 100644 --- a/usethis_hist.R +++ b/usethis_hist.R @@ -82,6 +82,8 @@ usethis::use_test("multi_polygon") usethis::use_test("expand_range") usethis::use_test("test_rename") +usethis::use_test("test_range") + # Github ---- usethis::use_github_action(name = "check-standard")