diff --git a/NEWS.md b/NEWS.md index 49b2ac7..72aaede 100644 --- a/NEWS.md +++ b/NEWS.md @@ -129,3 +129,5 @@ * Fixed bug when `sel_group` is used in a split (#40). * Stack flowcharts with `unite=TRUE` if there are more boxes in the last level of the first flowchart than in the first level of the second flowchart. + +* Fixed `bug` allowing trailing zeros to be trimmed regardless of `round_digits` argument in `fc_filter()` and `fc_split()` (@kenkomodo) \ No newline at end of file diff --git a/R/fc_filter.R b/R/fc_filter.R index f4fd875..fca6217 100644 --- a/R/fc_filter.R +++ b/R/fc_filter.R @@ -13,6 +13,7 @@ #' @param text_pattern_exc Character or expression defining the structure that will have the text in the exclude box. It recognizes label, n, N and perc within brackets. For default it is "\{label\}\\n \{n\} (\{perc\}\%)". If text_pattern or label is an expression, the label is always placed at the beginning of the pattern, followed by a line break where the structure specified by text_pattern_exc is placed. #' @param sel_group Select the group in which to perform the filter. The default is NULL. Can only be used if the flowchart has previously been split. If the flowchart has more than one group, it can either be given the full name as it is stored in the `$fc` component (separated by '\\'), or it can be given as a vector with the names of each group to be selected. #' @param round_digits Number of digits to round percentages. It is 2 by default. +#' @param trim_trailing_zeros Logical value. If `TRUE`, allows trailing zeros after the decimal to be trimmed (default is `FALSE`). #' @param just Justification for the text: left, center or right. Default is center. #' @param text_color Color of the text. It is black by default. See the `col` parameter for \code{\link{gpar}}. #' @param text_fs Font size of the text. It is 8 by default. See the `fontsize` parameter for \code{\link{gpar}}. @@ -44,7 +45,7 @@ #' #' @export -fc_filter <- function(object, filter = NULL, N = NULL, label = NULL, text_pattern = "{label}\n {n} ({perc}%)", perc_total = FALSE, show_exc = FALSE, direction_exc = "right", label_exc = "Excluded", text_pattern_exc = "{label}\n {n} ({perc}%)", sel_group = NULL, round_digits = 2, just = "center", text_color = "black", text_fs = 8, text_fface = 1, text_ffamily = NA, text_padding = 1, bg_fill = "white", border_color = "black", width = NA, height = NA, just_exc = "center", text_color_exc = "black", text_fs_exc = 6, text_fface_exc = 1, text_ffamily_exc = NA, text_padding_exc = 1, bg_fill_exc = "white", border_color_exc = "black", offset_exc = NULL, width_exc = NA, height_exc = NA) { +fc_filter <- function(object, filter = NULL, N = NULL, label = NULL, text_pattern = "{label}\n {n} ({perc}%)", perc_total = FALSE, show_exc = FALSE, direction_exc = "right", label_exc = "Excluded", text_pattern_exc = "{label}\n {n} ({perc}%)", sel_group = NULL, round_digits = 2, trim_trailing_zeros = FALSE, just = "center", text_color = "black", text_fs = 8, text_fface = 1, text_ffamily = NA, text_padding = 1, bg_fill = "white", border_color = "black", width = NA, height = NA, just_exc = "center", text_color_exc = "black", text_fs_exc = 6, text_fface_exc = 1, text_ffamily_exc = NA, text_padding_exc = 1, bg_fill_exc = "white", border_color_exc = "black", offset_exc = NULL, width_exc = NA, height_exc = NA) { is_class(object, "fc") UseMethod("fc_filter") @@ -55,7 +56,7 @@ fc_filter <- function(object, filter = NULL, N = NULL, label = NULL, text_patter #' @importFrom rlang .data #' @importFrom rlang := -fc_filter.fc <- function(object, filter = NULL, N = NULL, label = NULL, text_pattern = "{label}\n {n} ({perc}%)", perc_total = FALSE, show_exc = FALSE, direction_exc = "right", label_exc = "Excluded", text_pattern_exc = "{label}\n {n} ({perc}%)", sel_group = NULL, round_digits = 2, just = "center", text_color = "black", text_fs = 8, text_fface = 1, text_ffamily = NA, text_padding = 1, bg_fill = "white", border_color = "black", width = NA, height = NA, just_exc = "center", text_color_exc = "black", text_fs_exc = 6, text_fface_exc = 1, text_ffamily_exc = NA, text_padding_exc = 1, bg_fill_exc = "white", border_color_exc = "black", offset_exc = NULL, width_exc = NA, height_exc = NA) { +fc_filter.fc <- function(object, filter = NULL, N = NULL, label = NULL, text_pattern = "{label}\n {n} ({perc}%)", perc_total = FALSE, show_exc = FALSE, direction_exc = "right", label_exc = "Excluded", text_pattern_exc = "{label}\n {n} ({perc}%)", sel_group = NULL, round_digits = 2, trim_trailing_zeros = FALSE, just = "center", text_color = "black", text_fs = 8, text_fface = 1, text_ffamily = NA, text_padding = 1, bg_fill = "white", border_color = "black", width = NA, height = NA, just_exc = "center", text_color_exc = "black", text_fs_exc = 6, text_fface_exc = 1, text_ffamily_exc = NA, text_padding_exc = 1, bg_fill_exc = "white", border_color_exc = "black", offset_exc = NULL, width_exc = NA, height_exc = NA) { filter <- paste(deparse(substitute(filter)), collapse = "") filter <- gsub(" ", "", filter) @@ -242,7 +243,7 @@ fc_filter.fc <- function(object, filter = NULL, N = NULL, label = NULL, text_pat new_fc <- new_fc |> dplyr::mutate( y = NA, - perc = round(.data$n*100/.data$N_total, round_digits), + perc = format_percentage(.data$n*100/.data$N_total, round_digits, trim_trailing_zeros), type = "filter", just = just, text_color = text_color, diff --git a/R/fc_split.R b/R/fc_split.R index ed38f46..9b9f915 100644 --- a/R/fc_split.R +++ b/R/fc_split.R @@ -11,6 +11,7 @@ #' @param na.rm logical. Should missing values of the grouping variable be removed? Default is FALSE. #' @param show_zero logical. Should the levels of the grouping variable that don't have data be shown? Default is FALSE. #' @param round_digits Number of digits to round percentages. It is 2 by default. +#' @param trim_trailing_zeros Logical value. If `TRUE`, allows trailing zeros after the decimal to be trimmed (default is `FALSE`). #' @param just Justification for the text: left, center or right. Default is center. #' @param text_color Color of the text. It is black by default. #' @param text_fs Font size of the text. It is 8 by default. @@ -43,7 +44,7 @@ #' #' @export -fc_split <- function(object, var = NULL, N = NULL, label = NULL, text_pattern = "{label}\n {n} ({perc}%)", perc_total = FALSE, sel_group = NULL, na.rm = FALSE, show_zero = FALSE, round_digits = 2, just = "center", text_color = "black", text_fs = 8, text_fface = 1, text_ffamily = NA, text_padding = 1, bg_fill = "white", border_color = "black", width = NA, height = NA, title = NULL, text_color_title = "black", text_fs_title = 10, text_fface_title = 1, text_ffamily_title = NA, text_padding_title = 0.6, bg_fill_title = "white", border_color_title = "black", width_title = NA, height_title = NA, offset = NULL) { +fc_split <- function(object, var = NULL, N = NULL, label = NULL, text_pattern = "{label}\n {n} ({perc}%)", perc_total = FALSE, sel_group = NULL, na.rm = FALSE, show_zero = FALSE, round_digits = 2, trim_trailing_zeros = FALSE, just = "center", text_color = "black", text_fs = 8, text_fface = 1, text_ffamily = NA, text_padding = 1, bg_fill = "white", border_color = "black", width = NA, height = NA, title = NULL, text_color_title = "black", text_fs_title = 10, text_fface_title = 1, text_ffamily_title = NA, text_padding_title = 0.6, bg_fill_title = "white", border_color_title = "black", width_title = NA, height_title = NA, offset = NULL) { is_class(object, "fc") UseMethod("fc_split") @@ -54,7 +55,7 @@ fc_split <- function(object, var = NULL, N = NULL, label = NULL, text_pattern = #' @export #' @importFrom rlang .data -fc_split.fc <- function(object, var = NULL, N = NULL, label = NULL, text_pattern = "{label}\n {n} ({perc}%)", perc_total = FALSE, sel_group = NULL, na.rm = FALSE, show_zero = FALSE, round_digits = 2, just = "center", text_color = "black", text_fs = 8, text_fface = 1, text_ffamily = NA, text_padding = 1, bg_fill = "white", border_color = "black", width = NA, height = NA, title = NULL, text_color_title = "black", text_fs_title = 10, text_fface_title = 1, text_ffamily_title = NA, text_padding_title = 0.6, bg_fill_title = "white", border_color_title = "black", width_title = NA, height_title = NA, offset = NULL) { +fc_split.fc <- function(object, var = NULL, N = NULL, label = NULL, text_pattern = "{label}\n {n} ({perc}%)", perc_total = FALSE, sel_group = NULL, na.rm = FALSE, show_zero = FALSE, round_digits = 2, trim_trailing_zeros = FALSE, just = "center", text_color = "black", text_fs = 8, text_fface = 1, text_ffamily = NA, text_padding = 1, bg_fill = "white", border_color = "black", width = NA, height = NA, title = NULL, text_color_title = "black", text_fs_title = 10, text_fface_title = 1, text_ffamily_title = NA, text_padding_title = 0.6, bg_fill_title = "white", border_color_title = "black", width_title = NA, height_title = NA, offset = NULL) { var <- substitute(var) @@ -254,7 +255,7 @@ fc_split.fc <- function(object, var = NULL, N = NULL, label = NULL, text_pattern dplyr::mutate( x = NA, y = NA, - perc = round(.data$n*100/.data$N_total, round_digits), + perc = format_percentage(.data$n*100/.data$N_total, round_digits, trim_trailing_zeros), type = "split", just = just, text_color = text_color, diff --git a/R/utils.R b/R/utils.R index fa3b416..9dcccc5 100644 --- a/R/utils.R +++ b/R/utils.R @@ -357,3 +357,21 @@ update_numbers <- function(object, big.mark = "") { return(object) } + + +#' @title format_percentage +#' @description rounds percentage values while allowing the option to `trim_trailing_zeros` +#' +#'@param value numeric; percentage value to be rounded +#'@param round_digits integer; number of digits past the decimal to round to +#'@param trim_trailing_zeros logical; trim trailing zeros or not in returned value. +#'@keywords internal +#' +format_percentage <- function(value, round_digits, trim_trailing_zeros) { + rounded_perc <- round(value, round_digits) + if (trim_trailing_zeros) { + return(rounded_perc) + } else { + return(prettyNum(rounded_perc, nsmall = round_digits)) + } +} diff --git a/man/fc_filter.Rd b/man/fc_filter.Rd index 17a369e..f15b911 100644 --- a/man/fc_filter.Rd +++ b/man/fc_filter.Rd @@ -17,6 +17,7 @@ fc_filter( text_pattern_exc = "{label}\\n {n} ({perc}\%)", sel_group = NULL, round_digits = 2, + trim_trailing_zeros = FALSE, just = "center", text_color = "black", text_fs = 8, @@ -65,6 +66,8 @@ fc_filter( \item{round_digits}{Number of digits to round percentages. It is 2 by default.} +\item{trim_trailing_zeros}{Logical value. If `TRUE`, allows trailing zeros after the decimal to be trimmed (default is `FALSE`).} + \item{just}{Justification for the text: left, center or right. Default is center.} \item{text_color}{Color of the text. It is black by default. See the `col` parameter for \code{\link{gpar}}.} diff --git a/man/fc_split.Rd b/man/fc_split.Rd index c7613db..001adc5 100644 --- a/man/fc_split.Rd +++ b/man/fc_split.Rd @@ -15,6 +15,7 @@ fc_split( na.rm = FALSE, show_zero = FALSE, round_digits = 2, + trim_trailing_zeros = FALSE, just = "center", text_color = "black", text_fs = 8, @@ -59,6 +60,8 @@ fc_split( \item{round_digits}{Number of digits to round percentages. It is 2 by default.} +\item{trim_trailing_zeros}{Logical value. If `TRUE`, allows trailing zeros after the decimal to be trimmed (default is `FALSE`).} + \item{just}{Justification for the text: left, center or right. Default is center.} \item{text_color}{Color of the text. It is black by default.} diff --git a/man/format_percentage.Rd b/man/format_percentage.Rd new file mode 100644 index 0000000..692e879 --- /dev/null +++ b/man/format_percentage.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{format_percentage} +\alias{format_percentage} +\title{format_percentage} +\usage{ +format_percentage(value, round_digits, trim_trailing_zeros) +} +\arguments{ +\item{value}{numeric; percentage value to be rounded} + +\item{round_digits}{integer; number of digits past the decimal to round to} + +\item{trim_trailing_zeros}{logical; trim trailing zeros or not in returned value.} +} +\description{ +rounds percentage values while allowing the option to `trim_trailing_zeros` +} +\keyword{internal} diff --git a/tests/testthat/test-fc_split.R b/tests/testthat/test-fc_split.R index ca58c11..aedf6df 100644 --- a/tests/testthat/test-fc_split.R +++ b/tests/testthat/test-fc_split.R @@ -32,7 +32,7 @@ test_that("handles sel_group in a split", { ) expect_no_error(fc |> fc_draw()) expect_equal(nrow(fc$fc), 5) - expect_equal(fc$fc$text[5], "group 2\n10 (25%)") + expect_equal(fc$fc$text[5], "group 2\n10 (25.00%)") }) test_that("handles split after a sel_group", {