2

I'm trying to plot a gpx track in a Shiny application such that the gpx plot color is based on the elevation (altitude) at any given point. My sample gpx files contain anywhere between 4,000 and 10,000 points (coordinate pairs). The elevation can show minimal variation (flat track near sea level) or variation upto 1600m (hiking trails).

** Desired Output **

Sample from https://iosphere.github.io/Leaflet.hotline/demo/ using plugins in Leaflet. More details here: https://github.com/iosphere/Leaflet.hotline/ There's no R code available and I don't know how to integrate plugins for leaflet in R.

enter image description here

** Reading Data **

dat <- plotKML::readGPX(my_gpx_file) # sample file link below
track <- as.data.table(dat$tracks[[1]][[1]])
track[, ele := as.numeric(ele)]

** With Plotly **

The scattermapbox option only plots markers which can be colored based on a column but the output markers are not connected by lines (expected)

plot_mapbox(data = track, mode = 'scattermapbox') %>%
  add_markers(x = ~lon, y = ~lat, color = ~ele, hoverinfo = 'none') %>%
  layout(
    mapbox = list(
      zoom = 10,
      center = list(lon = track[, mean(lon)], lat = track[, mean(lat)])
    )
  )

enter image description here

switching to add_trace(..., mode = 'lines+markers') retains the marker color from above screenshot but colors the line with a uniform standard blue. If set to add_trace(..., mode = 'lines') the plot disappears (i.e. does not render):

enter image description here

** Using Leaflet **

With a basic call using addPolyLines :

leaflet(track) %>%
  fitBounds(lng1 = min(track$lon), lat1 = min(track$lat),
            lng2 = max(track$lon), lat2 = max(track$lat)) %>%
  clearShapes() %>%
  clearControls() %>%
  addProviderTiles(
    provider = providers$Thunderforest,
    options = list(variant = 'transport',
                   apikey = my_api_key)
  ) %>%
  addPolylines(lng = ~lon,
               lat = ~lat)

enter image description here

Using color = ~ele in the addPolylines call doesn't work (plot vanishes) but the tiles remain. I've tried using colorNumeric, colorRamp as well with the same results. The call was modified to addPolylines(..., color = ~colorFunc(ele)) where colorFunc could be:

colorFunc <- colorNumeric(
  palette = c('#000000', '#B20000') ,
  domain = track$ele
)

or

colorFunc <- colorRamp(
  colors = c('#FDFDFD', '#B20000'), 
  bias = 5, 
  interpolate = 'linear'
  )

