Reputation: 2753
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.
** 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)])
)
)
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):
** 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)
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.
** 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
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 )
Upvotes: 2