be_green
be_green

Reputation: 753

Adding Title Formatter to ggplot2

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

enter image description here

format_plot_titles(g)

enter image description here

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

Answers (1)

be_green
be_green

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

Related Questions