Eliminate 'flashing' when animating addTiles()

shiny
1

I would like to display a time series of my own tile overlays. The objective is to have an animation of this overlay where tile1 is not cleared until tile2 is drawn. The present scripts suffers from 'flashing', where for a few milliseconds, all of my tiles are cleared from the map. How do I eliminate this behavior?

library(shiny)
library(leaflet)

ui <- fluidPage(
  fluidRow(
    column(4, offset = 4, 
           sliderInput(
             "sliderIn",
             "Año",
             2001,
             2016,
             value = 2001,
             step = 1,
             sep = "",
             width = 600,
             animate =
               animationOptions(interval = 750, loop = T)
           ))
  ),
  leafletOutput("map", width = "100%", height = "600px")
)

server <- function(input, output, session){
  
  year <- reactive({
    which(2001:2016 == input$sliderIn)
  })
  
  output$map <- renderLeaflet({
    leaflet(options = leafletOptions(minZoom = 0, maxZoom = 16, zoomControl = F)) %>%
      addTiles(urlTemplate = "https://mts1.google.com/vt/lyrs=s&hl=en&src=app&x={x}&y={y}&z={z}&s=G", attribution = 'Google') %>%
      setView(lng = -84.8,
              lat = 15.75,
              zoom = 10) %>%
      addTiles(urlTemplate = "https://storage.googleapis.com/honduras/forestLoss/year1/{z}/{x}/{y}.png", 
               layerId = 'ForestLoss',
               options = tileOptions(minZoom = 9, maxZoom = 18, tms = TRUE))  
  })
  
  observe({
    leafletProxy(mapId = 'map') %>%
      removeTiles('ForestLoss') %>%
      addTiles(urlTemplate = paste0('https://storage.googleapis.com/honduras/forestLoss/year',year() ,'/{z}/{x}/{y}.png'),
               layerId = 'ForestLoss',
               options = tileOptions(minZoom = 9, maxZoom = 18, tms = TRUE))
  })
  
  
}

shinyApp(ui, server)
2

I don't think the problem is Shiny/leaflet flickering. I think the problem lies here:

    leafletProxy(mapId = 'map') %>%
      removeTiles('ForestLoss') %>%
      addTiles(urlTemplate = paste0('https://storage.googleapis.com/honduras/forestLoss/year',year() ,'/{z}/{x}/{y}.png'),
               layerId = 'ForestLoss',
               options = tileOptions(minZoom = 9, maxZoom = 18, tms = TRUE))

Each time then slider changes, you remove a layer and then add a new one, which is creating the flickering appearance.

One option is to add layers cumulatively:

library(shiny)
library(leaflet)

ui <- fluidPage(
  fluidRow(
    column(4, offset = 4, 
           sliderInput(
             "sliderIn",
             "Año",
             2001,
             2016,
             value = 2001,
             step = 1,
             sep = "",
             width = 600,
             animate =
               animationOptions(interval = 750, loop = T)
           ))
  ),
  leafletOutput("map", width = "100%", height = "600px")
)

server <- function(input, output, session){
  
  year <- reactive({
    which(2001:2016 == input$sliderIn)
  })
  
  output$map <- renderLeaflet({
    leaflet(options = leafletOptions(minZoom = 0, maxZoom = 16, zoomControl = F)) %>%
      addTiles(urlTemplate = "https://mts1.google.com/vt/lyrs=s&hl=en&src=app&x={x}&y={y}&z={z}&s=G", attribution = 'Google') %>%
      setView(lng = -84.8,
              lat = 15.75,
              zoom = 10) 
  })
  
  observe({
    leafletProxy(mapId = 'map') %>%
      addTiles(urlTemplate = paste0('https://storage.googleapis.com/honduras/forestLoss/year',year() ,'/{z}/{x}/{y}.png'),
               layerId = paste0('ForestLoss', year()),
               options = tileOptions(minZoom = 9, maxZoom = 18, tms = TRUE))
  })
}

shinyApp(ui, server)

Of course, this has its own set of problems but might give you some idea.

1 Like
4

Well, it's not the most beautiful code ever written, but it behaves as I'd like. As you mentioned, cumulative addition of layers eliminates the flashing, but also taxes the client quite a bit. So I amended the script to clear the 3rd to last layer added, unless the user drags the slider to a previous year, or the loop recycles, in which case all layers are cleared (still flashes, but really the forward temporal continuity is what I'm after).

library(shiny)
library(leaflet)

ui <- fluidPage(
  fluidRow(
    column(4, offset = 4, 
           sliderInput(
             "sliderIn",
             "Año",
             2001,
             2016,
             value = 2001,
             step = 1,
             sep = "",
             width = 600,
             animate =
               animationOptions(interval = 1250, loop = T)
           ))
  ),
  leafletOutput("map", width = "100%", height = "600px")
)

server <- function(input, output, session){
  
  year <- reactive({
    which(2001:2016 == input$sliderIn)
  })
  
  yearList <- reactiveValues(val = 0)
  
  observeEvent(input$sliderIn,{
    yearList$val <- c(yearList$val, year()) 
  })
  
  output$map <- renderLeaflet({
    leaflet(options = leafletOptions(minZoom = 0, maxZoom = 16, zoomControl = F)) %>%
      addTiles(urlTemplate = "https://mts1.google.com/vt/lyrs=s&hl=en&src=app&x={x}&y={y}&z={z}&s=G", attribution = 'Google') %>%
      setView(lng = -84.8,
              lat = 15.75,
              zoom = 10) %>%
      addTiles(urlTemplate = "https://storage.googleapis.com/honduras/fl/year1/{z}/{x}/{y}.png", 
               layerId = '1', group = 'ForestLoss',
               options = tileOptions(minZoom = 9, maxZoom = 18, tms = TRUE))  
  })
  
  observe({
    if(year() > tail(yearList$val, 2)[1]){
    leafletProxy(mapId = 'map') %>%
      removeTiles(layerId = paste0(tail(yearList$val,3)[1])) %>%
      addTiles(urlTemplate = paste0('https://storage.googleapis.com/honduras/fl/year',year() ,'/{z}/{x}/{y}.png'),
               layerId = paste0(year()), 
               group = 'ForestLoss',
               options = tileOptions(minZoom = 9, maxZoom = 18, tms = TRUE))
      }else{
    leafletProxy(mapId = 'map') %>%
      clearGroup('ForestLoss') %>%
      addTiles(urlTemplate = paste0('https://storage.googleapis.com/honduras/fl/year',year() ,'/{z}/{x}/{y}.png'),
               layerId = paste0(year()),
               group = 'ForestLoss',
               options = tileOptions(minZoom = 9, maxZoom = 18, tms = TRUE))}
  })
   

}

shinyApp(ui, server)
1 Like