-
Notifications
You must be signed in to change notification settings - Fork 8
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Fmt prop bug #61
base: main
Are you sure you want to change the base?
Fmt prop bug #61
Changes from all commits
1bdb76d
aa571b6
ed0db4c
ad3c1ee
23309e7
ec45180
5608e7f
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -168,7 +168,7 @@ fmt_corr <- function(x, digits, output = NULL) { | |
|
||
#' @export | ||
#' @rdname formatting | ||
fmt_prop <- function(x, digits, fmt_small = TRUE, keep_zero = FALSE) { | ||
fmt_prop <- function(x, digits, fmt_small = TRUE, keep_zero = FALSE, output) { | ||
x <- check_bound_real(x, name = "x", lb = 0, ub = 1) | ||
digits <- check_pos_int(digits, name = "digits") | ||
|
||
|
@@ -181,13 +181,15 @@ fmt_prop <- function(x, digits, fmt_small = TRUE, keep_zero = FALSE) { | |
small_text <- small %>% | ||
fmt_digits(digits) %>% | ||
fmt_leading_zero() %>% | ||
paste0_after(.first = "<") | ||
only_if(output == "latex")(paste0_after)(.first = "<") %>% | ||
only_if(output == "html")(paste0_after)(.first = "$\\lt$") | ||
|
||
large <- 1 - small | ||
large_text <- large %>% | ||
fmt_digits(digits) %>% | ||
fmt_leading_zero() %>% | ||
paste0_after(.first = ">") | ||
only_if(output == "latex")(paste0_after)(.first = ">") %>% | ||
only_if(output == "html")(paste0_after)(.first = "$\\gt$") | ||
|
||
x_chr[x < small] <- small_text | ||
x_chr[x > large] <- large_text | ||
|
@@ -202,7 +204,7 @@ fmt_prop <- function(x, digits, fmt_small = TRUE, keep_zero = FALSE) { | |
|
||
#' @export | ||
#' @rdname formatting | ||
fmt_prop_pct <- function(x, digits = 0, fmt_small = TRUE) { | ||
fmt_prop_pct <- function(x, digits = 0, fmt_small = TRUE, output) { | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Provide default value, check provided value. |
||
x <- check_bound_real(x, name = "x", lb = 0, ub = 1) | ||
digits <- check_0_int(digits, name = "digits") | ||
|
||
|
@@ -213,12 +215,14 @@ fmt_prop_pct <- function(x, digits = 0, fmt_small = TRUE) { | |
small <- 1 / (10 ^ digits) | ||
small_text <- small %>% | ||
fmt_digits(digits) %>% | ||
paste0_after(.first = "<") | ||
only_if(output == "latex")(paste0_after)(.first = "<") %>% | ||
only_if(output == "html")(paste0_after)(.first = "$\\lt$") | ||
|
||
large <- 100 - small | ||
large_text <- large %>% | ||
fmt_digits(digits) %>% | ||
paste0_after(.first = ">") | ||
only_if(output == "latex")(paste0_after)(.first = ">") %>% | ||
only_if(output == "html")(paste0_after)(.first = "$\\gt$") | ||
|
||
x_chr[round(x * 100, digits = digits) < small] <- small_text | ||
x_chr[round(x * 100, digits = digits) > large] <- large_text | ||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -153,18 +153,32 @@ pad_prop <- function(x, digits, fmt_small = TRUE, keep_zero = FALSE, | |
digits <- check_pos_int(digits) | ||
output <- check_output(output) | ||
new_x <- fmt_prop(x, digits = digits, fmt_small = fmt_small, | ||
keep_zero = keep_zero) | ||
keep_zero = keep_zero, output = output) | ||
new_x[is.na(new_x)] <- "NA" | ||
|
||
if (any(stringr::str_detect(new_x, "^<|^>")) & | ||
!all(stringr::str_detect(new_x, "^<|^>"))) { | ||
pad <- ifelse(output == "latex", 4, 3) | ||
new_x <- dplyr::case_when(stringr::str_detect(new_x, "^<|^>") ~ | ||
paste0(new_x, paste(rep("\\ ", pad), | ||
collapse = "")), | ||
TRUE ~ new_x) | ||
if(is_html_output()) { | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Why use |
||
if ((any(stringr::str_detect(new_x, "lt")) | | ||
any(stringr::str_detect(new_x, "gt"))) & | ||
!(all(stringr::str_detect(new_x, "lt") | | ||
stringr::str_detect(new_x, "gt")))) { | ||
Comment on lines
+160
to
+163
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Can we compress this? e.g.,
|
||
pad <- ifelse(output == "latex", 4, 3) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This is currently in an I would recommend moving this line of code outside of the HTML/LaTeX if statements, then you just have the |
||
new_x <- dplyr::case_when(stringr::str_detect(new_x, "^<|^>") ~ | ||
paste0(new_x, paste(rep("\\ ", pad), | ||
collapse = "")), | ||
TRUE ~ new_x) | ||
} | ||
} else if (is_latex_output()) { | ||
if (any(stringr::str_detect(new_x, "^<|^>")) & | ||
!all(stringr::str_detect(new_x, "^<|^>"))) { | ||
pad <- ifelse(output == "latex", 4, 3) | ||
new_x <- dplyr::case_when(stringr::str_detect(new_x, "^<|^>") ~ | ||
paste0(new_x, paste(rep("\\ ", pad), | ||
collapse = "")), | ||
TRUE ~ new_x) | ||
} | ||
} | ||
|
||
|
||
if (any(x == 1, na.rm = TRUE)) { | ||
new_x <- dplyr::case_when(stringr::str_detect(new_x, "^1\\.") ~ new_x, | ||
TRUE ~ paste0(paste(rep("\\ ", 2), collapse = ""), | ||
|
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
output should have a default value. Probably
output = NULL
like in thefmt_corr()
andfmt_minus()
functions.Should also check output using
check_output()