1#' Connect observations 2#' 3#' `geom_path()` connects the observations in the order in which they appear 4#' in the data. `geom_line()` connects them in order of the variable on the 5#' x axis. `geom_step()` creates a stairstep plot, highlighting exactly 6#' when changes occur. The `group` aesthetic determines which cases are 7#' connected together. 8#' 9#' An alternative parameterisation is [geom_segment()], where each line 10#' corresponds to a single case which provides the start and end coordinates. 11#' 12#' @eval rd_orientation() 13#' 14#' @eval rd_aesthetics("geom", "path") 15#' @inheritParams layer 16#' @inheritParams geom_bar 17#' @param lineend Line end style (round, butt, square). 18#' @param linejoin Line join style (round, mitre, bevel). 19#' @param linemitre Line mitre limit (number greater than 1). 20#' @param arrow Arrow specification, as created by [grid::arrow()]. 21#' @seealso 22#' [geom_polygon()]: Filled paths (polygons); 23#' [geom_segment()]: Line segments 24#' @section Missing value handling: 25#' `geom_path()`, `geom_line()`, and `geom_step()` handle `NA` as follows: 26#' 27#' * If an `NA` occurs in the middle of a line, it breaks the line. No warning 28#' is shown, regardless of whether `na.rm` is `TRUE` or `FALSE`. 29#' * If an `NA` occurs at the start or the end of the line and `na.rm` is `FALSE` 30#' (default), the `NA` is removed with a warning. 31#' * If an `NA` occurs at the start or the end of the line and `na.rm` is `TRUE`, 32#' the `NA` is removed silently, without warning. 33#' @export 34#' @examples 35#' # geom_line() is suitable for time series 36#' ggplot(economics, aes(date, unemploy)) + geom_line() 37#' ggplot(economics_long, aes(date, value01, colour = variable)) + 38#' geom_line() 39#' 40#' # You can get a timeseries that run vertically by setting the orientation 41#' ggplot(economics, aes(unemploy, date)) + geom_line(orientation = "y") 42#' 43#' # geom_step() is useful when you want to highlight exactly when 44#' # the y value changes 45#' recent <- economics[economics$date > as.Date("2013-01-01"), ] 46#' ggplot(recent, aes(date, unemploy)) + geom_line() 47#' ggplot(recent, aes(date, unemploy)) + geom_step() 48#' 49#' # geom_path lets you explore how two variables are related over time, 50#' # e.g. unemployment and personal savings rate 51#' m <- ggplot(economics, aes(unemploy/pop, psavert)) 52#' m + geom_path() 53#' m + geom_path(aes(colour = as.numeric(date))) 54#' 55#' # Changing parameters ---------------------------------------------- 56#' ggplot(economics, aes(date, unemploy)) + 57#' geom_line(colour = "red") 58#' 59#' # Use the arrow parameter to add an arrow to the line 60#' # See ?arrow for more details 61#' c <- ggplot(economics, aes(x = date, y = pop)) 62#' c + geom_line(arrow = arrow()) 63#' c + geom_line( 64#' arrow = arrow(angle = 15, ends = "both", type = "closed") 65#' ) 66#' 67#' # Control line join parameters 68#' df <- data.frame(x = 1:3, y = c(4, 1, 9)) 69#' base <- ggplot(df, aes(x, y)) 70#' base + geom_path(size = 10) 71#' base + geom_path(size = 10, lineend = "round") 72#' base + geom_path(size = 10, linejoin = "mitre", lineend = "butt") 73#' 74#' # You can use NAs to break the line. 75#' df <- data.frame(x = 1:5, y = c(1, 2, NA, 4, 5)) 76#' ggplot(df, aes(x, y)) + geom_point() + geom_line() 77#' 78#' \donttest{ 79#' # Setting line type vs colour/size 80#' # Line type needs to be applied to a line as a whole, so it can 81#' # not be used with colour or size that vary across a line 82#' x <- seq(0.01, .99, length.out = 100) 83#' df <- data.frame( 84#' x = rep(x, 2), 85#' y = c(qlogis(x), 2 * qlogis(x)), 86#' group = rep(c("a","b"), 87#' each = 100) 88#' ) 89#' p <- ggplot(df, aes(x=x, y=y, group=group)) 90#' # These work 91#' p + geom_line(linetype = 2) 92#' p + geom_line(aes(colour = group), linetype = 2) 93#' p + geom_line(aes(colour = x)) 94#' # But this doesn't 95#' should_stop(p + geom_line(aes(colour = x), linetype=2)) 96#' } 97geom_path <- function(mapping = NULL, data = NULL, 98 stat = "identity", position = "identity", 99 ..., 100 lineend = "butt", 101 linejoin = "round", 102 linemitre = 10, 103 arrow = NULL, 104 na.rm = FALSE, 105 show.legend = NA, 106 inherit.aes = TRUE) { 107 layer( 108 data = data, 109 mapping = mapping, 110 stat = stat, 111 geom = GeomPath, 112 position = position, 113 show.legend = show.legend, 114 inherit.aes = inherit.aes, 115 params = list( 116 lineend = lineend, 117 linejoin = linejoin, 118 linemitre = linemitre, 119 arrow = arrow, 120 na.rm = na.rm, 121 ... 122 ) 123 ) 124} 125 126#' @rdname ggplot2-ggproto 127#' @format NULL 128#' @usage NULL 129#' @export 130GeomPath <- ggproto("GeomPath", Geom, 131 required_aes = c("x", "y"), 132 133 default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA), 134 135 handle_na = function(data, params) { 136 # Drop missing values at the start or end of a line - can't drop in the 137 # middle since you expect those to be shown by a break in the line 138 complete <- stats::complete.cases(data[c("x", "y", "size", "colour", "linetype")]) 139 kept <- stats::ave(complete, data$group, FUN = keep_mid_true) 140 data <- data[kept, ] 141 142 if (!all(kept) && !params$na.rm) { 143 warn(glue("Removed {sum(!kept)} row(s) containing missing values (geom_path).")) 144 } 145 146 data 147 }, 148 149 draw_panel = function(data, panel_params, coord, arrow = NULL, 150 lineend = "butt", linejoin = "round", linemitre = 10, 151 na.rm = FALSE) { 152 if (!anyDuplicated(data$group)) { 153 message_wrap("geom_path: Each group consists of only one observation. ", 154 "Do you need to adjust the group aesthetic?") 155 } 156 157 # must be sorted on group 158 data <- data[order(data$group), , drop = FALSE] 159 munched <- coord_munch(coord, data, panel_params) 160 161 # Silently drop lines with less than two points, preserving order 162 rows <- stats::ave(seq_len(nrow(munched)), munched$group, FUN = length) 163 munched <- munched[rows >= 2, ] 164 if (nrow(munched) < 2) return(zeroGrob()) 165 166 # Work out whether we should use lines or segments 167 attr <- dapply(munched, "group", function(df) { 168 linetype <- unique(df$linetype) 169 new_data_frame(list( 170 solid = identical(linetype, 1) || identical(linetype, "solid"), 171 constant = nrow(unique(df[, c("alpha", "colour","size", "linetype")])) == 1 172 ), n = 1) 173 }) 174 solid_lines <- all(attr$solid) 175 constant <- all(attr$constant) 176 if (!solid_lines && !constant) { 177 abort("geom_path: If you are using dotted or dashed lines, colour, size and linetype must be constant over the line") 178 } 179 180 # Work out grouping variables for grobs 181 n <- nrow(munched) 182 group_diff <- munched$group[-1] != munched$group[-n] 183 start <- c(TRUE, group_diff) 184 end <- c(group_diff, TRUE) 185 186 if (!constant) { 187 segmentsGrob( 188 munched$x[!end], munched$y[!end], munched$x[!start], munched$y[!start], 189 default.units = "native", arrow = arrow, 190 gp = gpar( 191 col = alpha(munched$colour, munched$alpha)[!end], 192 fill = alpha(munched$colour, munched$alpha)[!end], 193 lwd = munched$size[!end] * .pt, 194 lty = munched$linetype[!end], 195 lineend = lineend, 196 linejoin = linejoin, 197 linemitre = linemitre 198 ) 199 ) 200 } else { 201 id <- match(munched$group, unique(munched$group)) 202 polylineGrob( 203 munched$x, munched$y, id = id, 204 default.units = "native", arrow = arrow, 205 gp = gpar( 206 col = alpha(munched$colour, munched$alpha)[start], 207 fill = alpha(munched$colour, munched$alpha)[start], 208 lwd = munched$size[start] * .pt, 209 lty = munched$linetype[start], 210 lineend = lineend, 211 linejoin = linejoin, 212 linemitre = linemitre 213 ) 214 ) 215 } 216 }, 217 218 draw_key = draw_key_path 219) 220 221# Trim false values from left and right: keep all values from 222# first TRUE to last TRUE 223keep_mid_true <- function(x) { 224 first <- match(TRUE, x) - 1 225 if (is.na(first)) { 226 return(rep(FALSE, length(x))) 227 } 228 229 last <- length(x) - match(TRUE, rev(x)) + 1 230 c( 231 rep(FALSE, first), 232 rep(TRUE, last - first), 233 rep(FALSE, length(x) - last) 234 ) 235} 236 237 238#' @export 239#' @rdname geom_path 240geom_line <- function(mapping = NULL, data = NULL, stat = "identity", 241 position = "identity", na.rm = FALSE, orientation = NA, 242 show.legend = NA, inherit.aes = TRUE, ...) { 243 layer( 244 data = data, 245 mapping = mapping, 246 stat = stat, 247 geom = GeomLine, 248 position = position, 249 show.legend = show.legend, 250 inherit.aes = inherit.aes, 251 params = list( 252 na.rm = na.rm, 253 orientation = orientation, 254 ... 255 ) 256 ) 257} 258 259#' @rdname ggplot2-ggproto 260#' @format NULL 261#' @usage NULL 262#' @export 263#' @include geom-path.r 264GeomLine <- ggproto("GeomLine", GeomPath, 265 setup_params = function(data, params) { 266 params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) 267 params 268 }, 269 270 extra_params = c("na.rm", "orientation"), 271 272 setup_data = function(data, params) { 273 data$flipped_aes <- params$flipped_aes 274 data <- flip_data(data, params$flipped_aes) 275 data <- data[order(data$PANEL, data$group, data$x), ] 276 flip_data(data, params$flipped_aes) 277 } 278) 279 280#' @param direction direction of stairs: 'vh' for vertical then horizontal, 281#' 'hv' for horizontal then vertical, or 'mid' for step half-way between 282#' adjacent x-values. 283#' @export 284#' @rdname geom_path 285geom_step <- function(mapping = NULL, data = NULL, stat = "identity", 286 position = "identity", direction = "hv", 287 na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { 288 layer( 289 data = data, 290 mapping = mapping, 291 stat = stat, 292 geom = GeomStep, 293 position = position, 294 show.legend = show.legend, 295 inherit.aes = inherit.aes, 296 params = list( 297 direction = direction, 298 na.rm = na.rm, 299 ... 300 ) 301 ) 302} 303 304#' @rdname ggplot2-ggproto 305#' @format NULL 306#' @usage NULL 307#' @export 308#' @include geom-path.r 309GeomStep <- ggproto("GeomStep", GeomPath, 310 draw_panel = function(data, panel_params, coord, direction = "hv") { 311 data <- dapply(data, "group", stairstep, direction = direction) 312 GeomPath$draw_panel(data, panel_params, coord) 313 } 314) 315 316#' Calculate stairsteps for `geom_step()` 317#' Used by `GeomStep()` 318#' 319#' @noRd 320stairstep <- function(data, direction = "hv") { 321 direction <- match.arg(direction, c("hv", "vh", "mid")) 322 data <- as.data.frame(data)[order(data$x), ] 323 n <- nrow(data) 324 325 if (n <= 1) { 326 # Need at least one observation 327 return(data[0, , drop = FALSE]) 328 } 329 330 if (direction == "vh") { 331 xs <- rep(1:n, each = 2)[-2*n] 332 ys <- c(1, rep(2:n, each = 2)) 333 } else if (direction == "hv") { 334 ys <- rep(1:n, each = 2)[-2*n] 335 xs <- c(1, rep(2:n, each = 2)) 336 } else if (direction == "mid") { 337 xs <- rep(1:(n-1), each = 2) 338 ys <- rep(1:n, each = 2) 339 } else { 340 abort("Parameter `direction` is invalid.") 341 } 342 343 if (direction == "mid") { 344 gaps <- data$x[-1] - data$x[-n] 345 mid_x <- data$x[-n] + gaps/2 # map the mid-point between adjacent x-values 346 x <- c(data$x[1], mid_x[xs], data$x[n]) 347 y <- c(data$y[ys]) 348 data_attr <- data[c(1,xs,n), setdiff(names(data), c("x", "y"))] 349 } else { 350 x <- data$x[xs] 351 y <- data$y[ys] 352 data_attr <- data[xs, setdiff(names(data), c("x", "y"))] 353 } 354 355 new_data_frame(c(list(x = x, y = y), data_attr)) 356} 357