From a52f805aa67a6bf881fbf9a3036d14d8df0d8cca Mon Sep 17 00:00:00 2001 From: nicolc11 Date: Thu, 18 Jul 2024 13:14:50 +0100 Subject: [PATCH] Added percent functions. --- DESCRIPTION | 2 +- NAMESPACE | 9 +++ R/percent.R | 194 ++++++++++++++++++++++++++++++++++++++++++++++ man/percent.Rd | 57 ++++++++++++++ man/phsmethods.Rd | 34 ++++++++ 5 files changed, 295 insertions(+), 1 deletion(-) create mode 100644 R/percent.R create mode 100644 man/percent.Rd diff --git a/DESCRIPTION b/DESCRIPTION index d8dbd33..dc1074f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -56,5 +56,5 @@ Encoding: UTF-8 Language: en-GB LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index c4efa6d..a9884e9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,17 @@ # Generated by roxygen2: do not edit by hand +S3method("[",percent) +S3method(Math,percent) +S3method(Ops,percent) +S3method(as.character,percent) +S3method(format,percent) +S3method(print,percent) +S3method(rep,percent) +S3method(unique,percent) export(age_calculate) export(age_from_chi) export(age_group) +export(as_percent) export(chi_check) export(chi_pad) export(create_age_groups) diff --git a/R/percent.R b/R/percent.R new file mode 100644 index 0000000..0b093c2 --- /dev/null +++ b/R/percent.R @@ -0,0 +1,194 @@ +#' Percentages +#' +#' @description +#' `percent` is a lightweight S3 class allowing for pretty +#' printing of proportions as percentages. +#' +#' @param x [numeric] vector of proportions. +#' +#' @returns +#' A class of object `percent`. +#' +#' @details +#' By default all percentages are formatted to 2 decimal places which can be +#' overwritten using `format()`. It's worth noting that the digits argument in +#' `format.percent` uses decimal rounding instead of significant digit rounding. +#' +#' @examples +#' library(phsmethods) +#' +#' # Convert proportions to percentages +#' as_percent(seq(0, 1, 0.1)) +#' +#' # You can use round() as usual +#' p <- as_percent(15.56 / 100) +#' round(p) +#' round(p, digits = 1) +#' +#' p2 <- as_percent(0.0005) +#' signif(p2, 2) +#' floor(p2) +#' ceiling(p2) +#' +#' # We can do basic math operations as usual +#' +#' # Order of operations matters +#' 10 * as_percent(c(0, 0.5, 2)) +#' as_percent(c(0, 0.5, 2)) * 10 +#' +#' as_percent(0.1) + as_percent(0.2) +#' +#' # Formatting options +#' format(as_percent(2.674 / 100), digits = 2, symbol = " (%)") +#' # Prints nicely in data frames (and tibbles) +#' library(dplyr) +#' starwars %>% +#' count(eye_color) %>% +#' mutate(perc = as_percent(n/sum(n))) %>% +#' arrange(desc(perc)) %>% # We can do numeric sorting with percent vectors +#' mutate(perc_rounded = round(perc)) +#' @export +#' @rdname percent +as_percent <- function(x){ + if (!is.numeric(x)){ + stop("x must be a numeric vector of proportions") + } + new_percent(x) +} +new_percent <- function(x){ + class(x) <- "percent" + x +} +round_half_up <- function(x, digits = 0){ + if (is.null(digits) || (length(digits) == 1 && digits == Inf)){ + return(x) + } + trunc( + abs(x) * 10^digits + 0.5 + + sqrt(.Machine$double.eps) + ) / + 10^digits * sign(x) +} +signif_half_up <- function(x, digits = 6){ + if (is.null(digits) || (length(digits) == 1 && digits == Inf)){ + return(x) + } + round_half_up(x, digits - ceiling(log10(abs(x)))) +} + +#' @export +as.character.percent <- function(x, digits = 2, ...){ + if (length(x) == 0){ + character() + } else { + paste0(unclass(round(x, digits) * 100), "%") + } +} + +#' @export +format.percent <- function(x, symbol = "%", trim = TRUE, + digits = 2, + ...){ + if (length(x) == 0){ + out <- character() + } else { + out <- paste0(format(unclass(round(x, digits) * 100), trim = trim, digits = NULL, ...), + symbol) + } + names(out) <- names(x) + out +} + +#' @export +print.percent <- function(x, max = NULL, trim = TRUE, + digits = 2, + ...){ + out <- x + N <- length(out) + if (N == 0){ + print("percent(numeric())") + return(invisible(x)) + } + if (is.null(max)) { + max <- getOption("max.print", 9999L) + } + suffix <- character() + max <- min(max, N) + if (max < N) { + out <- out[seq_len(max)] + suffix <- paste(" [ reached 'max' / getOption(\"max.print\") -- omitted", + N - max, "entries ]\n") + } + print(format(out, trim = trim, digits = digits), ...) + cat(suffix) + invisible(x) +} + +#' @export +`[.percent` <- function(x, ..., drop = TRUE){ + cl <- oldClass(x) + class(x) <- NULL + out <- NextMethod("[") + class(out) <- cl + out +} + +#' @export +unique.percent <- function(x, incomparables = FALSE, + fromLast = FALSE, nmax = NA, ...){ + cl <- oldClass(x) + class(x) <- NULL + out <- NextMethod("unique") + class(out) <- cl + out +} + +#' @export +rep.percent <- function(x, ...){ + cl <- oldClass(x) + class(x) <- NULL + out <- NextMethod("rep") + class(out) <- cl + out +} + +#' @export +Ops.percent <- function(e1, e2){ + math <- switch(.Generic, + `+` =, + `-` =, + `*` =, + `/` =, + `^` =, + `%%` =, + `%/%` = TRUE, FALSE) + if (inherits(e2, "percent") && !inherits(e1, "percent")){ + e1 <- unclass(e1) + e2 <- unclass(e2) + } + NextMethod(.Generic) +} +#' @export +Math.percent <- function(x, ...){ + rounding_math <- switch(.Generic, + `floor` =, + `ceiling` =, + `trunc` =, + `round` =, + `signif` = TRUE, FALSE) + x <- unclass(x) + if (rounding_math){ + x <- x * 100 + if (.Generic == "round"){ + out <- do.call(round_half_up, list(x, ...)) + } else if (.Generic == "signif"){ + out <- do.call(signif_half_up, list(x, ...)) + } else { + out <- NextMethod(.Generic) + } + new_percent(out / 100) + } else { + out <- NextMethod(.Generic) + new_percent(out) + } +} diff --git a/man/percent.Rd b/man/percent.Rd new file mode 100644 index 0000000..afb0609 --- /dev/null +++ b/man/percent.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/percent.R +\name{as_percent} +\alias{as_percent} +\title{Percentages} +\usage{ +as_percent(x) +} +\arguments{ +\item{x}{\link{numeric} vector of proportions.} +} +\value{ +A class of object \code{percent}. +} +\description{ +\code{percent} is a lightweight S3 class allowing for pretty +printing of proportions as percentages. +} +\details{ +By default all percentages are formatted to 2 decimal places which can be +overwritten using \code{format()}. It's worth noting that the digits argument in +\code{format.percent} uses decimal rounding instead of significant digit rounding. +} +\examples{ +library(percent) + +# Convert proportions to percentages +as_percent(seq(0, 1, 0.1)) + +# You can use round() as usual +p <- as_percent(15.56 / 100) +round(p) +round(p, digits = 1) + +p2 <- as_percent(0.0005) +signif(p2, 2) +floor(p2) +ceiling(p2) + +# We can do basic math operations as usual + +# Order of operations matters +10 * as_percent(c(0, 0.5, 2)) +as_percent(c(0, 0.5, 2)) * 10 + +as_percent(0.1) + as_percent(0.2) + +# Formatting options +format(as_percent(2.674 / 100), digits = 2, symbol = " (\%)") +# Prints nicely in data frames (and tibbles) +library(dplyr) +starwars \%>\% + count(eye_color) \%>\% + mutate(perc = as_percent(n/sum(n))) \%>\% + arrange(desc(perc)) \%>\% # We can do numeric sorting with percent vectors + mutate(perc_rounded = round(perc)) +} diff --git a/man/phsmethods.Rd b/man/phsmethods.Rd index 64143ac..762545f 100644 --- a/man/phsmethods.Rd +++ b/man/phsmethods.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/phsmethods.R \docType{package} \name{phsmethods} +\alias{phsmethods-package} \alias{phsmethods} \title{\code{phsmethods} package} \description{ @@ -11,3 +12,36 @@ Standard Methods for use in PHS. See the README on \href{https://github.com/Public-Health-Scotland/phsmethods#readme}{GitHub}. } +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/Public-Health-Scotland/phsmethods} + \item \url{https://public-health-scotland.github.io/phsmethods/} + \item Report bugs at \url{https://github.com/Public-Health-Scotland/phsmethods/issues} +} + +} +\author{ +\strong{Maintainer}: Tina Fu \email{Yuyan.Fu2@phs.scot} + +Authors: +\itemize{ + \item David Caldwell \email{David.Caldwell@phs.scot} + \item Jack Hannah \email{jack.hannah2@phs.scot} + \item Ciara Gribben \email{Ciara.Gribben@phs.scot} + \item Chris Deans \email{Chris.Deans2@phs.scot} + \item Jaime Villacampa \email{Jaime.Villacampa@phs.scot} + \item Graeme Gowans \email{Graeme.Gowans@phs.scot} + \item James McMahon \email{James.McMahon@phs.scot} (\href{https://orcid.org/0000-0002-5380-2029}{ORCID}) + \item Nicolaos Christofidis \email{nicolaos.christofidis@phs.scot} +} + +Other contributors: +\itemize{ + \item Public Health Scotland \email{phs.datascience@phs.scot} [copyright holder] + \item Lucinda Lawrie \email{Lucinda.Lawrie@phs.scot} [reviewer] + \item Alice Byers [contributor] + \item Alan Yeung \email{Alan.Yeung@phs.scot} [contributor] +} + +}