Gautam
Gautam

Reputation: 2753

Color gpx track bsaed on elevation using leaflet or plotly

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>)

Upvotes: 2

Views: 1885

Answers (1)

Wimpel
Wimpel

Reputation: 27732

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

Upvotes: 2

Related Questions