Tidied and commented trig helpers

R/geometry_helpers.R

@@ -63,28 +63,19 @@
 ) {
 
   ppi <- floor(convertUnit(unit(1, "in"), "pt", valueOnly = TRUE))
-  dpi <- (dev.size("px") / dev.size("in"))[1]
 
-  d <-0
+  path$length <- .arclength_from_xy(path$x, path$y)
 
-  path$adj_length <- .length_adjust_by_curvature(path$x, path$y, d)
-
-  # Meaure text
-  letters <- measure_text(label, gp = gp, ppi = ppi, vjust = vjust[1],
-                          halign = halign)
-
-  string_size <- attr(letters, "metrics")$width
+  letters <- measure_text(label, gp = gp, vjust = vjust[1], halign = halign)
 
   y_pos <- unique(c(0, letters$ymin))
 
   offset <- .get_offset(path$x, path$y, d = y_pos)
 
-  n <- nrow(path)
-
   arclength <- offset$arc_length
 
   # Calculate anchorpoint
-  anchor <- hjust[1] * (arclength[n, ] - string_size)
+  anchor <- hjust[1] * (c(tail(arclength, 1)) - attr(letters, "metrics")$width)
 
   # Offset text x by anchorpoint
   xpos <- c("xmin", "xmid", "xmax")
@@ -137,7 +128,7 @@
   df <- as.list(path[setdiff(names(path), c("x", "y", "angle"))])
   is_num <- vapply(df, is.numeric, logical(1))
   df[is_num] <- lapply(df[is_num], function(i) {
-    approx(x = path$adj_length, y = i, xout = letters$xmid, ties = mean)$y
+    approx(x = path$length, y = i, xout = letters$xmid, ties = mean)$y
   })
   df[!is_num] <- lapply(lapply(df[!is_num], `[`, 1L),
                         rep, length.out = nrow(letters))

R/trig_helpers.R

@@ -1,32 +1,3 @@
-
-# ------------------------------------------------------------------------------
-# Often we need the derivative or gradient to match the length of the input
-# vector. This does it via a simple interpolation along the input vector
-
-.stretch_by_one <- function(vec)
-{
-  n <- length(vec)
-
-  if(n == 1)
-    rep(vec, 2)
-  else
-    approx(seq(n), vec, seq(1, n, length.out = n + 1))$y
-}
-
-# ------------------------------------------------------------------------------
-# Given x, y co-ordinates, get the value of dy / dx (i.e. the gradient)
-
-.derivative <- function(x, y, stretch = TRUE)
-{
-  n <- length(x)
-
-  if(n != length(y)) stop("x and y must be same length")
-
-  result <- diff(y) / diff(x)
-
-  if(!stretch) result else .stretch_by_one(result)
-}
-
 # ------------------------------------------------------------------------------
 # This is a safe way to get the direction along a path. Since we use approx
 # to interpolate angles later, we can't have any sudden transitions
@@ -36,9 +7,11 @@
 # jump out of alignment. This little algorithm makes sure the changes
 # in angle never wrap around.
 
-.angle_from_xy <- function(x, y, degrees = FALSE, stretch = FALSE, norm = FALSE)
+.angle_from_xy <- function(x, y, degrees = FALSE, norm = FALSE)
 {
-  grad       <- .derivative(x, y, stretch = stretch)
+  if(length(x) != length(y)) stop("x and y vectors must be the same length")
+
+  grad       <- diff(y) / diff(x)
   first      <- atan2(diff(y), diff(x))[1]
   rads       <- atan(grad)
   diff_rads  <- if(length(rads) > 1) diff(rads) else numeric()
@@ -50,8 +23,6 @@
   if(degrees) rads * 180 / pi else rads
 }
 
-
-
 # ------------------------------------------------------------------------------
 # Get the cumulative length of an x, y path. The accuracy can be improved by
 # setting accuracy to 1 or more, which will interpolate the points with splines
@@ -61,48 +32,61 @@
 {
   if(length(x) != length(y)) stop("x and y must be same length")
 
+  if(is.na(accuracy)) return(c(0, cumsum(sqrt(diff(x)^2 + diff(y)^2))))
 
-  if(!is.na(accuracy))
+  if(!is.numeric(accuracy) | length(accuracy) != 1 | accuracy < 0)
   {
-    if(!is.numeric(accuracy) | length(accuracy) != 1 | accuracy < 0)
-    {
-      stop("accuracy must be a positive integer")
-    }
+    stop("accuracy must be a positive integer")
+  }
 
-    t <- seq_along(x)
-    n <- length(x)
+  t <- seq_along(x)
+  n <- length(x)
 
-    new_x <- stats::spline(x ~ t, n = n + floor(accuracy) * (n - 1))
-    new_y <- stats::spline(y ~ t, n = n + floor(accuracy) * (n - 1))$y
+  new_x <- stats::spline(x ~ t, n = n + floor(accuracy) * (n - 1))
+  new_y <- stats::spline(y ~ t, n = n + floor(accuracy) * (n - 1))$y
+
+  dist <- c(0, cumsum(sqrt(diff(new_x$y)^2 + diff(new_y)^2)))
+
+  return(dist[match(t, new_x$x)])
 
-    dist <- c(0, cumsum(sqrt(diff(new_x$y)^2 + diff(new_y)^2)))
-    return(dist[match(t, new_x$x)])
-  }
-  else
-  {
-    return(c(0, cumsum(sqrt(diff(x)^2 + diff(y)^2))))
-  }
 }
 
