ranimationplotlymapbox

R mapbox / plotly with animation and a shapefile

I'm putting together an animation that shows spatial data plotted on a map, with a date-based animation slider. In addition to these, I want to plot a shapefile that is stationary over time. My animation works fine without the shapefile. Plotting both markers and shapefile doesn't show the shapefile (seems to be some kind of a disconnect between add_sf and the layout specs that I don't understand), and also breaks the animation. How can these be made to work together? I think I need to stick with the plot_ly specification (as opposed to plot_mapbox) to make other components of my actual plot work together (here and here).

library(sf)
library(dplyr)
library(plotly)

nc <- st_read(system.file("shape/nc.shp", package="sf")) %>%
      select(AREA) %>%
       sf::st_cast("MULTILINESTRING") %>%
       sf::st_cast("LINESTRING")
df <- expand.grid(x = seq(-76, -84, -2), y = seq(34, 36, 1),
                  Date = seq(as.Date("2000-01-01"), as.Date("2000-04-01"), by = "1 day")) %>%
      mutate(x = rnorm(n(), x, 1),
              y = rnorm(n(), y, 1),
             Date = as.factor(Date))


df %>%
  plot_ly(lon = ~x, lat = ~y, frame = ~Date, 
          type = "scattermapbox", mode = "markers") %>%
  ######### this line breaks the animation and doesn't show the sf. Uncomment to check
  #########add_sf(data = nc, inherit = FALSE, color = I("white")) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                     center = list(lon = -80 ,lat= 35),
                     layers = list(list(below = 'traces', sourcetype = "raster",
                                        source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}")))))
Solution

  • Add-On

    To change the order of the traces 2 things have to happen, the literal trace order and the trace index assigned to each frame. Everything in my original answer still applies, but in lieu of fixer(), here is fixer2()

    fixer2 <- function(plt1, plt2) {
  # change the order of the traces (considering fixer())
  # where plt1 has frames and plt2 does not
  # get lines' trace from plt2, add to plt1 as the first trace
  # change the 'trace' index in each frame in plt1$x$frames
  plt1 <- plotly_build(plt1); plt2 <- plotly_build(plt2)  # prep by building
  lines2 <- lapply(1:length(plt2$x$data), function(i) {
    if(plt2$x$data[[i]]$mode == "lines") {   # extract index for combined plot
      return(i)
    }
  }) %>% unlist()
  plt1$x$data <- append(plt2$x$data[lines2], plt1$x$data) # add data diff order
  lapply(1:length(plt1$x$frames), function(j) {    # change frames trace index
    plt1$x$frames[[j]]$traces <<- 1 + plt1$x$frames[[j]]$traces
  }) # this assumes scatter is one color
  plt1   # return modified plot
}
fixer2(p1, p2)

    The Original Answer (before the add-on)

    I'm guessing that what you're looking for is a static outline of NC's counties during the animation. If that's an accurate assumption this will work. I tried several different approaches because I don't understand why Plotly gets so lost in translation. However, I could only get it to function appropriately with a workaround (versus a plotly parameter or something along those lines).

    First, I'll show you my solution.

    Then I've got a did you know? and a perhaps this would look a bit better if...

    The plot

    I created two scattermapbox plots and combined them with a UDF. I've essentially used your code, but made both scattermapbox (versus one scattermapbox and one add_sf).

    library(sf)
library(dplyr)
library(plotly)

nc <- st_read(system.file("shape/nc.shp", package="sf")) %>%
  select(AREA) %>%
  sf::st_cast("MULTILINESTRING") %>%
  sf::st_cast("LINESTRING")

df <- expand.grid(x = seq(-76, -84, -2), y = seq(34, 36, 1),
                  Date = seq(as.Date("2000-01-01"), as.Date("2000-04-01"), by = "1 day")) %>%
  mutate(x = rnorm(n(), x, 1),
         y = rnorm(n(), y, 1),
         Date = as.factor(Date))


p1 <- plot_ly(data = df, lon = ~x, lat = ~y, frame = ~Date, 
              type = "scattermapbox", mode = "markers") %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 

p2 <- plot_ly(data = nc, type = "scattermapbox", color = I("white")) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}")))))

    In the UDF, I take the lines trace from the data = nc plot and add that data to the other plot.

    fixer <- function(plt1, plt2) {
  # where plt1 has frames and plt2 does not
  # get lines' trace from plt2
  # add lines' trace data to plt1$x$data 
  plt1 <- plotly_build(plt1); plt2 <- plotly_build(plt2)  # prep by building
  lines2 <- lapply(1:length(plt2$x$data), function(i) {
    if(plt2$x$data[[i]]$mode == "lines") {   # extract index for combined plot
      return(i)
    }
  }) %>% unlist()
  plt1$x$data <- append(plt1$x$data, plt2$x$data[lines2]) # add data to plt1
  plt1   # return modified plot
}
fixer(p1, p2)

    enter image description here

    enter image description here

    Did you know?

    You did some extra work with the nc data, using select and st_cast. However, that work didn't change anything...I'm not sure what the objective was there.

    To create an identical map, you can leave the data as-is and add fill = "none" to the trace.

    Here's a visual explanation.

    nc2 <- st_read(system.file("shape/nc.shp", package="sf"))

p3 <- plot_ly(data = nc2, fill = "none", type = "scattermapbox", color = I("white")) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 
fixer(p1, p3)

    enter image description here

    It might look a bit better if...

    I noticed that the lines are so thick, that it's difficult to see the animation, so I thought I would add in that the default line in scattermapbox is line = list(width = 2). In this variation, I used the original nc data and cut the line width in half. (It's still really ostentatious though.)

    p4 <- plot_ly(data = nc2, fill = "none", type = "scattermapbox", color = I("white"), 
              line = list(width = 1)) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 
