From a52f805aa67a6bf881fbf9a3036d14d8df0d8cca Mon Sep 17 00:00:00 2001
From: nicolc11 <nicolaos.christofidis@phs.scot>
Date: Thu, 18 Jul 2024 13:14:50 +0100
Subject: [PATCH 01/12] 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]
+}
+
+}

From 6bd2798f16b80ae788746f8170c6890b84344a3c Mon Sep 17 00:00:00 2001
From: Nic-Chr <Nic-Chr@users.noreply.github.com>
Date: Thu, 18 Jul 2024 12:17:48 +0000
Subject: [PATCH 02/12] Update documentation

---
 DESCRIPTION    | 2 +-
 man/percent.Rd | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index dc1074f..be42799 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -56,5 +56,5 @@ Encoding: UTF-8
 Language: en-GB
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 VignetteBuilder: knitr
diff --git a/man/percent.Rd b/man/percent.Rd
index afb0609..c5b9d63 100644
--- a/man/percent.Rd
+++ b/man/percent.Rd
@@ -22,7 +22,7 @@ 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)
+library(phsmethods)
 
 # Convert proportions to percentages
 as_percent(seq(0, 1, 0.1))

From 9142f8664fc381a2281b29fd9f76ab68aba889ef Mon Sep 17 00:00:00 2001
From: nicolc11 <nicolaos.christofidis@phs.scot>
Date: Tue, 27 Aug 2024 12:04:00 +0100
Subject: [PATCH 03/12] Added summary methods.

---
 NAMESPACE   |  3 ++-
 R/percent.R | 35 +++++++++++++++++++----------------
 2 files changed, 21 insertions(+), 17 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index a9884e9..5c3274b 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -2,9 +2,10 @@
 
 S3method("[",percent)
 S3method(Math,percent)
-S3method(Ops,percent)
+S3method(Summary,percent)
 S3method(as.character,percent)
 S3method(format,percent)
+S3method(mean,percent)
 S3method(print,percent)
 S3method(rep,percent)
 S3method(unique,percent)
diff --git a/R/percent.R b/R/percent.R
index 0b093c2..f704347 100644
--- a/R/percent.R
+++ b/R/percent.R
@@ -152,22 +152,6 @@ rep.percent <- function(x, ...){
   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,
@@ -192,3 +176,22 @@ Math.percent <- function(x, ...){
     new_percent(out)
   }
 }
+#' @export
+Summary.percent <- function(x, ...){
+  summary_math <- switch(.Generic,
+                          `sum` =,
+                          `prod` =,
+                          `min` =,
+                          `max` =,
+                          `range` = TRUE, FALSE)
+  x <- unclass(x)
+  out <- NextMethod(.Generic)
+  if (summary_math){
+    out <- new_percent(out)
+  }
+  out
+}
+#' @export
+mean.percent <- function(x, ...){
+  new_percent(mean(unclass(x), ...))
+}

From 7ce3ebe3d1eb6c6cc167dfc4eeed4ab073eb8690 Mon Sep 17 00:00:00 2001
From: nicolc11 <nicolaos.christofidis@phs.scot>
Date: Tue, 27 Aug 2024 12:09:23 +0100
Subject: [PATCH 04/12] Improved print methods.

---
 R/percent.R | 24 +++++++++++-------------
 1 file changed, 11 insertions(+), 13 deletions(-)

diff --git a/R/percent.R b/R/percent.R
index f704347..6c82f6f 100644
--- a/R/percent.R
+++ b/R/percent.R
@@ -78,23 +78,18 @@ signif_half_up <- function(x, digits = 6){
 
 #' @export
 as.character.percent <- function(x, digits = 2, ...){
-  if (length(x) == 0){
-    character()
-  } else {
-    paste0(unclass(round(x, digits) * 100), "%")
-  }
+  stringr::str_c(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)
-  }
+  out <- stringr::str_c(
+    format(unclass(round(x, digits) * 100), trim = trim, digits = NULL, ...),
+    symbol
+  )
+  out[is.na(x)] <- NA
   names(out) <- names(x)
   out
 }