+# ------------------------------------------------------------------------------
+# We sometimes need to compare angles along a path, but ensure that the first
+# and last elements are compared to themselves. These little utility functions
+# allow a shorthand method of doing this.
+
 .before <- function(x) x[c(1, seq_along(x))]
 
 .after  <- function(x) x[c(seq_along(x), length(x))]
 
 
+# ------------------------------------------------------------------------------
+# Finds the offset path at distance d. This method effectively looks at each
+# segment of the path and finds the line at distance d that runs parallel to
+# it. The offset path is the set of points where adjacent offset lines meet.
 
 .get_offset <- function(x, y, d = 0) {
 
+  # Get angle normal to each segment of the path
   theta <- .angle_from_xy(x, y, norm = TRUE)
 
+  # Find the angle of the lines which, when drawn at each point on the path
+  # will project onto the intersections between adjacent offset segments
   theta_bisect <- (.before(theta) + .after(theta)) / 2
 
+  # Find the distances to these intersecting points when the offset is d.
+  # Since d can be a vector of distances, we need a matrix result, where
+  # each column is the distance to intersections at different values of d
   offset <- outer(1/cos(theta_bisect - .after(theta)), d)
 
-  # Project new points at the bisector
+  # Calculate the actual positions of the intersection points - these are
+  # our new offset paths - one matrix for x positions and one for y
   xout <- offset * cos(theta_bisect) + x
   yout <- offset * sin(theta_bisect) + y
 
-  # Calculate arc length
+  # Calculate arc length of the new paths: one length for each column in
+  # our x and y matrices.
   arc_length <- sapply(seq(ncol(xout)), function(i) {
      .arclength_from_xy(xout[,i], yout[,i])
   })
@@ -114,6 +98,7 @@
 # ------------------------------------------------------------------------------
 # Finds the curvature (change in angle per change in arc length)
 # This in effect finds 1/R, where R is the radius of the curve
+
 .get_curvature <- function(x, y)
 {
   dx  <- .stretch_by_one(diff(x))
@@ -124,19 +109,3 @@
 }
 
 
-# ------------------------------------------------------------------------------
-# Finds the length of each part of the offset path that projects onto the
-# original path
-.length_adjust_by_curvature <- function(x, y, offset)
-{
-  curvature         <- .get_curvature(x, y)
-  radius            <- 1 / curvature
-  radius[radius > 1e6] <- 1e6
-  radius[radius < -1e6] <- -1e6
-  length_correction <-  (radius + offset) / radius
-
-  effective_length  <- c(0, diff(.arclength_from_xy(x, y))) * length_correction
-
-  cumsum(effective_length)
-}
-