/R/geom-segment.r

http://github.com/hadley/ggplot2 · R · 117 lines · 59 code · 8 blank · 50 comment · 2 complexity · e2253a84b9cdcf7f4adff3089587f253 MD5 · raw file

  1. #' Line segments and curves.
  2. #'
  3. #' \code{geom_segment} draws a straight line between points (x1, y1) and
  4. #' (x2, y2). \code{geom_curve} draws a curved line.
  5. #'
  6. #' @section Aesthetics:
  7. #' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "segment")}
  8. #'
  9. #' @inheritParams layer
  10. #' @inheritParams geom_point
  11. #' @param arrow specification for arrow heads, as created by arrow()
  12. #' @param lineend Line end style (round, butt, square)
  13. #' @seealso \code{\link{geom_path}} and \code{\link{geom_line}} for multi-
  14. #' segment lines and paths.
  15. #' @seealso \code{\link{geom_spoke}} for a segment parameterised by a location
  16. #' (x, y), and an angle and radius.
  17. #' @export
  18. #' @examples
  19. #' b <- ggplot(mtcars, aes(wt, mpg)) +
  20. #' geom_point()
  21. #'
  22. #' df <- data.frame(x1 = 2.62, x2 = 3.57, y1 = 21.0, y2 = 15.0)
  23. #' b +
  24. #' geom_curve(aes(x = x1, y = y1, xend = x2, yend = y2, colour = "curve"), data = df) +
  25. #' geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2, colour = "segment"), data = df)
  26. #'
  27. #' b + geom_curve(aes(x = x1, y = y1, xend = x2, yend = y2), data = df, curvature = -0.2)
  28. #' b + geom_curve(aes(x = x1, y = y1, xend = x2, yend = y2), data = df, curvature = 1)
  29. #' b + geom_curve(
  30. #' aes(x = x1, y = y1, xend = x2, yend = y2),
  31. #' data = df,
  32. #' arrow = arrow(length = unit(0.03, "npc"))
  33. #' )
  34. #'
  35. #' ggplot(seals, aes(long, lat)) +
  36. #' geom_segment(aes(xend = long + delta_long, yend = lat + delta_lat),
  37. #' arrow = arrow(length = unit(0.1,"cm"))) +
  38. #' borders("state")
  39. #'
  40. #' # You can also use geom_segment to recreate plot(type = "h") :
  41. #' counts <- as.data.frame(table(x = rpois(100,5)))
  42. #' counts$x <- as.numeric(as.character(counts$x))
  43. #' with(counts, plot(x, Freq, type = "h", lwd = 10))
  44. #'
  45. #' ggplot(counts, aes(x, Freq)) +
  46. #' geom_segment(aes(xend = x, yend = 0), size = 10, lineend = "butt")
  47. geom_segment <- function(mapping = NULL, data = NULL,
  48. stat = "identity", position = "identity",
  49. ...,
  50. arrow = NULL,
  51. lineend = "butt",
  52. na.rm = FALSE,
  53. show.legend = NA,
  54. inherit.aes = TRUE) {
  55. layer(
  56. data = data,
  57. mapping = mapping,
  58. stat = stat,
  59. geom = GeomSegment,
  60. position = position,
  61. show.legend = show.legend,
  62. inherit.aes = inherit.aes,
  63. params = list(
  64. arrow = arrow,
  65. lineend = lineend,
  66. na.rm = na.rm,
  67. ...
  68. )
  69. )
  70. }
  71. #' @rdname ggplot2-ggproto
  72. #' @format NULL
  73. #' @usage NULL
  74. #' @export
  75. GeomSegment <- ggproto("GeomSegment", Geom,
  76. required_aes = c("x", "y", "xend", "yend"),
  77. non_missing_aes = c("linetype", "size", "shape"),
  78. default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
  79. draw_panel = function(data, panel_scales, coord, arrow = NULL,
  80. lineend = "butt", na.rm = FALSE) {
  81. data <- remove_missing(data, na.rm = na.rm,
  82. c("x", "y", "xend", "yend", "linetype", "size", "shape"),
  83. name = "geom_segment")
  84. if (empty(data)) return(zeroGrob())
  85. if (coord$is_linear()) {
  86. coord <- coord$transform(data, panel_scales)
  87. return(segmentsGrob(coord$x, coord$y, coord$xend, coord$yend,
  88. default.units = "native",
  89. gp = gpar(
  90. col = alpha(coord$colour, coord$alpha),
  91. fill = alpha(coord$colour, coord$alpha),
  92. lwd = coord$size * .pt,
  93. lty = coord$linetype,
  94. lineend = lineend
  95. ),
  96. arrow = arrow
  97. ))
  98. }
  99. data$group <- 1:nrow(data)
  100. starts <- subset(data, select = c(-xend, -yend))
  101. ends <- plyr::rename(subset(data, select = c(-x, -y)), c("xend" = "x", "yend" = "y"),
  102. warn_missing = FALSE)
  103. pieces <- rbind(starts, ends)
  104. pieces <- pieces[order(pieces$group),]
  105. GeomPath$draw_panel(pieces, panel_scales, coord, arrow = arrow,
  106. lineend = lineend)
  107. },
  108. draw_key = draw_key_path
  109. )