rgisr-sfr-leaflet

Display and offset overlapping polylines based on column value


I'm trying to stretch what I can do in R and have hit a wall and hope you can point me in the right direction on how best I could accomplish what I want to do. I am plotting a bunch of polylines from a shape file whose data looks like this:

placename,placetype,placebook,numbooks,row_number,placelinecoords
Main Street,street,"BOOKTDS",1,1,LINESTRING(-3.700559678237278 40.42098474661999,-3.698346475125229 40.42033268716025,-3.69731867182242 40.42003534594848,-3.697243299580215 40.42003534594848)
First Street,street,"BOOKESM",3,1,LINESTRING(-3.710546258545151 40.41308011176736,-3.710213664627304 40.41309440722183,-3.709234658336868 40.41341707524381,-3.708880606746902 40.4135232694443,-3.708711627578964 40.41372748858957)
First Street,street,"BOOKTDS",3,2,LINESTRING(-3.710546258545151 40.41308011176736,-3.710213664627304 40.41309440722183,-3.709234658336868 40.41341707524381,-3.708880606746902 40.4135232694443,-3.708711627578964 40.41372748858957)
First Street,street,"BOOKLDE",3,3,LINESTRING(-3.710546258545151 40.41308011176736,-3.710213664627304 40.41309440722183,-3.709234658336868 40.41341707524381,-3.708880606746902 40.4135232694443,-3.708711627578964 40.41372748858957)
Loughborough Street,street,"BOOKESM",2,1,LINESTRING(-3.707336328013795 40.42433623251054,-3.707014282978915 40.42429971916709,-3.706726498054129 40.42429971916709,-3.706281116622912 40.42409628731927,-3.705390353760477 40.42377288157678,-3.704602371228324 40.42316257940762,-3.70376642454204 40.42259400231908)
Loughborough Street,street,"BOOKTDS",2,2,LINESTRING(-3.707336328013795 40.42433623251054,-3.707014282978915 40.42429971916709,-3.706726498054129 40.42429971916709,-3.706281116622912 40.42409628731927,-3.705390353760477 40.42377288157678,-3.704602371228324 40.42316257940762,-3.70376642454204 40.42259400231908)
Oak Street,street,"BOOKLMI",2,1,LINESTRING(-3.700391803697817 40.41664973667679,-3.700384951675798 40.41673842198933,-3.699754565650076 40.4176044018386,-3.699549004989513 40.41782350340716)
Oak Street,street,"BOOKLBU",2,2,LINESTRING(-3.700391803697817 40.41664973667679,-3.700384951675798 40.41673842198933,-3.699754565650076 40.4176044018386,-3.699549004989513 40.41782350340716)

"placebook" is a unique code for a book where a particular street name appears. I have assigned each book with a color and load in the data:

books = c("OBRAESM", "OBRAHOR", "OBRAINS", "OBRALBU", "OBRALCT", "OBRALDB","OBRALDE","OBRALMI","OBRALPI","OBRATDS")
color = c("red", "orange", "yellow", "green", "blue", "pink","gray","purple","black","white")
df = cbind.data.frame(books,color)
colnames(df) = c("books","color")

placeographypaths <- readOGR("shapefiles/places_paths.shp")
placeographypathsstreets <- subset(placeographypaths, placetype %like% "street")

What I would like to do is plot these lines onto the map by book, with each appearing as a different color. When there is more than one book assigned to a particular line, I would need to offset the lines so they are all visible. These lines will overlap in their entirety and in most cases there will only be a few lines overlapping in the same location (the maximum is 5, but most are 1-3).

So "First Street" would display three lines: red, gray, and white. I see there's a PolylineOffset tool, but I can't find any examples that use column values as the criteria for offsetting--and it seems to mostly apply to more complex situations where only a part of the line overlaps)--perhaps there's a simpler solution that I'm missing.


