From bb09eda8f55258e34f25d94f401faa139ec781d6 Mon Sep 17 00:00:00 2001 From: Menna Date: Tue, 8 Oct 2024 15:56:10 +0100 Subject: [PATCH] Improve pretty num (#89) * added nsmall args to pretty_num and comma_sep to allow formatting of decimals * amended the function so it takes multiple values * updated documenation * fixed the issue with negative dp being passed to nsmall * changed code for testing pretty_num * amended the documentation for comma_sep and changed expected_error to expect_equal in test_pretty_num * fixed the - dp args problem added nsmall to the documentation fixed the lintr styling and complexity errors * added extra tests to pretty_num * fixing formtting issues for lint testing --- R/comma_sep.R | 9 +- R/pretty.R | 143 ++++++++++++++++++------------- man/comma_sep.Rd | 4 +- man/pretty_num.Rd | 13 +-- tests/testthat/test-pretty_num.R | 27 +++--- 5 files changed, 119 insertions(+), 77 deletions(-) diff --git a/R/comma_sep.R b/R/comma_sep.R index f34176f..fbb7758 100644 --- a/R/comma_sep.R +++ b/R/comma_sep.R @@ -5,6 +5,7 @@ #' return the value unchanged and as a string. #' #' @param number number to be comma separated +#' @param nsmall minimum number of digits to the right of the decimal point #' #' @return string #' @export @@ -13,6 +14,10 @@ #' comma_sep(100) #' comma_sep(1000) #' comma_sep(3567000) -comma_sep <- function(number) { - format(number, big.mark = ",", trim = TRUE, scientific = FALSE) +comma_sep <- function(number, + nsmall = 0L) { + format(number, + big.mark = ",", nsmall = nsmall, trim = TRUE, + scientific = FALSE + ) } diff --git a/R/pretty.R b/R/pretty.R index ba848d1..c481727 100644 --- a/R/pretty.R +++ b/R/pretty.R @@ -188,6 +188,7 @@ pretty_time_taken <- function(start_time, end_time) { #' @param ignore_na whether to skip function for strings that can't be #' converted and return original value #' @param alt_na alternative value to return in place of NA, e.g. "x" +#' @param nsmall minimum number of digits to the right of the decimal point #' #' @return string featuring prettified value #' @family prettying @@ -201,6 +202,7 @@ pretty_time_taken <- function(start_time, end_time) { #' pretty_num(567812343223, gbp = TRUE, prefix = "+/-") #' pretty_num(11^9, gbp = TRUE, dp = 3) #' pretty_num(-11^8, gbp = TRUE, dp = -1) +#' pretty_num(43.3, dp = 1, nsmall = 2) #' pretty_num("56.089", suffix = "%") #' pretty_num("x") #' pretty_num("x", ignore_na = TRUE) @@ -208,14 +210,14 @@ pretty_time_taken <- function(start_time, end_time) { #' #' # Applied over an example vector #' vector <- c(3998098008, -123421421, "c", "x") -#' unlist(lapply(vector, pretty_num)) -#' unlist(lapply(vector, pretty_num, prefix = "+/-", gbp = TRUE)) +#' pretty_num(vector) +#' pretty_num(vector, prefix = "+/-", gbp = TRUE) #' #' # Return original values if NA -#' unlist(lapply(vector, pretty_num, ignore_na = TRUE)) +#' pretty_num(vector, ignore_na = TRUE) #' #' # Return alternative value in place of NA -#' unlist(lapply(vector, pretty_num, alt_na = "z")) +#' pretty_num(vector, alt_na = "z") pretty_num <- function( value, prefix = "", @@ -223,68 +225,91 @@ pretty_num <- function( suffix = "", dp = 2, ignore_na = FALSE, - alt_na = FALSE) { - # Check we're only trying to prettify a single value - if (length(value) > 1) { - stop("value must be a single value, multiple values were detected") - } + alt_na = FALSE, + nsmall = NULL) { + # use lapply to use the function for singular value or a vector + + result <- lapply(value, function(value) { + # Force to numeric + num_value <- suppressWarnings(as.numeric(value)) - # Force to numeric - num_value <- suppressWarnings(as.numeric(value)) + # Check if should skip function + if (is.na(num_value)) { + if (ignore_na == TRUE) { + return(value) # return original value + } else if (alt_na != FALSE) { + return(alt_na) # return custom NA value + } else { + return(num_value) # return NA + } + } - # Check if should skip function - if (is.na(num_value)) { - if (ignore_na == TRUE) { - return(value) # return original value - } else if (alt_na != FALSE) { - return(alt_na) # return custom NA value + # Convert GBP to pound symbol + if (gbp == TRUE) { + currency <- "\U00a3" } else { - return(num_value) # return NA + currency <- "" } - } - # Convert GBP to pound symbol - if (gbp == TRUE) { - currency <- "\U00a3" - } else { - currency <- "" - } + # Add + / - symbols depending on size of value + if (prefix == "+/-") { + if (value >= 0) { + prefix <- "+" + } else { + prefix <- "-" + } + # Add in negative symbol if appropriate and not auto added with +/- + } else if (value < 0) { + prefix <- paste0("-", prefix) + } + + # Add suffix and prefix, plus convert to million or billion - # Add + / - symbols depending on size of value - if (prefix == "+/-") { - if (value >= 0) { - prefix <- "+" + # If nsmall is not given, make same value as dp + # if dp is smaller than 0, make nsmall 0 + # if nsmall is specified, use that value + + if (!is.null(nsmall)) { + nsmall <- nsmall + } else if (dp > 0 & is.null(nsmall)) { + nsmall <- dp } else { - prefix <- "-" + nsmall <- 0 } - # Add in negative symbol if appropriate and not auto added with +/- - } else if (value < 0) { - prefix <- paste0("-", prefix) - } - # Add suffix and prefix, plus convert to million or billion - if (abs(num_value) >= 1.e9) { - paste0( - prefix, - currency, - comma_sep(round_five_up(abs(num_value) / 1.e9, dp = dp)), - " billion", - suffix - ) - } else if (abs(num_value) >= 1.e6) { - paste0( - prefix, - currency, - comma_sep(round_five_up(abs(num_value) / 1.e6, dp = dp)), - " million", - suffix - ) - } else { - paste0( - prefix, - currency, - comma_sep(round_five_up(abs(num_value), dp = dp)), - suffix - ) - } + + if (abs(num_value) >= 1.e9) { + paste0( + prefix, + currency, + comma_sep(round_five_up(abs(num_value) / 1.e9, dp = dp), + nsmall = nsmall + ), + " billion", + suffix + ) + } else if (abs(num_value) >= 1.e6) { + paste0( + prefix, + currency, + comma_sep(round_five_up(abs(num_value) / 1.e6, dp = dp), + nsmall = nsmall + ), + " million", + suffix + ) + } else { + paste0( + prefix, + currency, + comma_sep(round_five_up(abs(num_value), dp = dp), + nsmall = nsmall + ), + suffix + ) + } + }) # lapply bracket + + # unlisting the results so that they're all on one line + return(unlist(result)) } diff --git a/man/comma_sep.Rd b/man/comma_sep.Rd index d321a72..f2092f3 100644 --- a/man/comma_sep.Rd +++ b/man/comma_sep.Rd @@ -4,10 +4,12 @@ \alias{comma_sep} \title{Comma separate} \usage{ -comma_sep(number) +comma_sep(number, nsmall = 0L) } \arguments{ \item{number}{number to be comma separated} + +\item{nsmall}{minimum number of digits to the right of the decimal point} } \value{ string diff --git a/man/pretty_num.Rd b/man/pretty_num.Rd index aaeff8e..4436e75 100644 --- a/man/pretty_num.Rd +++ b/man/pretty_num.Rd @@ -11,7 +11,8 @@ pretty_num( suffix = "", dp = 2, ignore_na = FALSE, - alt_na = FALSE + alt_na = FALSE, + nsmall = NULL ) } \arguments{ @@ -30,6 +31,8 @@ assign + or - based on the value} converted and return original value} \item{alt_na}{alternative value to return in place of NA, e.g. "x"} + +\item{nsmall}{minimum number of digits to the right of the decimal point} } \value{ string featuring prettified value @@ -66,14 +69,14 @@ pretty_num("nope", alt_na = "x") # Applied over an example vector vector <- c(3998098008, -123421421, "c", "x") -unlist(lapply(vector, pretty_num)) -unlist(lapply(vector, pretty_num, prefix = "+/-", gbp = TRUE)) +pretty_num(vector) +pretty_num(vector, prefix = "+/-", gbp = TRUE) # Return original values if NA -unlist(lapply(vector, pretty_num, ignore_na = TRUE)) +pretty_num(vector,ignore_na = TRUE) # Return alternative value in place of NA -unlist(lapply(vector, pretty_num, alt_na = "z")) +pretty_num(vector, alt_na = "z") } \seealso{ \code{\link[=comma_sep]{comma_sep()}} \code{\link[=round_five_up]{round_five_up()}} \code{\link[=as.numeric]{as.numeric()}} diff --git a/tests/testthat/test-pretty_num.R b/tests/testthat/test-pretty_num.R index 2cf3180..09892e5 100644 --- a/tests/testthat/test-pretty_num.R +++ b/tests/testthat/test-pretty_num.R @@ -1,17 +1,19 @@ test_that("prettifies", { - expect_equal(pretty_num(1, gbp = TRUE, suffix = " offer"), "£1 offer") - expect_equal(pretty_num(-1), "-1") - expect_equal(pretty_num(-1, prefix = "-"), "--1") - expect_equal(pretty_num(-1, prefix = "+/-"), "-1") - expect_equal(pretty_num(1, prefix = "+/-"), "+1") + expect_equal(pretty_num(1, gbp = TRUE, suffix = " offer"), "£1.00 offer") + expect_equal(pretty_num(-1), "-1.00") + expect_equal(pretty_num(-1, prefix = "-"), "--1.00") + expect_equal(pretty_num(-1, prefix = "+/-"), "-1.00") + expect_equal(pretty_num(1, prefix = "+/-"), "+1.00") expect_equal(pretty_num(12.289009, suffix = "%"), "12.29%") - expect_equal(pretty_num(1000), "1,000") + expect_equal(pretty_num(1000), "1,000.00") expect_equal(pretty_num(11^8, gbp = TRUE, dp = -1), "£210 million") expect_equal(pretty_num(11^9, gbp = TRUE, dp = 3), "£2.358 billion") expect_equal(pretty_num(-11^8, gbp = TRUE, dp = -1), "-£210 million") expect_equal(pretty_num(-123421421), "-123.42 million") + expect_equal(pretty_num(63.71, dp = 1, nsmall = 2), "63.70") + expect_equal(pretty_num(894.1, dp = 2, nsmall = 3), "894.100") expect_equal( - pretty_num(11^8, prefix = "+/-", gbp = TRUE, dp = -1), "+£210 million" + pretty_num(11^8, prefix = "+/-", gbp = TRUE, dp = -1.00), "+£210 million" ) }) @@ -22,9 +24,14 @@ test_that("handles NAs", { expect_equal(pretty_num("x", alt_na = "c"), "c") }) -test_that("rejects multiple values", { - expect_error( +test_that("tests multiple values", { + expect_equal( pretty_num(c(1:4)), - "value must be a single value, multiple values were detected" + c("1.00", "2.00", "3.00", "4.00") + ) + + expect_equal( + pretty_num(c(1:4), nsmall = 1), + c("1.0", "2.0", "3.0", "4.0") ) })