path data example

[timelyportfolio]

After some Twitter feedback, I thought an example with path data might be helpful.

library(mapview)  # for breweries data that we will use for the example
library(sf)
library(leaflet)
library(leaftime)
library(geojsonio)

b2 <- breweries
# add some hourly increment times for start and end
b2$start <- seq.POSIXt(Sys.time(), by = "hour", length.out = nrow(breweries))
# add one hour and then increment by hour for end time
b2$end <- seq.POSIXt(Sys.time() + 60*60, by = "hour", length.out = nrow(breweries) + 1)[-1]
# now combine points with previous and make into linestring
b2$geometry[-1] <- mapply(
  function(x1,x2) {
    st_cast(
      st_combine(c(x1,x2)),
      "LINESTRING"
    )
  },
  sf::st_geometry(b2)[-nrow(b2)],
  sf::st_geometry(b2)[-1]
)

# leaftime requires geojson in its current version
#   use geojsonio to convert to geojson
b2_geo <- geojsonio::geojson_json(b2[-1,])

bbox <- as.vector(st_bbox(b2))

# this works somehow unexpectedly
#   but leads me to realize that I need to expose style options
#   to non-point geojson data
leaflet(b2_geo) %>%
  addTiles() %>%
  fitBounds(bbox[1],bbox[2],bbox[3],bbox[4]) %>%
  addTimeline()

... but I discovered that we lose most ability to customize with path data. For instance, we can no longer control styling of the path.

[timelyportfolio]

@mdsumner @tim-salabim in reality looks like Leaflet.timeline will add any geojson. Here is another example.

library(mapview)
library(sf)
library(leaflet)
library(leaftime)
library(geojsonio)

franconia_time <- franconia
franconia_time$start <- seq.Date(Sys.Date() - nrow(franconia) - 1, by = "day", length.out = nrow(franconia))
franconia_time$end <- Sys.Date()
bbox <- as.vector(st_bbox(franconia_time))
leaflet() %>%
  fitBounds(bbox[1],bbox[2],bbox[3],bbox[4]) %>%
  addTimeline(geojsonio::geojson_json(franconia_time))

[tim-salabim]

Perfect! We can have mapview methods for space-time data classes now.

[timelyportfolio]

@tim-salabim @mdsumner I pushed develop branch that should allowing styling options for non-point data. I'll need to add more arguments for comprehensive styling options, or for now if we want non-supported style, we can use list(...) instead of using the styleOptions helper function.

franconia_time <- franconia
franconia_time$start <- seq.Date(Sys.Date() - nrow(franconia) - 1, by = "day", length.out = nrow(franconia))
franconia_time$end <- Sys.Date()
bbox <- as.vector(st_bbox(franconia_time))
leaflet() %>%
  fitBounds(bbox[1],bbox[2],bbox[3],bbox[4]) %>%
  addTimeline(
    geojsonio::geojson_json(franconia_time),
    timelineOpts = timelineOptions(
      styleOptions = styleOptions(fillColor = "purple", color = "white")
    )
  )

[mdsumner]

Hey thanks!

Here's a realistic-ish example with a set of elephant seal tracks, it works nicely - brings up the issue of needing lag-settings, but also shows that short enough segments make for pretty compelling time-continuous approximations.

