1#' Munch coordinates data
2#'
3#' This function "munches" lines, dividing each line into many small pieces
4#' so they can be transformed independently. Used inside geom functions.
5#'
6#' @param coord Coordinate system definition.
7#' @param data Data set to transform - should have variables `x` and
8#'   `y` are chopped up into small pieces (as defined by `group`).
9#'   All other variables are duplicated as needed.
10#' @param range Panel range specification.
11#' @param segment_length Target segment length
12#' @keywords internal
13#' @export
14coord_munch <- function(coord, data, range, segment_length = 0.01) {
15  if (coord$is_linear()) return(coord$transform(data, range))
16
17  # range has theta and r values; get corresponding x and y values
18  ranges <- coord$backtransform_range(range)
19
20  # Convert any infinite locations into max/min
21  # Only need to work with x and y because for munching, those are the
22  # only position aesthetics that are transformed
23  data$x[data$x == -Inf] <- ranges$x[1]
24  data$x[data$x == Inf]  <- ranges$x[2]
25  data$y[data$y == -Inf] <- ranges$y[1]
26  data$y[data$y == Inf]  <- ranges$y[2]
27
28  # Calculate distances using coord distance metric
29  dist <- coord$distance(data$x, data$y, range)
30  dist[data$group[-1] != data$group[-nrow(data)]] <- NA
31  if (!is.null(data$subgroup)) {
32    dist[data$subgroup[-1] != data$subgroup[-nrow(data)]] <- NA
33  }
34
35  # Munch and then transform result
36  munched <- munch_data(data, dist, segment_length)
37  coord$transform(munched, range)
38}
39
40# For munching, only grobs are lines and polygons: everything else is
41# transformed into those special cases by the geom.
42#
43# @param dist distance, scaled from 0 to 1 (maximum distance on plot)
44# @keyword internal
45munch_data <- function(data, dist = NULL, segment_length = 0.01) {
46  n <- nrow(data)
47
48  if (is.null(dist)) {
49    data <- add_group(data)
50    dist <- dist_euclidean(data$x, data$y)
51  }
52
53  # How many endpoints for each old segment, not counting the last one
54  extra <- pmax(floor(dist / segment_length), 1)
55  extra[is.na(extra)] <- 1
56  # Generate extra pieces for x and y values
57  # The final point must be manually inserted at the end
58  x <- c(unlist(mapply(interp, data$x[-n], data$x[-1], extra, SIMPLIFY = FALSE)), data$x[n])
59  y <- c(unlist(mapply(interp, data$y[-n], data$y[-1], extra, SIMPLIFY = FALSE)), data$y[n])
60
61  # Replicate other aesthetics: defined by start point but also
62  # must include final point
63  id <- c(rep(seq_len(nrow(data) - 1), extra), nrow(data))
64  aes_df <- data[id, setdiff(names(data), c("x", "y")), drop = FALSE]
65
66  new_data_frame(c(list(x = x, y = y), unclass(aes_df)))
67}
68
69# Interpolate.
70# Interpolate n-1 evenly spaced steps (n points) from start to
71# (end - (end - start) / n). end is never included in sequence.
72interp <- function(start, end, n) {
73  if (n == 1) return(start)
74  start + seq(0, 1, length.out = n + 1)[-(n + 1)] * (end - start)
75}
76
77# Euclidean distance between points.
78# NA indicates a break / terminal points
79dist_euclidean <- function(x, y) {
80  n <- length(x)
81
82  sqrt((x[-n] - x[-1]) ^ 2 + (y[-n] - y[-1]) ^ 2)
83}
84
85# Compute central angle between two points.
86# Multiple by radius of sphere to get great circle distance
87# @arguments longitude
88# @arguments latitude
89dist_central_angle <- function(lon, lat) {
90  # Convert to radians
91  lat <- lat * pi / 180
92  lon <- lon * pi / 180
93
94  hav <- function(x) sin(x / 2) ^ 2
95  ahav <- function(x) 2 * asin(x)
96
97  n <- length(lat)
98  ahav(sqrt(hav(diff(lat)) + cos(lat[-n]) * cos(lat[-1]) * hav(diff(lon))))
99}
100
101
102# Polar dist.
103# Polar distance between points. This does not give the straight-line
104# distance between points in polar space. Instead, it gives the distance
105# along lines that _were_ straight in cartesian space, but have been
106# warped into polar space. These lines are all spiral arcs, circular
107# arcs, or segments of rays.
108dist_polar <- function(r, theta) {
109
110  # Pretending that theta is x and r is y, find the slope and intercepts
111  # for each line segment.
112  # This is just like finding the x-intercept of a line in cartesian coordinates.
113  lf <- find_line_formula(theta, r)
114
115  # Rename x and y columns to r and t, since we're working in polar
116  # Note that 'slope' actually means the spiral slope, 'a' in the spiral
117  #   formula r = a * theta
118  lf <- rename(lf, c(x1 = "t1", x2 = "t2", y1 = "r1", y2 = "r2",
119    yintercept = "r_int",  xintercept = "t_int"))
120
121  # Re-normalize the theta values so that intercept for each is 0
122  # This is necessary for calculating spiral arc length.
123  # If the formula is r=a*theta, there's a big difference between
124  # calculating the arc length from theta = 0 to pi/2, vs.
125  # theta = 2*pi to pi/2
126  lf$tn1 <- lf$t1 - lf$t_int
127  lf$tn2 <- lf$t2 - lf$t_int
128
129  # Add empty distance column
130  lf$dist <- NA_real_
131
132  # There are three types of lines, which we handle in turn:
133  # - Spiral arcs (r and theta change)
134  # - Circular arcs (r is constant)
135  # - Rays (theta is constant)
136
137  # Get spiral arc length for segments that have non-zero, non-infinite slope
138  # (spiral_arc_length only works for actual spirals, not circle arcs or rays)
139  # Use the _normalized_ theta values for arc length calculation
140  # Also make sure to ignore NA's because they cause problems when used on left
141  # side assignment.
142  idx <- !is.na(lf$slope) & lf$slope != 0 & !is.infinite(lf$slope)
143  idx[is.na(idx)] <- FALSE
144  lf$dist[idx] <-
145    spiral_arc_length(lf$slope[idx], lf$tn1[idx], lf$tn2[idx])
146
147  # Get circular arc length for segments that have zero slope (r1 == r2)
148  idx <- !is.na(lf$slope) & lf$slope == 0
149  lf$dist[idx] <- lf$r1[idx] * (lf$t2[idx] - lf$t1[idx])
150
151  # Get radial length for segments that have infinite slope (t1 == t2)
152  idx <- !is.na(lf$slope) & is.infinite(lf$slope)
153  lf$dist[idx] <- lf$r1[idx] - lf$r2[idx]
154
155  # Find the maximum possible length, a spiral line from
156  # (r=0, theta=0) to (r=1, theta=2*pi)
157  max_dist <- spiral_arc_length(1 / (2 * pi), 0, 2 * pi)
158
159  # Final distance values, normalized
160  abs(lf$dist / max_dist)
161}
162
163# Given n points, find the slope, xintercept, and yintercept of
164# the lines connecting them.
165#
166# This returns a data frame with length(x)-1 rows
167#
168# @param x A vector of x values
169# @param y A vector of y values
170# @examples
171# find_line_formula(c(4, 7), c(1, 5))
172# find_line_formula(c(4, 7, 9), c(1, 5, 3))
173find_line_formula <- function(x, y) {
174  slope <- diff(y) / diff(x)
175  yintercept <- y[-1] - (slope * x[-1])
176  xintercept <- x[-1] - (y[-1] / slope)
177  new_data_frame(list(x1 = x[-length(x)], y1 = y[-length(y)],
178    x2 = x[-1], y2 = y[-1],
179    slope = slope, yintercept = yintercept, xintercept = xintercept))
180}
181
182# Spiral arc length
183#
184# Each segment consists of a spiral line of slope 'a' between angles
185# 'theta1' and 'theta2'. Because each segment has its own _normalized_
186# slope, the ending theta2 value may not be the same as the starting
187# theta1 value of the next point.
188#
189# @param a A vector of spiral "slopes". Each spiral is defined as r = a * theta.
190# @param theta1 A vector of starting theta values.
191# @param theta2 A vector of ending theta values.
192# @examples
193# spiral_arc_length(a = c(0.2, 0.5), c(0.5 * pi, pi), c(pi, 1.25 * pi))
194spiral_arc_length <- function(a, theta1, theta2) {
195  # Archimedes' spiral arc length formula from
196  # http://mathworld.wolfram.com/ArchimedesSpiral.html
197  0.5 * a * (
198    (theta1 * sqrt(1 + theta1 * theta1) + asinh(theta1)) -
199    (theta2 * sqrt(1 + theta2 * theta2) + asinh(theta2)))
200}
201