Fixing the aspect ratio issue

NAMESPACE

@@ -1,7 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(makeContent,textpath)
 export(GeomTextpath)
 export(geom_textpath)
+export(textpathGrob)
 import(ggplot2)
 import(grid)
 importFrom(graphics,strwidth)

NEWS.md

@@ -3,3 +3,5 @@
 * Added a `NEWS.md` file to track changes to the package.
 * Plot text atop curve for readability purposes.
 * Support for `lineend`, `linejoin`, `linemitre` parameters.
+* Letter angles should now be stable for regardless of aspect ratios and 
+  recomputed when the plot device is resized (#6)

R/geom_textpath.R

@@ -25,10 +25,7 @@
 #' \code{ggplot} due to the way that the underlying \code{grid} graphics handles
 #' text. A text string is dealt with as a zero-width object, and therefore the
 #' rotation and spacing of the letters making up the string can only be dealt
-#' with by treating each letter separately. Inevitably, this means
-#' that curved text paths have to be calculated based on the size and aspect
-#' ratio of the plotting device. Resizing the device after drawing a curved
-#' text path will therefore cause artefacts of spacing and rotation in the text.
+#' with by treating each letter separately.
 #'
 #' It is important to realise that the letters are only rotated, and do not
 #' undergo any change in shape. Thus, for example, large text appearing on
@@ -158,198 +155,6 @@ geom_textpath <- function(
         ))
 }
 
