'possible to implement two sequential flyTo in leaflet R

I would like to create a Leaflet Map which renders at a default location, at a zoom level of 4, and then when the user clicks the go button, pans from location to another, both of which have been selected from a dropdown. enter image description here I've tried using the following code, the data for which can be found @ https://github.com/eoefelein/COVID_Business_Recovery_and_Social_Capital/tree/master/socialCapitalEmployment/data

library(sf)
library(tigris)
library(shiny)
library(shinydashboard)
library(tidyverse)
library(leaflet)

# data loading and processing
USA <- st_read(dsn = 'data/cb_2018_us_county_5m.shp')
counties_sf <- st_as_sf(USA)
counties_reproject_sf <- st_transform(counties_sf, 4326) %>% filter(COUNTYFP < 60010)

emp_rate <- read_csv('data/synthetic_emp_rate_pred.csv')
emp_rate$countyfips <- sprintf("%05d", emp_rate$countyfips)
states_sf_coef <- geo_join(counties_reproject_sf, emp_rate, "GEOID", "countyfips", how='inner')

ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title="Employee Rate Data"),
    dashboardSidebar(
      sidebarMenu(
        menuItem(
          "Maps",
          tabName = "maps",
          icon=icon("globe")
        )
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(
          tabName = "maps",
          tags$style(type="text/css","#all_airports {height:calc(100vh - 80px) !important;}"),
          fluidRow(column(4),
                   column(8,
                          selectInput(inputId = "FromCounty",
                                      label="from",
                                      choices=c(unique(emp_rate$countyname)),
                                      selected = 'Travis County, Texas'
                          ),
                          selectInput(inputId = "ToCounty",
                                      label = "to",
                                      choices=c(unique(emp_rate$countyname))
                          ))),
          actionButton("zoomer","go"),
          leafletOutput("map")
          
        )
      )
    )
  )
)

server <- function(input, output, session) {
  
  # map
  output$map <- renderLeaflet({
    mypal <- colorNumeric(palette="viridis", domain=states_sf_coef$rand_pred, na.color="transparent")
    # mypalette(c(45,43))
    
    leaflet() %>%
      addProviderTiles("OpenStreetMap.Mapnik") %>%
      setView(lat = 38.2393,
              lng = -96.3795,
              zoom = 4) %>%
      addPolygons(
        data = states_sf_coef,
        fillColor = ~mypal(rand_pred),
        # fillColor = ~ mypal(data$value),
        stroke = FALSE,
        smoothFactor = 0.2,
        fillOpacity = 0.3,
        popup = paste(
          "Region: ",
          states_sf_coef$countyname,
          "<br>",
          "Social Index: ",
          states_sf_coef$rand_pred,
          "<br>"
        )
      )  
    # %>%
      # addLayersControl(
      #   baseGroups = c("Employment Prediction Data (default)", "To-From"),
      #   options = layersControlOptions(collapsed = FALSE)
      # )
  })
  
  map_proxy <- leafletProxy("map")
  
  observeEvent(input$zoomer, { # add Smith, county, kansas and default to zoom = 1?
    # fromCounty
    fromCountyInput <- reactive({
      states_sf_coef %>% dplyr::filter(countyname == input$FromCounty)
    })
    fromData <- fromCountyInput()
    fromCoords <- st_coordinates(st_centroid(fromData$geometry))
    
    # toCounty
    toCountyInput <- reactive({
      states_sf_coef %>% dplyr::filter(countyname == input$ToCounty)
    })
    toData <- toCountyInput()
    toCoords <- st_coordinates(st_centroid(toData$geometry))
    
    
    map_proxy %>%
      flyTo(lng = fromCoords[1], lat = fromCoords[2], zoom = 10)
      flyTo(lng = toCoords[1], lat = toCoords[2], zoom = 10)
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Right now I'm getting the following error: Warning: Error in dispatch: argument "map" is missing, with no default. Any guidance would be much appreciated!



Solution 1:[1]

I can't access your data to check that this works but I found a solution my (similar) problem by using shinyjs::delay(). This requires that you include the useShinyjs() in the ui as I have done below.

library(sf)
library(tigris)
library(shiny)
library(shinydashboard)
library(tidyverse)
library(leaflet)
library(shinyjs)

# data loading and processing
USA <- st_read(dsn = 'data/cb_2018_us_county_5m.shp')
counties_sf <- st_as_sf(USA)
counties_reproject_sf <- st_transform(counties_sf, 4326) %>% filter(COUNTYFP < 60010)

emp_rate <- read_csv('data/synthetic_emp_rate_pred.csv')
emp_rate$countyfips <- sprintf("%05d", emp_rate$countyfips)
states_sf_coef <- geo_join(counties_reproject_sf, emp_rate, "GEOID", "countyfips", how='inner')

ui <- fluidPage(
  dashboardPage(
    useShinyjs(),
    dashboardHeader(title="Employee Rate Data"),
    dashboardSidebar(
      sidebarMenu(
        menuItem(
          "Maps",
          tabName = "maps",
          icon=icon("globe")
        )
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(
          tabName = "maps",
          tags$style(type="text/css","#all_airports {height:calc(100vh - 80px) !important;}"),
          fluidRow(column(4),
                   column(8,
                          selectInput(inputId = "FromCounty",
                                      label="from",
                                      choices=c(unique(emp_rate$countyname)),
                                      selected = 'Travis County, Texas'
                          ),
                          selectInput(inputId = "ToCounty",
                                      label = "to",
                                      choices=c(unique(emp_rate$countyname))
                          ))),
          actionButton("zoomer","go"),
          leafletOutput("map")
          
        )
      )
    )
  )
)

server <- function(input, output, session) {
  
  # map
  output$map <- renderLeaflet({
    mypal <- colorNumeric(palette="viridis", domain=states_sf_coef$rand_pred, na.color="transparent")
    # mypalette(c(45,43))
    
    leaflet() %>%
      addProviderTiles("OpenStreetMap.Mapnik") %>%
      setView(lat = 38.2393,
              lng = -96.3795,
              zoom = 4) %>%
      addPolygons(
        data = states_sf_coef,
        fillColor = ~mypal(rand_pred),
        # fillColor = ~ mypal(data$value),
        stroke = FALSE,
        smoothFactor = 0.2,
        fillOpacity = 0.3,
        popup = paste(
          "Region: ",
          states_sf_coef$countyname,
          "<br>",
          "Social Index: ",
          states_sf_coef$rand_pred,
          "<br>"
        )
      )  
    # %>%
      # addLayersControl(
      #   baseGroups = c("Employment Prediction Data (default)", "To-From"),
      #   options = layersControlOptions(collapsed = FALSE)
      # )
  })
  
  map_proxy <- leafletProxy("map")
  
  observeEvent(input$zoomer, { # add Smith, county, kansas and default to zoom = 1?
    # fromCounty
    fromCountyInput <- reactive({
      states_sf_coef %>% dplyr::filter(countyname == input$FromCounty)
    })
    fromData <- fromCountyInput()
    fromCoords <- st_coordinates(st_centroid(fromData$geometry))
    
    # toCounty
    toCountyInput <- reactive({
      states_sf_coef %>% dplyr::filter(countyname == input$ToCounty)
    })
    toData <- toCountyInput()
    toCoords <- st_coordinates(st_centroid(toData$geometry))
    
    
    map_proxy %>%
      flyTo(lng = fromCoords[1], lat = fromCoords[2], zoom = 10)
    
    delay(5000, {map_proxy %>% flyTo(lng = toCoords[1], lat = toCoords[2], zoom = 10)})
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Rex Parsons