File: geom_edge_sf.R

package info (click to toggle)
r-cran-ggraph 2.2.1%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,832 kB
  • sloc: cpp: 1,630; makefile: 2
file content (71 lines) | stat: -rw-r--r-- 2,021 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
#' Draw edges as LINESTRINGs in geographical space
#'
#' This geom is equivalent in functionality to [ggplot2::geom_sf()] for `LINESTRING`
#' geometries and allows for plotting of edges in their geographical space in
#' different colours, linetypes and widths.
#'
#' @section Aesthetics:
#' `geom_edge_sf` understand the following aesthetics.
#'
#' - alpha
#' - colour
#' - linetype
#' - filter
#'
#' @inheritParams ggplot2::geom_sf
#'
#' @param mapping Set of aesthetic mappings created by [ggplot2::aes()]
#' or [ggplot2::aes_()]. By default geometry is mapped to the geometry in
#' the edge data.
#'
#' @author Lorena Abad
#'
#' @family geom_edge_*
#'
#' @examples
#' if (require("sfnetworks", quietly = TRUE)) {
#'   gr <- sfnetworks::as_sfnetwork(roxel)
#'   ggraph(gr, 'sf') + geom_edge_sf()
#' }
#'
#' @export
#'
geom_edge_sf <- function(mapping = NULL, data = get_sf_edges(),
                         position = 'identity', show.legend = NA, ...) {
  mapping <- complete_edge_aes(mapping)
  mapping <- aes_intersect(mapping, aes(geometry = geometry))
  c(
    layer_sf(
      geom = GeomEdgeSf, data = data, mapping = mapping, stat = StatFilterSf,
      position = position, show.legend = show.legend, inherit.aes = FALSE,
      params = expand_edge_aes(list2(na.rm = FALSE, ...))
    ),
    coord_sf(default = TRUE)
  )
}
#' @rdname get_edges
get_sf_edges <- function(){
  function(layout) {
    edges <- sf::st_as_sf(attr(layout, "graph"), "edges")
    attr(edges, 'type_ggraph') <- 'edge_ggraph'
    edges
  }
}

#' @rdname ggraph-extensions
#' @format NULL
#' @usage NULL
#' @export
GeomEdgeSf = ggproto("GeomEdgeSf", GeomSf,
  draw_panel = function(data, panel_params, coords) {
    names(data) <- sub('edge_', '', names(data))
    names(data)[names(data) == 'width'] <- 'linewidth'
    GeomSf$draw_panel(data, panel_params, coords)
  },
  draw_key = GeomEdgePath$draw_key,
  default_aes = aes(
    edge_colour = 'black', edge_width = 0.5, edge_linetype = 1,
    edge_alpha = NA
  ),
  rename_size = FALSE
)