diff --git a/DESCRIPTION b/DESCRIPTION index 5143fd1..319a20c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,6 +20,7 @@ BugReports: https://github.com/NONONOexe/pavement/issues Depends: R (>= 3.3.0) Imports: + graphics, grDevices, igraph, lwgeom, diff --git a/NAMESPACE b/NAMESPACE index 9269a28..55593c3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -46,6 +46,9 @@ export(split_linestring) export(transform_to_cartesian) export(transform_to_geographic) importFrom(grDevices,heat.colors) +importFrom(graphics,axis) +importFrom(graphics,par) +importFrom(graphics,segments) importFrom(igraph,"E<-") importFrom(igraph,E) importFrom(igraph,graph_from_data_frame) diff --git a/R/create-segmented-network.R b/R/create-segmented-network.R index ee8b1ee..31b9e8f 100644 --- a/R/create-segmented-network.R +++ b/R/create-segmented-network.R @@ -13,7 +13,10 @@ #' road_network <- create_road_network(sample_roads) #' #' # Create a segmented road network -#' segmented_network <- create_segmented_network(road_network) +#' segmented_network <- create_segmented_network( +#' road_network, +#' segment_length = 0.5 +#' ) #' segmented_network #' #' # Plot the segmented road network @@ -84,24 +87,87 @@ plot.segmented_network <- function( ... ) { mode <- match.arg(mode) + if (mode == "event") { - plot(x$links$geometry, lwd = 1) - plot(x$events$geometry, cex = 1, pch = 4, col = "red", add = TRUE) + plot(x$links$geometry, lwd = 1, ...) + plot(x$events$geometry, cex = 1, pch = 4, col = "red", add = TRUE, ...) } else if (mode %in% c("count", "density")) { - targets <- x$links[[mode]] - colors <- heat.colors(100, rev = TRUE) - normalized_values <- targets / max(targets) - link_colors <- colors[as.numeric(cut(normalized_values, breaks = 100))] - link_colors[targets == 0] <- "#ACACAC" - link_widths <- 1 - link_widths[targets != 0] <- 2 - plot(x$links$geometry, col = link_colors, lwd = link_widths) + plot_coloured_segmented_network(x$links$geometry, x$links[[mode]], ...) + plot_legends(x$links[[mode]], mode, ...) + reset_layout() } else { plot(x$links$geometry, lwd = 1, ...) plot(x$nodes$geometry, cex = 1, pch = 16, add = TRUE, ...) } } +reset_layout <- function() { + par(fig = c(0, 1, 0, 1), mar = c(5, 4, 4, 2) + 0.1, oma = c(0, 0, 0, 0)) +} + +plot_coloured_segmented_network <- function(network_linestrings, + segment_values, + ...) { + par(fig = c(0, 0.75, 0, 1), mar = c(0, 0, 0, 0)) + plot(network_linestrings, lwd = 1, ...) + plot( + network_linestrings, + col = get_heatmap_colours(segment_values), + lwd = ifelse(segment_values == 0, 1, 2), + add = TRUE, + ... + ) +} + +plot_legends <- function(segment_values, mode, ...) { + main <- switch (mode, count = "Count", density = "Probability\ndensity") + digits <- ifelse(mode == "count", 0, 3) + labels <- unique(round(seq(0, max(segment_values), length.out = 5), digits)) + + par( + fig = c(0.75, 0.95, 0.3, 0.7), + mar = c(0, 0, 3, 0.5), + cex.main = 1, + new = TRUE + ) + plot( + x = rep(1, 100), + y = seq(0, 1, length.out = 100), + xlim = c(0, 1), + col = get_heatmap_colours(seq(0, 1, length.out = 100)), + type = "n", + xaxs = "i", + yaxs = "i", + axes = FALSE, + main = main + ) + segments( + x0 = 0.4, + x1 = 0.6, + y0 = seq(0, 1, length.out = 100), + y1 = seq(0, 1, length.out = 100), + col = get_heatmap_colours(seq(0, 1, length.out = 100)), + lwd = 20, + lend = "butt" + ) + axis( + 4, + at = seq(0, 1, length.out = length(labels)), + labels = labels, + line = -1.5, + tick = TRUE, + las = 2 + ) +} + +get_heatmap_colours <- function(segment_values) { + heatmap_colours <- paste0(heat.colors(100, rev = TRUE), "CD") + normalized_values <- segment_values / max(segment_values) + colours <- heatmap_colours[as.numeric(cut(normalized_values, breaks = 100))] + + return(colours) +} + #' @export summary.segmented_network <- function(object, ...) { cat("Segmented network summary\n") diff --git a/R/pavement-package.R b/R/pavement-package.R index 5c01d66..11d2e08 100644 --- a/R/pavement-package.R +++ b/R/pavement-package.R @@ -2,6 +2,9 @@ "_PACKAGE" ## usethis namespace: start +#' @importFrom graphics axis +#' @importFrom graphics par +#' @importFrom graphics segments #' @importFrom grDevices heat.colors #' @importFrom igraph E #' @importFrom igraph E<- diff --git a/man/create_segmented_network.Rd b/man/create_segmented_network.Rd index 1723b7d..51854b4 100644 --- a/man/create_segmented_network.Rd +++ b/man/create_segmented_network.Rd @@ -24,7 +24,10 @@ input road network into segments of a specified length. road_network <- create_road_network(sample_roads) # Create a segmented road network -segmented_network <- create_segmented_network(road_network) +segmented_network <- create_segmented_network( + road_network, + segment_length = 0.5 +) segmented_network # Plot the segmented road network diff --git a/man/figures/README-example-2.png b/man/figures/README-example-2.png index fca1606..a06e554 100644 Binary files a/man/figures/README-example-2.png and b/man/figures/README-example-2.png differ