Is Date required? (we can't have POSIXct for start/end)

library(sf)
library(trip)
library(leaftime)

## set of elephant seal track data
u <- "https://github.com/Trackage/animal-tracks/raw/master/ellie_IMOS.RDS"
if (!file.exists(basename(u))) curl::curl_download(u, basename(u))
dd <- readRDS(basename(u))

## take a subset
dd <- dplyr::filter(dd, as.Date(date) >= as.Date("2015-01-01"))

## create a trip because ...
tr <- trip(dplyr::select(dd, lon, lat, date, id, lc, trip))
## ...it's the easiest way to bust into segments
dt <- sf::st_as_sf(explode(tr))

bbox <- as.vector(st_bbox(dt))

## rename POSIXct to Date start/end
dt$start <- as.Date(dt$starttime)
dt$end <- as.Date(dt$endtime)
leaflet() %>%
  fitBounds(bbox[1],bbox[2],bbox[3],bbox[4]) %>%
  addTimeline(
    geojsonio::geojson_json(dt),
    timelineOpts = timelineOptions(
      styleOptions = styleOptions(fillColor = "purple", color = "white")
    )
  )

FWIW, in terms of time-continuous, and controlling lag with a time-slider the best I've seen is KML in GE, you can do that with the tr object using

#trip::write_track_kml(tr, kml_file= "my_file.kmz")

Then open that in GE (it doesn't work in he browser). The time slider pops up with play, and lag, and speed etc.

[gabezuckerman]

@timelyportfolio First want to say this is an awesome package!

But I wanted to ask whether it is possible to have 2 timelines in one map, eg points and polygons, operating at the same time scale?

The goal is just to have my polygons, that are already plotted to begin with, change colors at certain dates, while the points are moving around in the normal timeline manner.

UPDATE: After some digging, this may involve the onchange argument.

[timelyportfolio]

@gabezuckerman yes, this is possible, and now I just need to find a little bit of time to demonstrate. Sorry for the delay and thanks for the interest and use of leaftime.

[gabezuckerman]

@timelyportfolio thanks for getting back to me! Looking forward to seeing the demonstration when you get the chance.

[timelyportfolio]

@gabezuckerman this became way more complicated than I intended. Please let me know if you would like me to explain or clarify any of this code.

library(sf)
library(mapview)
library(leaflet)
library(leaftime)
library(geojsonio)

data("breweries", package="mapview")

# add some fake start and end dates
breweries$start <- rep(seq.Date(Sys.Date(), by="days", length.out = 20),20)[1:224]
breweries$end <- breweries$start + 1
# convert to geojson
brew_gj <- geojsonio::geojson_json(breweries)
bbox <- as.vector(st_bbox(breweries))

mapview(franconia, col.regions = "#CC99AA", alpha.regions = 0.2)@map %>%
  addTimeline(
    brew_gj
  ) %>%
  htmlwidgets::onRender(sprintf(
"
function(el,x) {
  var colors = %s;
  var map = this;
  // get the timeline control
  var timeline = map.layerManager._byCategory.timeline.getLayers()[1];

  // use R leaflet layerManager to get franconia polygon layer group
  var franconia = this.layerManager.getLayerGroup('franconia')

  timeline.on('change', function() {
    // figure out what time is current selected on timeline and select that color
    var time_selected = this.time;
    var idx = this.times.indexOf(time_selected);
    // but when playing instead of stepping times will not match exactly so in this case we will
    //   crudely bisect the array in a very inefficient way; easy to optimize if there is a need
    if(idx === -1) {
      this.times.forEach(function(d,i) {
        d <= time_selected ? idx = i : idx = idx;
      })
    }
    var color = colors[idx];
    franconia.setStyle({fillColor: color});
    // could also send to Shiny here if helpful
  })
}
",
    # some colors courtesy of topo.colors
    jsonlite::toJSON(substr(topo.colors(20),1,7),auto_unbox=TRUE)
  ))

[gabezuckerman]

@timelyportfolio This works great when using mapview. However, I have a shiny app in which I am using a leaflet based map. When I change this

mapview(franconia, col.regions = "#CC99AA", alpha.regions = 0.2)@map

to this

leaflet(franconia) %>% addPolygons() %>% addProviderTiles(providers$Esri.NatGeoWorldMap)

the play button no longer works, the colors of the polygon don't change, and when I slide the slider only the dots move.

This may be from my lack of understanding the nuances of the array bisection in the on change function.

Thanks again for the help!

[timelyportfolio]

@gabezuckerman Sorry, I should have taken a little more time to explain. mapview automatically adds a group name. With plain leaflet, we can do the same. Feel free to change franconia to whatever name you like, but make sure to change in JavaScript.

library(sf)
library(mapview)
library(leaflet)
library(leaftime)
library(geojsonio)

data("breweries", package="mapview")

# add some fake start and end dates
breweries$start <- rep(seq.Date(Sys.Date(), by="days", length.out = 20),20)[1:224]
breweries$end <- breweries$start + 1
# convert to geojson
brew_gj <- geojsonio::geojson_json(breweries)
bbox <- as.vector(st_bbox(breweries))

leaflet(franconia) %>%
  addPolygons(
    group = "franconia",
    stroke = TRUE, color = "#fff", weight = 3, fillColor = substr(topo.colors(1),1,7), fillOpacity = 0.5,
  ) %>%
  addProviderTiles(providers$Esri.NatGeoWorldMap) %>%
  addTimeline(
    brew_gj
  ) %>%
  htmlwidgets::onRender(sprintf(
"
function(el,x) {
  var colors = %s;
  var map = this;
  // get the timeline control
  var timeline = map.layerManager._byCategory.timeline.getLayers()[1];

  // use R leaflet layerManager to get franconia polygon layer group
  var franconia = this.layerManager.getLayerGroup('franconia')

  timeline.on('change', function() {
    // figure out what time is current selected on timeline and select that color
    var time_selected = this.time;
    var idx = this.times.indexOf(time_selected);
    // but when playing instead of stepping times will not match exactly so in this case we will
    //   crudely bisect the array
    if(idx === -1) {
      this.times.forEach(function(d,i) {
        d <= time_selected ? idx = i : idx = idx;
      })
    }
    var color = colors[idx];
    franconia.setStyle({fillColor: color});
  })
}
",
    # some colors courtesy of topo.colors
    jsonlite::toJSON(substr(topo.colors(20),1,7),auto_unbox=TRUE)
  ))

[VictorGarciaDS]

breweries$start <- rep(seq.Date(Sys.Date(), by="days", length.out = 20),20)[1:224]

Hi, I would like to know why the [1:224] is needed. Is there any way to show more possible positions for the slider?