1

I'm trying to create a shinyapp using mapdeck that maps a variable based on some attributes. Basically, I select a city and then select an activity and a time threshold to produce the desirable map. Reproducible code below (make sure to use a mapbox API):

library(shiny)
library(dplyr)
library(mapdeck)
library(sf)


ui <- shinyUI(fluidPage(
  selectInput(inputId = "city",
              label = h1("Pick city:"),
              choices = c("Belo Horizonte" = "bho",
                          "Fortaleza" = "for"),
              selected = "bho"),
  selectInput(inputId = "activity",
              label = h1("Pick activity:"),
              choices = c("TT", "ST"),
              selected = "TT"),
  sliderInput(inputId = "time",
              label = h1("Pick time threshold:"),
              min = 30, max = 120,
              step = 30, value = 30,
              animate = TRUE),
  mapdeckOutput("map")
)
)



# SERVER --------------------------------------------------------------------------------------

# Define a server for the Shiny app
server <- shinyServer(function(input, output) {


  data <- readRDS(url("https://github.com/kauebraga/misc/raw/master/data.rds"), "rb")

  centroids <- data.frame(sigla_muni = c("for", "bho"),
                          lon = c(-38.52770, -43.95988),
                          lat = c( -3.785656, -19.902739))

  # register mapbox api key
  mapdeck::set_token("YOUR_API")

  # reactive for the city
  city_filtered <- reactive({
    data %>% filter(sigla_muni == input$city)
  })

  # reactive for the activity
  activity_filtered <- reactive({
    city_filtered() %>% dplyr::filter(activity == input$activity)
  })


  # Reactive for time threshold
  time_filtered <- reactive({

    activity_filtered() %>% dplyr::filter(time_threshold == input$time)

  })

  # initialize baseMap
  output$map <- renderMapdeck({

    mapdeck(location = c(-43.95988, -19.902739), zoom = 0)

  })



  #  
  observe({

    centroids_city <- filter(centroids, sigla_muni == input$city)

    mapdeck_update(map_id = "map") %>%
      mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
                   duration = 3000,
                   transition = "fly")

    a <- mapdeck_update(map_id = "map") %>%
      add_polygon(
        data = time_filtered(),
        fill_colour = "value",
        fill_opacity = 200,
        layer_id = "acess",
        palette = "inferno",
        update_view = FALSE,
        focus_layer = FALSE,
      )


  })


}

)


shinyApp(ui = ui, server = server)

I want to use the cool map transitions provided by mapdeck, so I create a basemap with zero zoom and then use the mapdeck_view function inside my shiny::observer so I can have the nice transition whenever I open the map or select a different city. I set the views based on cities centroids.

The problem is that the view (and the transition) also updates whenever I change the zoom inside the same city and then select different attributes (different activities or a different time threshold). I wish there was a way to keep the map in the same zoom while I change attributes within the same city, having transition only when I change cities.

I tried to play with shiny::isolate inside my observer but didn't succeed (nothing happened in this case):

observe({

    isolate({
    centroids_city <- filter(centroids, sigla_muni == input$city)

    mapdeck_update(map_id = "map") %>%
      mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
                   duration = 3000,
                   transition = "fly")

    })

    a <- mapdeck_update(map_id = "map") %>%
      add_polygon(
        data = time_filtered(),
        fill_colour = "value",
        fill_opacity = 200,
        layer_id = "acess_cum",
        palette = "inferno",
        update_view = FALSE,
        focus_layer = FALSE,
      )


  })

Appreciate any help. Thanks!

Kauê Braga
  • 117
  • 8

1 Answers1

1

I think you need the city input and the time & activity inputs in different observers. This appears to achieve your desired behaviour.

  observe({
    centroids_city <- filter(centroids, sigla_muni == input$city)

    mapdeck_update(map_id = "map") %>%
      mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
                   duration = 3000,
                   transition = "fly")
  })

  observeEvent({c(input$time, input$activity, input$city)},{

    print(" -- changing -- ")
    sf <- time_filtered()
    print( unique( sf$sigla_muni ) )
    print( unique( sf$time_threshold ) )
    print( unique( sf$activity )  )

    mapdeck_update(map_id = "map") %>%
      add_polygon(
        data = sf,
        fill_colour = "value",
        fill_opacity = 200,
        layer_id = "acess",
        palette = "inferno",
        update_view = FALSE,
        focus_layer = FALSE,
      )
  })
SymbolixAU
  • 25,502
  • 4
  • 67
  • 139
  • It works to keep the zoom unchanged, bui it renders an overlay of `valor` variable for all the attributes (because `city_filtered` was used) whenever I change cities, until I pick a new activity or time threshold. Tried to change `city_filtered` for `time_filtered` but this will make the zoom change. Any tips? – Kauê Braga Jan 12 '20 at 23:52
  • I don't understand what you mean by "bui it renders an overlay of `valor` variable for all the attributes" - what is this `valor` variable/ where is it in the data, which overlay is it? – SymbolixAU Jan 13 '20 at 04:32
  • Sorry, I meant `value` instead of `valor`. When I change cities, it seems that the map renders all `value` on top of each other (for all activities and thresholds of that city), instead of only one`value` of the activity and time threshold selected. – Kauê Braga Jan 13 '20 at 04:44
  • I've updated it slightly, and put a few `print` statements in to see which data is being plotted. From what I can see only the chosen variables are being displayed. – SymbolixAU Jan 13 '20 at 21:46