Improve pretty num

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
+  )
 }

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,90 +202,114 @@ 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)
 #' 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")
 pretty_num <- function(
     value,
     prefix = "",
     gbp = FALSE,
     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))
 }

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")
   )
 })