-
Notifications
You must be signed in to change notification settings - Fork 3
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
*
f_replace
added as a ggplot2 scale gsub
convenience function.
* `f_title` added as a ggplot2 scale `tools::toTitleCase` convenience function. * `f_title` added as a ggplot2 scale `strwrap` + `paste(collapse =TRUE)` convenience function.
- Loading branch information
Tyler Rinker
committed
Aug 30, 2017
1 parent
8535525
commit 7d43a42
Showing
14 changed files
with
682 additions
and
169 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,33 @@ | ||
#' Replace Characters in Strings | ||
#' | ||
#' A wrapper for \code{\link[base]{gsub}} for replacing substrings that is | ||
#' useful for \pkg{ggplot2} scales. Useful for taking field names like | ||
#' 'Cool_Variable' and turning it into 'Cool Variable'. | ||
#' | ||
#' @param x A vector of text strings. | ||
#' @param pattern A character string defining search patterns. | ||
#' @param replacement A character string defining replacement patterns. | ||
#' @param \ldots Other arguments passed to \code{\link[base]{gsub}}. | ||
#' @return Returns a string vector with characters replaced. | ||
#' @rdname f_replace | ||
#' @export | ||
#' @seealso \code{\link[base]{strwrap}} | ||
#' @examples | ||
#' f_replace('Cool_Variable') | ||
#' f_title(f_replace('cool_variable')) | ||
#' f_replace('Cool_Variable', pattern = '([A-Z])', replacement = '\\L\\1') | ||
#' cat(f_replace('really long label names are the pits', | ||
#' pattern = '\\s', replace = '\n')) | ||
f_replace <- function (x, pattern = '_', replacement = ' ', ...) { | ||
|
||
gsub(pattern, replacement, x, perl = TRUE, ...) | ||
|
||
} | ||
|
||
|
||
#' @export | ||
#' @include utils.R | ||
#' @rdname f_replace | ||
ff_replace <- functionize(f_replace) | ||
|
||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,111 @@ | ||
#' Convert First Letter of Words to Title Case | ||
#' | ||
#' A wrapper for \code{\link[tools]{toTitleCase}} converting text to title case. | ||
#' | ||
#' @param x A vector of text strings. | ||
#' @param \ldots ignored. | ||
#' @return Returns a string vector with characters replaced. | ||
#' @rdname f_title | ||
#' @export | ||
#' @seealso \code{\link[tools]{toTitleCase}} | ||
#' @examples | ||
#' f_title('i love this title') | ||
#' f_title(f_title('Cool_Variable')) | ||
#' | ||
#' \dontrun{ | ||
#' library(tidyverse) | ||
#' | ||
#' set.seed(10) | ||
#' dat <- data_frame( | ||
#' level = c("not_involved", "somewhat_involved_single_group", | ||
#' "somewhat_involved_multiple_groups", "very_involved_one_group", | ||
#' "very_involved_multiple_groups" | ||
#' ), | ||
#' n = sample(1:10, length(level)) | ||
#' ) %>% | ||
#' mutate( | ||
#' level = factor(level, levels = unique(level)), | ||
#' `%` = n/sum(n) | ||
#' ) | ||
#' | ||
#' gridExtra::grid.arrange( | ||
#' | ||
#' gridExtra::arrangeGrob( | ||
#' | ||
#' dat %>% | ||
#' ggplot(aes(level, `%`)) + | ||
#' geom_col() + | ||
#' labs(title = 'Very Sad', y = NULL) + | ||
#' theme( | ||
#' axis.text = element_text(size = 7), | ||
#' title = element_text(size = 9) | ||
#' ), | ||
#' | ||
#' dat %>% | ||
#' ggplot(aes(level, `%`)) + | ||
#' geom_col() + | ||
#' scale_x_discrete(labels = function(x) f_replace(x, '_', '\n')) + | ||
#' scale_y_continuous(labels = ff_prop2percent(digits = 0)) + | ||
#' labs(title = 'Underscore Split (Readable)', y = NULL) + | ||
#' theme( | ||
#' axis.text = element_text(size = 7), | ||
#' title = element_text(size = 9) | ||
#' ), | ||
#' | ||
#' | ||
#' ncol = 2 | ||
#' | ||
#' ), | ||
#' gridExtra::arrangeGrob( | ||
#' | ||
#' dat %>% | ||
#' ggplot(aes(level, `%`)) + | ||
#' geom_col() + | ||
#' scale_x_discrete(labels = function(x) f_title(f_replace(x))) + | ||
#' scale_y_continuous(labels = ff_prop2percent(digits = 0)) + | ||
#' labs(title = 'Underscore Replaced & Title (Capitalized Sadness)', y = NULL) + | ||
#' theme( | ||
#' axis.text = element_text(size = 7), | ||
#' title = element_text(size = 9) | ||
#' ), | ||
#' | ||
#' dat %>% | ||
#' ggplot(aes(level, `%`)) + | ||
#' geom_col() + | ||
#' scale_x_discrete(labels = function(x) f_wrap(f_title(f_replace(x)))) + | ||
#' scale_y_continuous(labels = ff_prop2percent(digits = 0)) + | ||
#' labs(title = 'Underscore Replaced, Title, & Wrapped (Happy)', y = NULL) + | ||
#' theme( | ||
#' axis.text = element_text(size = 7), | ||
#' title = element_text(size = 9) | ||
#' ), | ||
#' | ||
#' ncol = 2 | ||
#' | ||
#' ), ncol = 1 | ||
#' | ||
#' ) | ||
#' | ||
#' } | ||
f_title <- function (x, ...) { | ||
|
||
nas <- is.na(x) | ||
out <- gsub('(^.)', '\\U\\1', tools::toTitleCase(x), perl = TRUE) | ||
|
||
out[nas] <- NA | ||
out | ||
|
||
} | ||
|
||
|
||
#' @export | ||
#' @include utils.R | ||
#' @rdname f_title | ||
ff_title <- functionize(f_title) | ||
|
||
|
||
|
||
|
||
|
||
|
||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,73 @@ | ||
#' Wrap Strings | ||
#' | ||
#' Wrap strings by splitting n width, and paste collapsing with new line | ||
#' characters. | ||
#' | ||
#' @param x A vector of text strings. | ||
#' @param width A positive integer giving the target column for wrapping lines | ||
#' in the output. | ||
#' @param exdent A non-negative integer specifying the indentation of subsequent | ||
#' lines in paragraphs. | ||
#' @param indent A non-negative integer giving the indentation of the first line | ||
#' in a paragraph. | ||
#' @param \ldots Other arguments passed to \code{\link[base]{strwrap}}. | ||
#' @return Returns a string vector with wrapped new line characters. | ||
#' @rdname f_wrap | ||
#' @export | ||
#' @seealso \code{\link[base]{strwrap}} | ||
#' @examples | ||
#' cat(f_wrap('really long label names are the pits')) | ||
#' cat(f_wrap('really long label names are the pits', width = 20, exdent = 2)) | ||
#' | ||
#' \dontrun{ | ||
#' library(tidyverse); library(gridExtra) | ||
#' | ||
#' set.seed(10) | ||
#' dat <- data_frame( | ||
#' level = c('Not Involved', 'Somewhat Involved Single Group', | ||
#' 'Somewhat Involved Multiple Groups', 'Very Involved One Group', | ||
#' 'Very Involved Multiple Groups' | ||
#' ), | ||
#' n = sample(1:10, length(level)) | ||
#' ) %>% | ||
#' mutate( | ||
#' level = factor(level, levels = unique(level)), | ||
#' `%` = n/sum(n) | ||
#' ) | ||
#' | ||
#' gridExtra::grid.arrange( | ||
#' dat %>% | ||
#' ggplot(aes(level, `%`)) + | ||
#' geom_col() + | ||
#' labs(title = 'Yucky Labels', y = NULL), | ||
#' | ||
#' dat %>% | ||
#' ggplot(aes(level, `%`)) + | ||
#' geom_col() + | ||
#' scale_x_discrete(labels = f_wrap) + | ||
#' scale_y_continuous(labels = ff_prop2percent(digits = 0)) + | ||
#' labs(title = 'Happy Labels', y = NULL), | ||
#' | ||
#' ncol = 1, heights = c(.45, .55) | ||
#' ) | ||
#' | ||
#' } | ||
f_wrap <- function (x, width = 15, exdent = 0, indent = 0, ...) { | ||
|
||
nas <- is.na(x) | ||
out <- unlist(lapply(x, function(y) { | ||
paste( | ||
strwrap(y, width = width, exdent = exdent, indent = indent, ...), | ||
collapse = "\n" | ||
) | ||
})) | ||
out[nas] <- NA | ||
out | ||
|
||
} | ||
|
||
|
||
#' @export | ||
#' @include utils.R | ||
#' @rdname f_wrap | ||
ff_wrap <- functionize(f_wrap) |
Oops, something went wrong.