R - ggplot2: geom_text with fontsize scaled to window size

Question

a function that I'm writing uses ggplot2::geom_text(). However, I need the fontsize to stay scaled to the window size, meaning: If the size of the window is decreased the fontsize has to decrease, too, and vice versa in case of increasing the window size. I did not find a solution online. Therefore, I'm trying to create a ggplot2 GeomTextScaled that works slightly different than GeomText does. Inspired by this post I wrote the preliminary solution below. This is probably incredibly awkward to everybody who is familiar with grid and grobs etc.

# awkward temporary solution
# other fns. resizingGrobText, drawDetails.resizingTextGrob,
# preDrawDetails.resizingGrobText, postDrawDetails.resizingGrobText

#' @export
resizingTextGrob <- function(...){

  grid::grob(tg = grid::textGrob(...), cl = "resizingTextGrob")

}



# draw --------------------------------------------------------------------

drawDetails <- grid::drawDetails

#' @exportS3Method
drawDetails.resizingTextGrob <- function(x, recording = TRUE){

  grid::grid.draw(x$tg)

}



# pre ---------------------------------------------------------------------

preDrawDetails <- grid::preDrawDetails

#' @exportS3Method
preDrawDetails.resizingTextGrob <- function(x){

# awkward...
  size.x <-
    base::get(
      x = "temp_x.size.scale.bar.text.x_temp",
      envir = .GlobalEnv
    )

  h <- grid::convertHeight(unit(size.x, "snpc"), "mm", valueOnly=TRUE)

  fs <- scales::rescale(h, to=c(18, 7), from=c(120, 20))

  grid::pushViewport(viewport(gp = grid::gpar(fontsize = fs)))

}


# post --------------------------------------------------------------------

postDrawDetails <- grid::postDrawDetails

#' @exportS3Method
postDrawDetails.resizingTextGrob <- function(x){  grid::popViewport()}


# ggplot2 --------------------------------------------------------------------

#' @title GeomTextScaled
#' @format NULL
#' @usage NULL
#' @export
GeomTextScaled <- ggplot2::ggproto(
  `_class` = "GeomTextScaled",
  `_inherit` = ggplot2::Geom,
  required_aes = c("x", "y", "label"),
  default_aes = aes(
    colour = "black", size = 3.88, angle = 0, hjust = 0.5,
    vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2
  ),
  draw_panel = function(data, panel_params, coord, parse = FALSE,
                        na.rm = FALSE, check_overlap = FALSE) {

    lab <- data$label

    data <- coord$transform(data, panel_params)

    size.x <- data$size

# awkward...
    base::assign(
      x = "temp_x.size.scale.bar.text.x_temp",
      value = size.x,
      envir = .GlobalEnv
    )

    resizingTextGrob(
      label = lab,
      x = data$x,
      y = data$y,
      default.units = "native",
      rot = data$angle,
      gp = grid::gpar(
        col = ggplot2::alpha(data$colour, data$alpha),
        fontfamily = data$family,
        fontface = data$fontface,
        lineheight = data$lineheight
      ),
      check.overlap = check_overlap
    )


  },

  draw_key = ggplot2::draw_key_text
)

#' @export
geom_text_scaled <- function(...,
                            mapping = ggplot2::aes(),
                            data = NULL,
                            stat = "identity",
                            position = "identity",
                            na.rm = FALSE,
                            show.legend = NA,
                            inherit.aes = TRUE){

  ggplot2::layer(
    geom = GeomTextScaled,
    data = data,
    stat = stat,
    position = position,
    params = c(..., list(na.rm = na.rm)),
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    mapping = mapping
  )

}

This is an example that works...

# example -----------------------------------------------------------------
​
library(ggplot2)
​
ggplot() +
  geom_text_fixed(
    data = data.frame(x = 25, y = 25, label = "scaled_to_window"),
    mapping = aes(x = x, y= y, label = label),
    size = 1
  ) +
  geom_text(
    data = data.frame(x = 75, y = 75, label = "stays the same"),
    mapping = aes(x = x, y= y, label = label),
    size = 5
  ) +
  coord_cartesian(xlim = c(0,100), ylim = c(0,100))
​

But it only works under two conditions that I'd like to have removed:

1. I can not "communicate" via the size argument with preDrawDetails() and have to assign a variable to the global environment every time I use it. I'd prefer not to do this but I don't know how to access the method for resizingGrobText().

2. I'm actually writing a package where I have to export everything. If I load the code below in the global environment everything works. If I only load the package via devtools::load_all() it does not.

How can I solve this?

If there is an easier solution than writing a whole new Geom that I just don't find with google I am happy to use it! I just need the text in this plot to remain scaled to the viewport size.

Any help is appreciated. Thanks so much!

....

Answer 1

I think in this case it is just easier to make a makeContent.my_class method than all the three methods you wrote before. Below, we scale the fontsize such that is a fraction of the width of the panel.

#' @export
resizingTextGrob <- function(...){
  grobTree(tg = textGrob(...), cl = "resizingTextGrob")
}

#' @export
#' @method makeContent resizingTextGrob
makeContent.resizingTextGrob <- function(x) {
  width <- convertWidth(unit(1, "npc"), "pt", valueOnly = TRUE)
  fontsize <-  x$children[[1]]$gp$fontsize
  fontsize <- if (is.null(fontsize)) 12 else fontsize
  x$children[[1]]$gp$fontsize <- fontsize * width / 100
  x
}