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