-# Helpers -----------------------------------------------------------------
-
-## Adding path data -------------------------------------------------------
-
-# This function does the work of calculating the gradient of the path at each
-# x, y value along its length, and the angle this implies that text should sit
-# on the path (measured in degrees, not rads). It takes a group-subset of
-# the layer data frame as input, so this function needs to be lapply-ed to the
-# list formed by splitting the layer data frame by group. This has to be done
-# _after_ transforming the data to co-ordinate space with coord$transform(),
-# otherwise the angles will be wrong. This function could be moved into the
-# body of draw_panel, but I have kept it as a separate non-exported function at
-# the moment to keep the logic of this step separate.
-#
-# This function will be called after plot.new (or grid.newpage), so it will
-# have access to the current device dimensions, etc. This is where we should do
-# any calculations that take the aspect ratio into account to improve the angle
-# of rotation for the letters.
-
-.add_path_data <- function(.data)
-{
-  # Gradient is found and converted to angle here. Since we use approx
-  # to interpolate angles later, we can't have any sudden transitions
-  # where angles "wrap around" from +180 to -180, otherwise we might
-  # interpolate in this transition and get letters with an angle of
-  # around 0. When combined with a vjust, this also makes the letters
-  # jump out of alignment. This little algorithm makes sure the changes
-  # in angle never wrap around.
-  grad <- diff(.data$y) / diff(.data$x)
-  rads <- atan(grad)
-  diff_rads <- diff(rads)
-  diff_rads <- ifelse(diff_rads < - pi / 2, diff_rads + pi, diff_rads)
-  diff_rads <- ifelse(diff_rads > pi / 2, diff_rads - pi, diff_rads)
-  rads <- cumsum(c(rads[1], 0, diff_rads))
-
-  # Now we can safely convert to degrees
-  .data$angle <- rads * 180 / pi
-
-  # Letters need to be spaced according to their distance along the path, so
-  # we need a column to measure the distance of each point along the path
-  .data$length <- c(0, cumsum(sqrt(diff(.data$x)^2 + diff(.data$y)^2)))
-
-  # We also need to define curvature of the line at each point.
-  # This is how much the angle changes per unit distance. We need to use
-  # radians here. We need to know the curvature to increase or decrease
-  # the spacing between characters when vjust is used, otherwise the spacing
-  # will change
-
-  diff_rads <- approx(seq_along(diff_rads), diff_rads,
-                     seq(1, length(diff_rads), length.out = nrow(.data) - 1))$y
-
-  curvature <- diff_rads/diff(.data$length)
-
-
-  #curvature <- predict(loess(curvature ~ seq_along(curvature)))
-
-  effective_length <- diff(.data$length) * (1 + (.data$vjust[1] - 0.5) * 0.04 *curvature)
-
-  .data$adj_length <- c(0, cumsum(effective_length))
-
-  .data
-}
-
-
-## Getting path points ----------------------------------------------------
-
-# This is another helper function for the draw_panel function. This is where
-# the text gets split into its component parts and assigned x, y and angle
-# components. This function also takes one group subset of the main panel data
-# frame at a time after .add_path_data() has been called, and returns a
-# modified data frame.
-#
-# The total length of the textpath is currently implemented as the product of
-# strwidth and text size multiplied by a "magic constant" that seems to look
-# right on the plot (currently 0.5). Presumably there is a better way to do
-# this.
-#
-# The hjust is also applied here. Actually, although it's called hjust, this
-# parameter is really just analogous to hjust, and never gets passed to grid.
-# It determines how far along the path the string will be placed. The
-# individual letters all have an hjust of 0.5.
-
-.get_path_points <- function(path)
-{
-  # The text needs some breathing space on either side if we are adding lines.
-  # The easiest way to do this is to add spaces around the text string
-  path$label <- paste0("  ", path$label, "  ")
-
-  # Using the shape_string function from package "systemfonts" allows fast
-  # and accurate calculation of letter spacing
-
-  letters <- shape_string(strings    = path$label[1],
-                          family     = path$family[1],
-                          italic     = path$fontace[1] %in% c(3, 4),
-                          bold       = path$fontface[1] %in% c(2, 4),
-                          size       = path$size[1],
-                          lineheight = path$lineheight[1])
-
-
-  # We need to define a proportionality constant between mm and npc space
-  k <- as.numeric(convertWidth(unit(1, "npc"), "mm"))
-
-  # This gives us an accurate size for the letter placement in npc space
-  letterwidths <- (letters$shape$x_offset + letters$shape$x_midpoint)/(k * 0.8)
-
-  # This calculates the starting distance along the path where we place
-  # the first letter
-  start_dist <- path$hjust[1] * (max(path$adj_length) - max(letterwidths))
-
-  # Now we just add on the letterwidths and we have the correct distances
-  dist_points <- letterwidths + start_dist
-
-  # We now need to interpolate all the numeric values along the path so we
-  # get the appropriate values at each point. Non-numeric values should all
-  # be identical, so these are just kept as-is
-
-
-  df <- as.data.frame(lapply(path, function(i) {
-    if(is.numeric(i))
-      approx(x = path$adj_length, y = i, xout = dist_points, ties = mean)$y
-    else
-      rep(i[1], length(dist_points))
-    }))
-
-
-  # Now we assign each letter to its correct point on the path
-  df$label <- letters$shape$glyph
-
-  # This ensures that we don't try to return any invalid letters
-  # (those letters that fall off the path on either side will have
-  # NA angles)
-  df[!is.na(df$angle), ]
-}
-
-## Getting surrounding lines -----------------------------------------------
-
-# We probably want the option to draw the path itself, since this will be less
-# work for the end-user. If the vjust is between 0 and 1 then the path will
-# clash with the text, so we want to remove the segment where the text is.
-# This function will get the correct segments in either case, but it needs
-# the whole path data AND the calculated string data to do it.
-
-## TODO: Do we want to add a parameter to switch the lines on and off,
-##       inside geom_textpath(), or simply set a default linewidth of 0?
-## RE: We could separate it into two geoms, one with a path by default and one
-##     without. I think some graphics devices interpret 0-linewidth differently,
-##     so the safer option would be to use `linetype = 0`, I think.
-
-## TODO: Below, we're using `vjust` to determine where to cut the path if it
-##       intersects text, but that doesn't take ascenders and descenders into
-##       account.
-
-## Can we rename this function to `.paths_bookends()`? I like the term bookend
-## you used earlier in a comment!
-.get_surrounding_lines <- function(path, letters) {
-
-  # Early exit if text isn't exactly on path
-  if (all(letters$vjust < 0) || all(letters$vjust > 1)) {
-    path$section <- "all"
-    return(path)
-  }
-
-  # Lengths of group runs (assumed to be sorted)
-  # The `rle()` function handles NAs inelegantly,
-  # but I'm assuming `group` cannot be NA.
-  letter_lens <- rle(letters$group)$lengths
-  curve_lens  <- rle(path$group)$lengths
-
-  # Get locations where strings start and end
-  starts <- {ends <- cumsum(letter_lens)} - letter_lens + 1
-  mins <- letters$length[starts]
-  maxs <- letters$length[ends]
-
-  # Assign sections to before and after string
-  path$section <- ""
-  path$section[path$length < rep(mins, curve_lens)] <- "pre"
-  path$section[path$length > rep(maxs, curve_lens)] <- "post"
-
-  # Filter empty sections (i.e., the part where the string is)
-  path[path$section != "", , drop = FALSE]
-}
-
-# Magic constant
-#
-# This magic constant is the number of points per millimetre. We need this to
-# parametrise font size in the equivalent manner as `geom_text()`, which
-# uses millimetres instead of points (unlike e.g. `element_text()`).
-# The grid system only understands points for fonts, so we need to multiply
-# the text size in the geom with the magic constant to get the usual expected
-# font size. In ggplot2, this is the `ggplot2::.pt` object. As a sanity check:
-# .pt <- grid::convertUnit(unit(1, "mm"), "pt")
-
 # ggproto class -----------------------------------------------------------
 
 #' The Geom object for a textpath