fixer(p1, p4)

    enter image description here

    All the code altogether

    Here's all the code (broken down above) in one place (easier copy + paste and all that).

    library(sf)
library(dplyr)
library(plotly)

nc <- st_read(system.file("shape/nc.shp", package="sf")) %>%
  select(AREA) %>%
  sf::st_cast("MULTILINESTRING") %>%
  sf::st_cast("LINESTRING")

df <- expand.grid(x = seq(-76, -84, -2), y = seq(34, 36, 1),
                  Date = seq(as.Date("2000-01-01"), as.Date("2000-04-01"), by = "1 day")) %>%
  mutate(x = rnorm(n(), x, 1),
         y = rnorm(n(), y, 1),
         Date = as.factor(Date))

#---------------------------- basic fix ----------------------------
p1 <- plot_ly(data = df, lon = ~x, lat = ~y, frame = ~Date, 
              type = "scattermapbox", mode = "markers") %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 

p2 <- plot_ly(data = nc, type = "scattermapbox", color = I("white")) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 


fixer <- function(plt1, plt2) {
  # where plt1 has frames and plt2 does not
  # get lines' trace from plt2
  # add lines' trace data to plt1$x$data 
  plt1 <- plotly_build(plt1); plt2 <- plotly_build(plt2)  # prep by building
  lines2 <- lapply(1:length(plt2$x$data), function(i) {
    if(plt2$x$data[[i]]$mode == "lines") {   # extract index for combined plot
      return(i)
    }
  }) %>% unlist()
  plt1$x$data <- append(plt1$x$data, plt2$x$data[lines2]) # add data to plt1
  plt1   # return modified plot
}
fixer(p1, p2)


#---------------------- using NC data as is-------------------------
nc2 <- st_read(system.file("shape/nc.shp", package="sf"))

p3 <- plot_ly(data = nc2, fill = "none", type = "scattermapbox", color = I("white")) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 
fixer(p1, p3)

#----------- basic NC data & different line aesthetics -------------
p4 <- plot_ly(data = nc2, fill = "none", type = "scattermapbox", color = I("white"), 
              line = list(width = 1)) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 
fixer(p1, p4)