Robust implementation of horizontal y-axis title above y-axis in ggplot

Question

I am attempting to develop a robust ggplot theme (or sourcable file) to override the default ggplot theme, with the new theme having the y-axis title horizontal above the y-axis text.

Related to Put y axis title in top left corner of graph, although I'm trying to overwrite the default ggplot theme and extend to a more robust and general solution.

Not a duplicate of Move Y axis Title horizontally ggplot2 as I'm looking for a automatic, general solution instead of trying to manually find numbers for every single plot.

The current implementation below has three issues:

1. Using theme_set to override the default doesn't trigger ggplot_add.test_theme to switch the y-axis and subtitle. I'm guessing theme_set acts as a fallback, so the default theme is never added to the ggplot, but I can't work out how to hook into the default ggplot build to make this change.
2. Creating a facet plot moves the y-axis outside the facet. This may be unfixable with the current approach of moving the y-axis into the subtitle. I have also tried adding an invisible secondary x-axis to add white space between the facet title and the panel/plot (with strip.placement = "outside"), and trying to add an annotation/tag into the gap, but I can't see a general way of finding the appropriate coordinates with grid/gtable
3. Switching the y-axis and subtitle in this way means the theme has to be added after any changes to the y-axis title through labs (or otherwise).

I'm open to completely different approaches.

library(ggplot2)

test_theme <- \(){
  tmp <- theme_grey() + theme(
    plot.title.position = "plot",
    axis.title.x = element_text(hjust = 1)
  )
  class(tmp) <- c("test_theme", c("theme", "gg"))
  return(tmp)
}

# Make changes to the plot when test_theme is added to a ggplot (e.g. p + test_theme())
ggplot_add.test_theme <- function(object, plot, object_name) {
  # Move the y-axis to the subtitle
  plot$labels$subtitle <- plot$labels$y
  plot$labels$y <- ""
  plot
}

# Set the new theme as the default
theme_set(test_theme())

# Problem 1
# x-axis moved, y-axis in default position
ggplot(mpg, aes(cyl, displ)) + 
  geom_point()

# both axis have moved - this is what the plot should look like.
ggplot(mpg, aes(cyl, displ)) + 
  geom_point() +
  test_theme()

# Problem 2
# Facetting moves the y-axis outside the facet.
ggplot(mpg, aes(cyl, displ)) + 
  geom_point() +
  facet_wrap(fl ~ .) +
  test_theme()

# Problem 3
# Breaks if labs is after the theme
ggplot(mpg, aes(cyl, displ)) + 
  geom_point() +
  test_theme() +
  labs(y = "Y test")

Answer 1

I have improved the starting code I gave in the question by monkey-patching print.ggplot so that test_theme() is automatically appended to any ggplot call when it is printed. The code below also updates to add the theme in ggplot_add.test_theme, preserve the theme attached to the ggplot by the user (instead of forcing theme_grey) and to remove the call to theme_set which is no longer necessary.

With the new code the user no longer needs to call test_theme() at all as the horizontal y-axis is applied automatically. This fixes problems 1 and 3, but not problem 2 with the y-axis position in a facet plot.

library(ggplot2)

test_theme <- \(){
  tmp <- theme(plot.title.position = "plot",
               axis.title.x = element_text(hjust = 1))
  class(tmp) <- c("test_theme", c("theme", "gg"))
  return(tmp)
}

# Make changes to the plot when test_theme is added to a ggplot (e.g. p + test_theme())
ggplot_add.test_theme <- function(object, plot, object_name) {
  # Move the y-axis to the subtitle
  plot$labels$subtitle <- plot$labels$y
  plot$labels$y <- ""
  # Updated to add the theme changes.
  plot$theme <- ggplot2:::add_theme(plot$theme, object)
  class(plot) <- c("test_theme", class(plot))
  plot
}

# Essentially add a hook into the ggplot method which builds the plots
# https://stackoverflow.com/questions/38732663/how-to-insert-expression-into-the-body-of-a-function-in-r
patch_function <- function(fun, patch, position = 1) {
  fun.body <- deparse(body(fun))
  patched.fun.body <- paste0(
    c(fun.body[1:position], patch, fun.body[(position + 1):length(fun.body)]),
    collapse = "\n"
  )
  expr <- as.expression(parse(text = patched.fun.body))
  return(expr)
}

monkey_patch <- 'if(!("test_theme" %in% class(x))) x <- x + test_theme()'
if (!grepl(monkey_patch, 
           deparse1(ggplot2:::print.ggplot), 
           fixed = TRUE)){
  y_ggplot <- ggplot2:::print.ggplot 
  body(y_ggplot) <- patch_function(ggplot2:::print.ggplot, 
                                   monkey_patch)
  assignInNamespace("print.ggplot", y_ggplot, ns = "ggplot2")
}

# New examples.  The user doesn't need to call test_theme() at all.
# Problem 1 is fixed.
ggplot(mpg, aes(cyl, displ)) + 
  geom_point()


# Problem 2 is still there.
# Facetting moves the y-axis outside the facet.
ggplot(mpg, aes(cyl, displ)) + 
  geom_point() +
  facet_wrap(fl ~ .)

# Problem 3 - works now
ggplot(mpg, aes(cyl, displ)) + 
  geom_point() +
  labs(y = "Y test")