@@ -116,8 +111,11 @@ print.percent <- function(x, max = NULL, trim = TRUE,
   max <- min(max, N)
   if (max < N) {
     out <- out[seq_len(max)]
-    suffix <- paste(" [ reached 'max' / getOption(\"max.print\") -- omitted",
-                    N - max, "entries ]\n")
+    suffix <- stringr::str_c(
+      " [ reached 'max' / getOption(\"max.print\") -- omitted",
+      N - max, "entries ]\n",
+      sep = " "
+    )
   }
   print(format(out, trim = trim, digits = digits), ...)
   cat(suffix)

From 322f84801be67102fc09ec1ed940b612d6f5e7fa Mon Sep 17 00:00:00 2001
From: nicolc11 <nicolaos.christofidis@phs.scot>
Date: Tue, 27 Aug 2024 12:22:01 +0100
Subject: [PATCH 05/12] Updated percent documentation.

---
 R/percent.R    | 22 ++++++++++++++++++----
 man/percent.Rd | 22 ++++++++++++++++++----
 2 files changed, 36 insertions(+), 8 deletions(-)

diff --git a/R/percent.R b/R/percent.R
index 6c82f6f..58902e5 100644
--- a/R/percent.R
+++ b/R/percent.R
@@ -1,18 +1,32 @@
 #' Percentages
 #'
 #' @description
+#'
 #' `percent` is a lightweight S3 class allowing for pretty
-#' printing of proportions as percentages.
+#' printing of proportions as percentages. \cr
+#' It aims to remove the need for creating character vectors of percentages.
 #'
-#' @param x [numeric] vector of proportions.
+#' @param x [`numeric`] vector of proportions.
 #'
 #' @returns
 #' A class of object `percent`.
 #'
 #' @details
+#'
+#' ### Rounding
+#'
+#' The rounding for percent vectors differs to that of base R rounding,
+#' namely in that halves are rounded up instead of rounded to even.
+#' This means that `round(x)` will round the percent vector `x` using
+#' halves-up rounding (like in the janitor package).
+#'
+#' ### Formatting
+#'
 #' 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.
+#' overwritten using `format()` or using `round()` if your required digits are
+#' less than 2. It's worth noting that the digits argument in
+#' `format.percent` uses decimal rounding instead of the usual
+#' significant digit rounding that `format.default()` uses.
 #'
 #' @examples
 #' library(phsmethods)
diff --git a/man/percent.Rd b/man/percent.Rd
index c5b9d63..b234bd5 100644
--- a/man/percent.Rd
+++ b/man/percent.Rd
@@ -7,19 +7,33 @@
 as_percent(x)
 }
 \arguments{
-\item{x}{\link{numeric} vector of proportions.}
+\item{x}{\code{\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.
+printing of proportions as percentages. \cr
+It aims to remove the need for creating character vectors of percentages.
 }
 \details{
+\subsection{Rounding}{
+
+The rounding for percent vectors differs to that of base R rounding,
+namely in that halves are rounded up instead of rounded to even.
+This means that \code{round(x)} will round the percent vector \code{x} using
+halves-up rounding (like in the janitor package).
+}
+
+\subsection{Formatting}{
+
 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.
+overwritten using \code{format()} or using \code{round()} if your required digits are
+less than 2. It's worth noting that the digits argument in
+\code{format.percent} uses decimal rounding instead of the usual
+significant digit rounding that \code{format.default()} uses.
+}
 }
 \examples{
 library(phsmethods)

From f7382fcef87bf75757c8386df47403379a9b1e6c Mon Sep 17 00:00:00 2001
From: nicolc11 <nicolaos.christofidis@phs.scot>
Date: Tue, 27 Aug 2024 12:28:48 +0100
Subject: [PATCH 06/12] More accurate print result for zero-length percent
 vectors.

---
 R/percent.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/percent.R b/R/percent.R
index 58902e5..0e104ea 100644
--- a/R/percent.R
+++ b/R/percent.R
@@ -115,7 +115,7 @@ print.percent <- function(x, max = NULL, trim = TRUE,
   out <- x
   N <- length(out)
   if (N == 0){
-    print("percent(numeric())")
+    print("as_percent(numeric())")
     return(invisible(x))
   }
   if (is.null(max)) {

From 6aa3ce073ea65f776006f299ddfd6b9e65f27176 Mon Sep 17 00:00:00 2001
From: nicolc11 <nicolaos.christofidis@phs.scot>
Date: Tue, 27 Aug 2024 14:16:55 +0100
Subject: [PATCH 07/12] Updated percent documentation.

---
 R/percent.R    | 2 --
 man/percent.Rd | 2 --
 2 files changed, 4 deletions(-)

diff --git a/R/percent.R b/R/percent.R
index 0e104ea..07b0d15 100644
--- a/R/percent.R
+++ b/R/percent.R
@@ -29,8 +29,6 @@
 #' significant digit rounding that `format.default()` uses.
 #'
 #' @examples
-#' library(phsmethods)
-#'
 #' # Convert proportions to percentages
 #' as_percent(seq(0, 1, 0.1))
 #'
diff --git a/man/percent.Rd b/man/percent.Rd
index b234bd5..43f552e 100644
--- a/man/percent.Rd
+++ b/man/percent.Rd
@@ -36,8 +36,6 @@ significant digit rounding that \code{format.default()} uses.
 }
 }
 \examples{
-library(phsmethods)
-
 # Convert proportions to percentages
 as_percent(seq(0, 1, 0.1))
 

From 9a7b634795e8190fa1d3660fe0e4b29ddb39d8ef Mon Sep 17 00:00:00 2001
From: nicolc11 <nicolaos.christofidis@phs.scot>
Date: Tue, 27 Aug 2024 14:43:07 +0100
Subject: [PATCH 08/12] Updated sign method for percent.

---
 R/percent.R | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/R/percent.R b/R/percent.R
index 07b0d15..3132e34 100644
--- a/R/percent.R
+++ b/R/percent.R
@@ -171,7 +171,10 @@ Math.percent <- function(x, ...){
                           `round` =,
                           `signif` = TRUE, FALSE)
   x <- unclass(x)
-  if (rounding_math){
+
+  if (switch(.Generic, `sign` = TRUE, FALSE)){
+    NextMethod(.Generic)
+  } else if (rounding_math){
     x <- x * 100
     if (.Generic == "round"){
       out <- do.call(round_half_up, list(x, ...))

From 61e5d79d86fd63c718600a476675e7a84a4d12a9 Mon Sep 17 00:00:00 2001
From: nicolc11 <nicolaos.christofidis@phs.scot>
Date: Tue, 27 Aug 2024 15:14:46 +0100
Subject: [PATCH 09/12] Better error checking.

---
 R/percent.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/percent.R b/R/percent.R
index 3132e34..9acf726 100644
--- a/R/percent.R
+++ b/R/percent.R
@@ -62,8 +62,8 @@
 #' @export
 #' @rdname percent
 as_percent <- function(x){
-  if (!is.numeric(x)){
-    stop("x must be a numeric vector of proportions")
+  if (!identical(class(x), "numeric")){
+    cli::cli_abort("{.arg x} must be a {.cls numeric} vector, not a {.cls {class(x)}} vector.")
   }
   new_percent(x)
 }

From b9a9151ab0ab2a89e8f3527b929c2ab4e93f60f9 Mon Sep 17 00:00:00 2001
From: nicolc11 <nicolaos.christofidis@phs.scot>
Date: Tue, 27 Aug 2024 15:16:50 +0100
Subject: [PATCH 10/12] Better error checking part II.

---
 R/percent.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/percent.R b/R/percent.R
index 9acf726..a4334a5 100644
--- a/R/percent.R
+++ b/R/percent.R
@@ -62,7 +62,7 @@
 #' @export
 #' @rdname percent
 as_percent <- function(x){
-  if (!identical(class(x), "numeric")){
+  if (!(identical(class(x), "integer") || identical(class(x), "numeric"))){
     cli::cli_abort("{.arg x} must be a {.cls numeric} vector, not a {.cls {class(x)}} vector.")
   }
   new_percent(x)

From ff4093cf1b9b08739f3d740253bdf2ba95be1fdf Mon Sep 17 00:00:00 2001
From: nicolc11 <nicolaos.christofidis@phs.scot>
Date: Wed, 20 Nov 2024 10:40:22 +0000
Subject: [PATCH 11/12] Make sure as.character is used.

---
 R/percent.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/percent.R b/R/percent.R
index a4334a5..3b3455e 100644
--- a/R/percent.R
+++ b/R/percent.R
@@ -90,7 +90,7 @@ signif_half_up <- function(x, digits = 6){
 
 #' @export
 as.character.percent <- function(x, digits = 2, ...){
-  stringr::str_c(unclass(round(x, digits) * 100), "%")
+  stringr::str_c(as.character(unclass(round(x, digits) * 100), ...), "%")
 }
 
 #' @export

From 8c64090816e2e362a0ab7abc27f153d11026f6c7 Mon Sep 17 00:00:00 2001
From: nicolc11 <nicolaos.christofidis@phs.scot>
Date: Mon, 16 Dec 2024 16:08:55 +0000
Subject: [PATCH 12/12] New functionality.

---
 NAMESPACE      |  2 ++
 R/percent.R    | 58 ++++++++++++++++++++++++++++++++++----------------
 R/phsmethods.R |  1 +
 man/percent.Rd | 21 ++++++++++++++----
 4 files changed, 60 insertions(+), 22 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 5c3274b..04a6245 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -9,6 +9,7 @@ S3method(mean,percent)
 S3method(print,percent)
 S3method(rep,percent)
 S3method(unique,percent)
+export(NA_percent_)
 export(age_calculate)
 export(age_from_chi)
 export(age_group)
@@ -31,5 +32,6 @@ export(sex_from_chi)
 importFrom(lifecycle,deprecated)
 importFrom(magrittr,"%<>%")
 importFrom(magrittr,"%>%")
+importFrom(rlang,"%||%")
 importFrom(rlang,.data)
 importFrom(tibble,tibble)
diff --git a/R/percent.R b/R/percent.R
index 3b3455e..9596840 100644
--- a/R/percent.R
+++ b/R/percent.R
@@ -6,10 +6,14 @@
 #' printing of proportions as percentages. \cr
 #' It aims to remove the need for creating character vectors of percentages.
 #'
-#' @param x [`numeric`] vector of proportions.
+#' @param x `[numeric]` vector of proportions.
+#' @param digits `[numeric(1)]` - The number of digits that will be used for
+#' formatting. This is by default 2 and is applied whenever `format()`,
+#'  `as.character()` and `print()` are called. This can also be controlled
+#' directly via `format()`.
 #'
 #' @returns
-#' A class of object `percent`.
+#' An object of class `percent`.
 #'
 #' @details
 #'
@@ -44,7 +48,7 @@
 #'
 #' # We can do basic math operations as usual
 #'
-#' # Order of operations matters
+#' # Order of operations doesn't matter
 #' 10 * as_percent(c(0, 0.5, 2))
 #' as_percent(c(0, 0.5, 2)) * 10
 #'
@@ -59,18 +63,29 @@
 #'   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 (!(identical(class(x), "integer") || identical(class(x), "numeric"))){
+#' @export
+as_percent <- function(x, digits = 2){
+  if (inherits(x, "percent")){
+    return(new_percent(x, digits))
+  }
+  if (!inherits(x, c("numeric", "integer", "logical"))){
     cli::cli_abort("{.arg x} must be a {.cls numeric} vector, not a {.cls {class(x)}} vector.")
   }
-  new_percent(x)
+  new_percent(as.numeric(x), digits = digits)
 }
-new_percent <- function(x){
+#' @rdname percent
+#' @export
+NA_percent_ <- structure(NA_real_, class = "percent", .digits = 2)
+
+new_percent <- function(x, digits = 2){
   class(x) <- "percent"
+  attr(x, ".digits") <- digits
   x
 }
+get_perc_digits <- function(x){
+  attr(x, ".digits") %||% 2
+}
 round_half_up <- function(x, digits = 0){
   if (is.null(digits) || (length(digits) == 1 && digits == Inf)){
     return(x)
@@ -89,13 +104,18 @@ signif_half_up <- function(x, digits = 6){
 }
 
 #' @export
-as.character.percent <- function(x, digits = 2, ...){
-  stringr::str_c(as.character(unclass(round(x, digits) * 100), ...), "%")
+as.character.percent <- function(x, digits = get_perc_digits(x), ...){
+  out <- stringr::str_c(
+    format(unclass(round(x, digits) * 100), trim = TRUE, digits = NULL),
+    "%"
+  )
+  out[is.na(x)] <- NA
+  out
 }
 
 #' @export
 format.percent <- function(x, symbol = "%", trim = TRUE,
-                           digits = 2,
+                           digits = get_perc_digits(x),
                            ...){
   out <- stringr::str_c(
     format(unclass(round(x, digits) * 100), trim = trim, digits = NULL, ...),
@@ -108,7 +128,7 @@ format.percent <- function(x, symbol = "%", trim = TRUE,
 
 #' @export
 print.percent <- function(x, max = NULL, trim = TRUE,
-                          digits = 2,
+                          digits = get_perc_digits(x),
                           ...){
   out <- x
   N <- length(out)
@@ -140,16 +160,17 @@ print.percent <- function(x, max = NULL, trim = TRUE,
   class(x) <- NULL
   out <- NextMethod("[")
   class(out) <- cl
+  attr(out, ".digits") <- get_perc_digits(x)
   out
 }
 
 #' @export
-unique.percent <- function(x, incomparables = FALSE,
-                           fromLast = FALSE, nmax = NA, ...){
+unique.percent <- function(x, incomparables = FALSE, ...){
   cl <- oldClass(x)
   class(x) <- NULL
   out <- NextMethod("unique")
   class(out) <- cl
+  attr(out, ".digits") <- get_perc_digits(x)
   out
 }
 
@@ -159,6 +180,7 @@ rep.percent <- function(x, ...){
   class(x) <- NULL
   out <- NextMethod("rep")
   class(out) <- cl
+  attr(out, ".digits") <- get_perc_digits(x)
   out
 }
 
@@ -183,10 +205,10 @@ Math.percent <- function(x, ...){
     } else {
       out <- NextMethod(.Generic)
     }
-    new_percent(out / 100)
+    new_percent(out / 100, get_perc_digits(x))
   } else {
     out <- NextMethod(.Generic)
-    new_percent(out)
+    new_percent(out, get_perc_digits(x))
   }
 }
 #' @export
@@ -200,11 +222,11 @@ Summary.percent <- function(x, ...){
   x <- unclass(x)
   out <- NextMethod(.Generic)
   if (summary_math){
-    out <- new_percent(out)
+    out <- new_percent(out, get_perc_digits(x))
   }
   out
 }
 #' @export
 mean.percent <- function(x, ...){
-  new_percent(mean(unclass(x), ...))
+  new_percent(mean(unclass(x), ...), get_perc_digits(x))
 }
diff --git a/R/phsmethods.R b/R/phsmethods.R
index 8197566..9b6b8e9 100644
--- a/R/phsmethods.R
+++ b/R/phsmethods.R
@@ -10,6 +10,7 @@
 #' @importFrom magrittr %>%
 #' @importFrom magrittr %<>%
 #' @importFrom rlang .data
+#' @importFrom rlang %||%
 #' @importFrom tibble tibble
 #' @importFrom lifecycle deprecated
 NULL
diff --git a/man/percent.Rd b/man/percent.Rd
index 43f552e..1cf1c13 100644
--- a/man/percent.Rd
+++ b/man/percent.Rd
@@ -1,16 +1,28 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/percent.R
+\docType{data}
 \name{as_percent}
 \alias{as_percent}
+\alias{NA_percent_}
 \title{Percentages}
+\format{
+An object of class \code{percent} of length 1.
+}
 \usage{
-as_percent(x)
+as_percent(x, digits = 2)
+
+NA_percent_
 }
 \arguments{
-\item{x}{\code{\link{numeric}} vector of proportions.}
+\item{x}{\verb{[numeric]} vector of proportions.}
+
+\item{digits}{\verb{[numeric(1)]} - The number of digits that will be used for
+formatting. This is by default 2 and is applied whenever \code{format()},
+\code{as.character()} and \code{print()} are called. This can also be controlled
+directly via \code{format()}.}
 }
 \value{
-A class of object \code{percent}.
+An object of class \code{percent}.
 }
 \description{
 \code{percent} is a lightweight S3 class allowing for pretty
@@ -51,7 +63,7 @@ ceiling(p2)
 
 # We can do basic math operations as usual
 
-# Order of operations matters
+# Order of operations doesn't matter
 10 * as_percent(c(0, 0.5, 2))
 as_percent(c(0, 0.5, 2)) * 10
 
@@ -67,3 +79,4 @@ starwars \%>\%
   arrange(desc(perc))  \%>\% # We can do numeric sorting with percent vectors
   mutate(perc_rounded = round(perc))
 }
+\keyword{datasets}