colorRamp showed a variation in the output for different values of elevation whereas colorNumeric always defaulted to the high color (#B20000). colorRampPalette worked for some folks but didn't change my output here.

I've seen several answers on SO and other forums but none of them worked out for me.

  1. Leaflet colours for polylines
  2. How to plot polylines in multiple colors in R?
  3. Adding color to polylines in leaflet in R
  4. https://gis.stackexchange.com/questions/90193/color-code-a-leaflet-polyline-based-on-additional-values-e-g-altitude-speed

** Data **

sample data below (50 points only). You can download a sample file here: https://ridewithgps.com/routes/28431977

structure(list(lat = c(45.54214, 45.54205, 45.54183, 45.54148, 
45.54103, 45.54081, 45.54041, 45.54036, 45.5403499, 45.53998, 
45.53985, 45.53954, 45.5394, 45.53918, 45.53898, 45.53893, 45.53893, 
45.53882, 45.53882, 45.53884, 45.53888, 45.5390299, 45.53926, 
45.53937, 45.53976, 45.54013, 45.54032, 45.54045, 45.54048, 45.54055, 
45.5406199, 45.54071, 45.5409099, 45.54103, 45.54131, 45.54162, 
45.54197, 45.54247, 45.5427, 45.5428, 45.5441, 45.5443799, 45.54557, 
45.54627, 45.54639, 45.54656, 45.54667, 45.54685, 45.54706, 45.54714
), lon = c(-73.55111, -73.55079, -73.55008, -73.5489, -73.54741, 
-73.54671, -73.54546, -73.54528, -73.54524, -73.54394, -73.54346, 
-73.54244, -73.54192, -73.54115, -73.54048, -73.54029, -73.54029, 
-73.54025, -73.54025, -73.54021, -73.54013, -73.53994, -73.53964, 
-73.53954, -73.53937, -73.53905, -73.5389, -73.53877, -73.53871, 
-73.53827, -73.53814, -73.53812, -73.53824, -73.53825, -73.5381, 
-73.5378, -73.53758, -73.53713, -73.53706, -73.53701, -73.53625, 
-73.536, -73.53537, -73.53502, -73.53498, -73.5349899, -73.53504, 
-73.53528, -73.53529, -73.53527), ele = c(23.7, 23.3, 22.8, 21.9, 
21.6, 21.8, 21.9, 22.1, 22.1, 21.2, 20, 17.7, 16.6, 15.3, 14.8, 
14.8, 14.8, 14.7, 14.7, 14.7, 14.7, 14.8, 14.8, 14.8, 14.3, 13.6, 
13.4, 13.2, 13.1, 12.6, 12.5, 12.4, 12.6, 12.6, 12.4, 12.2, 12.4, 
12.3, 12.2, 12.2, 12.3, 12.4, 12.7, 12.9, 12.9, 12.9, 12.9, 13.2, 
13.2, 13.2)), row.names = c(NA, -50L), class = c("data.table", 
"data.frame"), .internal.selfref = <pointer: 0x7f91fb8096e0>)
Gautam
  • 2,597
  • 1
  • 28
  • 51

1 Answers1

2

Here is my go at things...

inspiration from: https://gist.github.com/helgasoft/799fac40f6fa2561c61cd1404521573a

library(plotKML)  #for reading gpx
library(dplyr)    #for setting ele to numeric
library(leaflet)
library(htmltools)
library(htmlwidgets)

#load gpx file, convert data to lat-lon-ele data.frame
mydata <- plotKML::readGPX( "./temp/19_aout_2018_-_au_complet.gpx" )$tracks[[1]][[1]] %>%
  dplyr::mutate( ele = as.numeric( ele ) )
#download the needed js-file to C:/temp (create c:/Temp first if necessairy)
download.file("https://raw.githubusercontent.com/iosphere/Leaflet.hotline/master/dist/leaflet.hotline.js", 
              'C:/Temp/leaflet.hotline.js', mode="wb")
#load the plugin
hotlinePlugin <- htmltools::htmlDependency(
  name = 'Leaflet.hotline',
  version = "0.4.0",
  src = c(file = normalizePath('C:/Temp')),
  script = "leaflet.hotline.js"
  )
#register plugin
registerPlugin <- function( map, plugin ) {
  map$dependencies <- c( map$dependencies, list( plugin ) )
  map
}
#draw leaflet
leaflet() %>% addTiles() %>%
  fitBounds( min(mydata$lon), min(mydata$lat), max(mydata$lon), max(mydata$lat) ) %>%
  registerPlugin(hotlinePlugin) %>%
  onRender("function(el, x, data) {
    data = HTMLWidgets.dataframeToD3(data);
    data = data.map(function(val) { return [val.lat, val.lon, val.ele]; });
    L.hotline(data, {min: 15, max: 70}).addTo(this);
  }", data = mydata )

enter image description here

Wimpel
  • 26,031
  • 1
  • 20
  • 37
  • Thanks, much appreciated! Could you add some explanation on how this works - I've got a few more parameters that I could base the plot on (min. value, color palette etc.). Also, how would this work for a shiny app? – Gautam Jun 30 '20 at 13:34
  • parameters that ban be added are on the github-page you mentioned in your question..., you enter them here in the code, separated by a comma, the way I already entered `min` and `max`: `{min: 15, max: 70}`.. for a hiny app, I guess it works the same, but you'll have to put your `leaflet.hotline.js` in a data-folder insice your app, and link there... – Wimpel Jun 30 '20 at 13:44
  • further eplanation... not really.. I'm no leaflet expert and constructed this example based on some googling and my own limited leaflet-knowledge. – Wimpel Jun 30 '20 at 13:45
  • and for the shiny part: in the link in my answer, is acually a shiny app... so it should probably work just fine if you follow that example... – Wimpel Jun 30 '20 at 13:47
  • It works for a standalone map but doesn't work with `leafletProxy` in the Shiny `server` code.. – Gautam Jun 30 '20 at 19:54
  • Sorry to hear that. Perhaps it is better to ask a new question, building on this code. – Wimpel Jun 30 '20 at 21:42