R ggplot subtitles with different size fonts

Question

This is a question that was prompted by the following:

I am trying to replicate a visualization in that each plot of a grid has a title and a subtitle. However, in the example I am trying to replicate, the subtitle (see the last image) shows the main result in slightly larger font than the second part. The format is as such:

99.85% / 2.35 hrs

I'd like the percentage to be larger and the "2.35 hrs" part to be smaller, maybe like 2 sizes or so smaller. The main thing is that the owners of these are measured by percent, but they still ask about the total hours, so I'd like it it be there, just not as emphasized. Adding a trend arrow would be nice too, not sure the best way to do that, but if there are suggestions on that as well, they are welcomed.

I'm not sure if I can do multiple subtitles or if there is a way to format each part of a single subtitle differently. Any suggestions?

I have produced the following code to generate a grid of plots for a report / dashboard:

# Needed Libraries

library(Hmisc)
library(zoo)
library(lubridate)
library(ggplot2)
library(ggthemes)
library(grid)
library(gridExtra)

# Plot Function

metricplot <- function(data = criticalSystemAvailabilityFullDetail, row = 1) {

  # Since data is organized by row, I need to pull only the columns I need 
  # for the particular row (system) specificied. Then turn it into columns
  # since ggplot works best this way.
  ytdMonths <- as.data.frame(names(data)[4:((month(Sys.Date())-1)+3)])
  ytdValue <- t(as.data.frame(data[row,((month(Sys.Date()))+3):(ncol(data)-2)][1,]))
  ytdData <- cbind(ytdMonths, ytdValue)
  names(ytdData)[1] <- "Month"
  names(ytdData)[2] <- "Value"

  # Since I need red, yellow and green for my thresholds, I already have my 
  # target. My rules for this are basically, green until it exceeds 50%
  # of the target, then it turns yellow. Once it exceeds the Target, it turns
  # red. This function is called when the plot is made to determine the background
  # color.
  colour <- function (system = data[row,]) {
    if(data[row,ncol(data)] < as.numeric(strsplit(data[row,2], "%")[[1]][1]) ) {
      return("#fc5e58")
    } else if((data[row,ncol(data)] > as.numeric(strsplit(data[row,2], "%")[[1]][1])) == TRUE & (data[row,ncol(data)] < ((as.numeric(strsplit(data[row,2], "%")[[1]][1]) + 100.00) / 2)) == TRUE) {
      return("#ebc944")
    } else {
      return("#8BC34A")
    }
  }

  # Now for the plot. I have made some slight modifications to this. For example, in the white area that 
  # represents the high and low - I have used 100% for the max and the target for the low. I do this dynamically
  # by using the target from the row (system) I am currently plotting. I adjusted the line size down to 1, since 
  # the preivous value made the line a little too big. 
  plot <- 
    ggplot(ytdData) +
    annotate("rect", xmin = -Inf, xmax = Inf, ymax = 100.000, ymin = as.numeric(strsplit(data[row,2], "%")[[1]][1]), fill = "white", alpha = 0.6) + # Create the plot
    geom_line(aes(x = as.yearmon(Month), y = Value), colour = "white", size = 1) +
    labs(title = data[row,1], subtitle = paste0(data[row,ncol(data)], "% / ", data[row,(ncol(data)-1)], " hours")) + # Add title and subtitle
    theme(axis.line=element_blank(), # Remove X-axis title
          axis.text.x=element_blank(), # Remove X-Xais Text
          axis.text.y=element_blank(), # Remove Y-Axis Text - Comment this whole line out if you want a scale on the y-axis.
          axis.ticks=element_blank(), # Remove X-Axis
          axis.title.x=element_blank(), # Remove X-Axis Titlke
          axis.title.y=element_blank(),legend.position="none", # Remove legend and Y-axis title
          panel.background=element_blank(), # Remove bland gray background
          panel.border=element_blank(), # Remove border
          panel.grid.major=element_blank(), # Remove Grid
          panel.grid.minor=element_blank(), # Remove Grid
          plot.background = element_rect(fill = colour()), # Red, Green, Yellow
          plot.title = element_text(size = 10, colour = "white", face = "plain"), # Main Title
          plot.subtitle = element_text(size = 15, colour = "white", face = "bold"))

  return(plot) # Return the plot.
}



# Now we build the the grid by calling each row. Depending on the size of the canvas, 
# you might want to break up how many rows on the grid you do. In my case, this 
# is going on an A4 size peice of paper, so I will probably limit it to about 5-6 rows 
# in order to provide a readable page. Squeezing 5 columns in could get you more
# on a page, too. 

grid.arrange(metricplot2(data = criticalSystemAvailabilityFullDetail, row=1),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=2),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=3),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=4),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=5),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=5),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=7),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=8),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=9),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=10),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=11),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=12),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=13),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=14),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=15),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=16),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=17),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=18),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=19),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=20),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=21),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=22),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=23),
             metricplot2(data = criticalSystemAvailabilityFullDetail, row=24), ncol=4)

This produces the following:

The original concept I am trying to shoot for is the following:

Thanks in advance!

user10146431 · Accepted Answer

lower-level grid functions might be more suitable for custom annotations, e.g.

library(grid)

fancyGrob <- function(title = "Armani [Desktop]", 
                      number = "7880", 
                      percent = "45% ▼", 
                      d = list(raw = data.frame(x = 1:20, y = runif(20, 0.2, 1)), mean = 0.5), 
                      bkg = "#4DAF4A") {

  title <- textGrob(title, gp = gpar(col="white", fontsize = 18),
                    x = unit(5, 'pt'), y = unit(1, 'npc')- unit(0.1, 'line'), vjust = 1, hjust=0)
  number <- textGrob(number, gp = gpar(col="white", fontsize = 22, fontface=2),
                     x = unit(5, 'pt'), vjust = 0, hjust=0)
  y <- grobHeight(title) + grobHeight(number)
  number$y <- unit(1, 'npc') - 1.5*y 
  percent <- textGrob(paste0(" / ", percent), gp = gpar(col="white", fontsize = 10),
                     x = unit(5, 'pt') + grobWidth(number), 
                     y = unit(1, 'npc') - 1.5*y, vjust = 0, hjust=0)
  background <- rectGrob(gp=gpar(fill=bkg))

  p <- ggplot(d$raw, aes(x,y)) + 
    geom_area(aes(y=d$mean), fill='white', col=NA, alpha=0.5) +
    geom_line(col='white',  alpha=0.5, lwd=1.2) +
    scale_x_continuous(expand=c(0,0)) +
    scale_y_continuous(expand=c(0,0)) +
    theme_void() + theme(plot.margin = margin(5,5,5,5, unit = 'pt') )
  plot <- ggplotGrob(p)
  plot$vp <- viewport(height=0.5,just=c(0.5,1))
  grobTree(background, plot, number, percent, title, gp = gpar(fontfamily='Source Sans Pro'))

}

grid.arrange(grobs = replicate(7, fancyGrob(), simplify = FALSE))

Screensho

R ggplot subtitles with different size fonts

Answers (2)

Related Questions