Reputation: 753
I'm working on a package that will make it easier for other users at my company to use ggplot2. One of the things I would like to do is to add a function that automatically formats ugly variable names to pretty titles.
I have a function that does this already. Let's assume there's some dummy data and a basic plot:
data <- data.frame(
place_name = c("Los Angeles","New York"),
some_amount = c(5,10)
)
g <- ggplot(data, aes(x = place_name, y = some_amount)) +
geom_bar(stat = 'identity') +
labs(title = "test_of_function")
So I have my ggplot, and I want to format the titles. This function works fine once I apply it to the labels of a function.
format_title <- function(...,sep = "[^[:alnum:]]+"){
args <- list(...)
if (is.list(args[[1]]))
args <- args[[1]]
lapply(args, function(x, sep){
stringr::str_to_title(stringr::str_replace_all(x,sep," "))
}, sep = sep)
}
format_plot_titles <- function(g){
g$labels <- format_title(g$labels)
g
}
So now if we compare them:
g
format_plot_titles(g)
What I was hoping to do is add it via the ggplot2 +
, but in order to do that I need access to what the previous labels of the plot were.
It would look something like this (with better names):
ggplot(data, aes(x = place_name, y = some_amount)) +
geom_bar() +
title_labels()
I'm having a lot of trouble figuring out how to access the labels of the previous plot as I attempt to layer the new labels on top of the old one. Any help is appreciated!
Edit: Solved this. There was no slick solution though. I basically had to overwrite the default s3 method for the +
that ggplot2 exports to take in a new type of object I'm calling a "formatter". This allows me to construct a method that checks for the formatter class, and if my object does inherit the formatter class, it applies that formatter to the plot labels. Here's the code:
`+.gg` <- function (e1, e2) {
e2name <- deparse(substitute(e2))
if (ggplot2::is.theme(e1))
ggplot2:::add_theme(e1, e2, e2name)
else if (ggplot2::is.ggplot(e1) & is.formatter(e2)){
add_formatter(e1, e2, e2name)
}
else if (ggplot2::is.ggplot(e1))
ggplot2:::add_ggplot(e1, e2, e2name)
}
update_format <- function(p, formatter){
p <- ggplot2:::plot_clone(p)
p$labels <- formatter(p$labels)
p
}
add_formatter <- function(p, formatter, objectname) {
update_format(p, formatter)
}
is.formatter <- function(x){
inherits(x,"formatter")
}
format_title <- function(...,sep = "[^[:alnum:]]+"){
args <- list(...)
if (is.list(args[[1]]))
args <- args[[1]]
lapply(args, function(x, sep){
stringr::str_to_title(stringr::str_replace_all(x,sep," "))
}, sep = sep)
}
title_labels <- function(...){
structure(format_title, class = "formatter")
}
ggplot(data, aes(x = place_name, y = some_amount)) +
geom_bar(stat = 'identity') +
title_labels()
Upvotes: 1
Views: 186
Reputation: 753
Posting edit as a formal answer.
Solved this. There was no slick solution though. I basically had to overwrite the default s3 method for the + that ggplot2 exports to take in a new type of object I'm calling a "formatter". This allows me to construct a method that checks for the formatter class, and if my object does inherit the formatter class, it applies that formatter to the plot labels. Here's the code:
`+.gg` <- function (e1, e2) {
e2name <- deparse(substitute(e2))
if (ggplot2::is.theme(e1))
ggplot2:::add_theme(e1, e2, e2name)
else if (ggplot2::is.ggplot(e1) & is.formatter(e2)){
add_formatter(e1, e2, e2name)
}
else if (ggplot2::is.ggplot(e1))
ggplot2:::add_ggplot(e1, e2, e2name)
}
update_format <- function(p, formatter){
p <- ggplot2:::plot_clone(p)
p$labels <- formatter(p$labels)
p
}
add_formatter <- function(p, formatter, objectname) {
update_format(p, formatter)
}
is.formatter <- function(x){
inherits(x,"formatter")
}
format_title <- function(...,sep = "[^[:alnum:]]+"){
args <- list(...)
if (is.list(args[[1]]))
args <- args[[1]]
lapply(args, function(x, sep){
stringr::str_to_title(stringr::str_replace_all(x,sep," "))
}, sep = sep)
}
title_labels <- function(...){
structure(format_title, class = "formatter")
}
ggplot(data, aes(x = place_name, y = some_amount)) +
geom_bar(stat = 'identity') +
title_labels()
Upvotes: 2