Solution

  • I spent some time to think what I could do since I do not know how to use PolylineOffset. It seems that this feature will be coming in the leaflet package. I want to suggest an alternative for your visualization. Reading your question, you would have five types of lines. That is, each line type can represent how many times streets appear in your data set. You said the maximum overlapping is five times. I think you can create five levels in in a grouping variable and create colors in leaflet.

    First, I summarized your data grouping by placename. For each placename, I counted how many data points (rows) exist. I also created a string containing book names. The string is arranged for popups. Then, I created a color palette for leaflet. Finally, I drew a map. If you want something fancier, I think you can use the htmlTable package, for example.

    library(dplyr)
    library(leaflet)
    library(sf)
    library(viridis)
    
    # Aggregate the data by placename. Note your data is called mysf, which is an
    # sf object.
    
    group_by(mysf, placename) %>% 
    summarize(frequency = factor(n(), levels = 1:3, labels = c("1", "2", "3")),
              books = paste0("<br/>", paste0(placebook, collapse = "<br/>"))) -> mysf2
    
    # Create categorical colors
    # I am checking colors here
    previewColors(colorFactor(palette = "viridis", domain = mysf2$frequency),
                              values = unique(mysf2$frequency))
    
    # Create my own palette
    mypal <- colorFactor(palette = "viridis", domain = mysf2$frequency)
    
    # Draw a leaflet map
    leaflet() %>% 
    addProviderTiles("CartoDB.Positron") %>% 
    addPolylines(data = mysf2, color = ~mypal(mysf2$frequency),
                 popup = paste("Place: ", mysf2$placename, "<br>",
                               "Book(s): ", mysf2$books, "<br>")) %>% 
    addLegend(position = "bottomright", pal = mypal, values = mysf2$frequency,
              title = "Frequency",
              opacity = 1)
    

    enter image description here

    Finally one note. The way you provided your data does not unfortunately work for anybody to replicate your situation. (I invested some good amount of time to manually create your data. I would not do this if I do not have enough time. Perhapd you would not want to as well, right?) If your data is large, you want to consider uploading it somewhere else. Otherwise, you can use dput() which creates a copy of your data. If you carefully see questions in R, many users provide their data with dput(). I highly recommend you to use this function when you ask more questions in the future.

    DATA

    mysf <- structure(list(placename = structure(c(3L, 1L, 1L, 1L, 2L, 2L, 
    4L, 4L), .Label = c("First Street", "Loughborough Street", "Main Street", 
    "Oak Street"), class = "factor"), placetype = structure(c(1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = "placetype", class = "factor"), 
    placebook = structure(c(5L, 1L, 5L, 3L, 1L, 5L, 4L, 2L), .Label = c("BOOKESM", 
    "BOOKLBU", "BOOKLDE", "BOOKLMI", "BOOKTDS"), class = "factor"), 
    geometry = structure(list(structure(c(-3.70055967823728, 
    -3.69834647512523, -3.69731867182242, -3.69724329958022, 
    40.42098474662, 40.4203326871602, 40.4200353459485, 40.4200353459485
    ), .Dim = c(4L, 2L), class = c("XY", "LINESTRING", "sfg")), 
        structure(c(-3.71054625854515, -3.7102136646273, -3.70923465833687, 
        -3.7088806067469, -3.70871162757896, 40.4130801117674, 
        40.4130944072218, 40.4134170752438, 40.4135232694443, 
        40.4137274885896), .Dim = c(5L, 2L), class = c("XY", 
        "LINESTRING", "sfg")), structure(c(-3.71054625854515, 
        -3.7102136646273, -3.70923465833687, -3.7088806067469, 
        -3.70871162757896, 40.4130801117674, 40.4130944072218, 
        40.4134170752438, 40.4135232694443, 40.4137274885896), .Dim = c(5L, 
        2L), class = c("XY", "LINESTRING", "sfg")), structure(c(-3.71054625854515, 
        -3.7102136646273, -3.70923465833687, -3.7088806067469, 
        -3.70871162757896, 40.4130801117674, 40.4130944072218, 
        40.4134170752438, 40.4135232694443, 40.4137274885896), .Dim = c(5L, 
        2L), class = c("XY", "LINESTRING", "sfg")), structure(c(-3.70733632801379, 
        -3.70701428297891, -3.70672649805413, -3.70628111662291, 
        -3.70539035376048, -3.70460237122832, -3.70376642454204, 
        40.4243362325105, 40.4242997191671, 40.4242997191671, 
        40.4240962873193, 40.4237728815768, 40.4231625794076, 
        40.4225940023191), .Dim = c(7L, 2L), class = c("XY", 
        "LINESTRING", "sfg")), structure(c(-3.70733632801379, 
        -3.70701428297891, -3.70672649805413, -3.70628111662291, 
        -3.70539035376048, -3.70460237122832, -3.70376642454204, 
        40.4243362325105, 40.4242997191671, 40.4242997191671, 
        40.4240962873193, 40.4237728815768, 40.4231625794076, 
        40.4225940023191), .Dim = c(7L, 2L), class = c("XY", 
        "LINESTRING", "sfg")), structure(c(-3.70039180369782, 
        -3.7003849516758, -3.69975456565008, -3.69954900498951, 
        40.4166497366768, 40.4167384219893, 40.4176044018386, 
        40.4178235034072), .Dim = c(4L, 2L), class = c("XY", 
        "LINESTRING", "sfg")), structure(c(-3.70039180369782, 
        -3.7003849516758, -3.69975456565008, -3.69954900498951, 
        40.4166497366768, 40.4167384219893, 40.4176044018386, 
        40.4178235034072), .Dim = c(4L, 2L), class = c("XY", 
        "LINESTRING", "sfg"))), class = c("sfc_LINESTRING", "sfc"
    ), precision = 0, bbox = structure(c(xmin = -3.71054625854515, 
    ymin = 40.4130801117674, xmax = -3.69724329958022, ymax = 40.4243362325105
    ), class = "bbox"), crs = structure(list(epsg = 4326L, proj4string = "+proj=longlat +datum=WGS84 +no_defs"), class = "crs"), n_empty = 0L)), row.names = c(NA, 
    8L), sf_column = "geometry", agr = structure(c(placename = NA_integer_, 
    placetype = NA_integer_, placebook = NA_integer_), class = "factor", .Label = c("constant", 
    "aggregate", "identity")), class = c("sf", "data.frame"))