@@ -417,62 +222,43 @@ GeomTextpath <- ggproto("GeomTextpath", Geom,
     # All our transformations occur after the coord transform:
     data <- coord$transform(data, panel_params)
 
-    # Get gradients, angles and path lengths for each group
-    data <- lapply(split(data, data$group), .add_path_data)
+    #---- Set graphical parameters --------------------------#
 
-    # Get the actual text string positions & angles for each group
-    data_points <- do.call(rbind, lapply(data, .get_path_points))
-    data <- do.call(rbind, data)
+    # browser()
 
-    # Trim path if it intersects text
-    data_lines <- .get_surrounding_lines(data, data_points)
+    # Get first observation of each group
+    first <- c(TRUE, data$group[-1] != data$group[-nrow(data)])
 
-    # Get first point of individual paths (for graphical parameters)
-    path_id <- paste0(data_lines$group, "&", data_lines$section)
-    path_id <- match(path_id, unique(path_id))
-    start   <- c(TRUE, path_id[-1] != path_id[-length(path_id)])
-
-    #---- Grob writing --------------------------------------#
-
-    my_tree <- gTree()
-
-    # Create the linegrobs
-    my_tree <- addGrob(
-      my_tree, polylineGrob(
-        x = data_lines$x,
-        y = data_lines$y,
-        id = path_id,
-        gp = gpar(
-          col  = alpha(data_lines$colour, data_lines$alpha)[start],
-          fill = alpha(data_lines$colour, data_lines$alpha)[start],
-          lwd  = data_lines$linewidth[start] * .pt,
-          lty  = data_lines$linetype[start],
-          lineend   = lineend,
-          linejoin  = linejoin,
-          linemitre = linemitre
-        )
-      )
+    text_gp <- gpar(
+      col  = alpha(data$colour, data$alpha)[first],
+      fontsize   = data$size[first] * .pt,
+      fontface   = data$fontface[first],
+      fontfamily = data$family[first],
+      lineheight = data$lineheight[first]
     )
 
-    # Create the textgrobs
-    my_tree <- addGrob(
-      my_tree,  textGrob(
-        label = data_points$label,
-        x     = data_points$x,
-        y     = data_points$y,
-        vjust = data_points$vjust,
-        hjust = 0.5, # this must be kept constant; we are implementing
-                     # hjust per string, not per letter
-        rot   = data_points$angle,
-        gp    = gpar(
-          col = alpha(data_points$colour, data_points$alpha),
-          fontsize   = data_points$size * .pt,
-          fontface   = data_points$fontface,
-          fontfamily = data_points$fontfamily
-        )
-      )
+    path_gp <- gpar(
+      col  = alpha(data$colour, data$alpha)[first],
+      fill = alpha(data$colour, data$alpha)[first],
+      lwd  = data$linewidth[first] * .pt,
+      lty  = data$linetype[first],
+      lineend   = lineend,
+      linejoin  = linejoin,
+      linemitre = linemitre
     )
 
-    return(my_tree)
+    #---- Dispatch data to grob -----------------------------#
+
+    textpathGrob(
+      label = data$label[first],
+      x = data$x,
+      y = data$y,
+      id = data$group,
+      hjust = data$hjust[first],
+      vjust = data$vjust[first],
+      gp_text = text_gp,
+      gp_path = path_gp,
+      default.units = "npc"
+    )
   }
 )