Adding more shiny inputs that take advantage of various existing maplibre / mapbox functions...

[kmcd39]

I implemented a set of new shiny inputs to take advantage of maplibre features like queryRenderedFeatures and querySourceFeatures already in my branch of this package. I'm not doing a pull request yet because i'm not sure these have wider applicability and there's definitely room to improve on my current implementations.

My current implementation has new functions in the shiny.R set of functions to query rendered features of a particular layer or source features -- which to me is really cool to pull geometries and properties from the geojson underlying the base map -- I think this has potential to be a really cool interface with resources like openstreetmap.

I also have a function, analogous to the enable_hover_events function @walkerke added to alter my hover features implementation, which updates a shiny input (__bbox_features), with all features from a given layer currently in the map viewport. It seems really fast and performant! (I wanted to play with this in one of my own projects, and felt this approach could be a big improvement over using the _bbox input and doing a spatial filter in R.

Starting the discussion so folks are aware, but not yet a pull request.

Also, here is a minimal shiny app to show these features as my branch currently implements them!

library(sf)
library(tidyverse)
library(shiny)
devtools::load_all()


statesf <- tigris::states(
) |>
  rename_with(tolower)

statesf <- statesf |>
  st_transform(4326)

#statesf |> tibble() |> select(geoid, name) |> arrange(geoid) |> print(n=60)

l48 <- statesf |>
  filter(as.numeric(geoid) %in% c(4:14,16:56))


# pluck layers
map.style <- mapgl::carto_style("voyager")
map.json <- jsonlite::fromJSON(map.style)
carto.source.layers <- map.json$layers$`source-layer` |> unique() |> sort(decreasing = T)
carto.source.layers


mapgl_hover_UI <- function(id) {

  ns <- NS(id)
  tagList(

    # make sure edited js re-loads
    shiny::includeScript("~/R/PKGS/forked/mapgl/mapgl/inst/htmlwidgets/maplibregl.js"),

    mapgl::maplibreOutput( ns("map")
                           ,height = "500px"
                           )

    ,shiny::actionButton(
      ns("qry.bbox")
      , "get visible features!"
    )

    ,shiny::selectizeInput(
      ns("source.layer")
      ,"What source layer"
      ,choices = carto.source.layers
    )
    ,shiny::actionButton(
      ns("qry.source")
      , "get source features in bbox for selected source layer!"
    )
    ,shiny::actionButton(
      ns("get.drawn.features")
      ,"get drawn features!"
    )
  )
}

mapgl_hover_Server <- function(id) {

  moduleServer(
    id,
    function(input, output, session) {

      output$map <- mapgl::renderMaplibre({

        maplibre(
          style = map.style
          ) |>
          mapgl::fit_bounds(l48
                            ) |>
          mapgl::add_fill_layer(
            id = "states"
            ,source = statesf
            ,fill_color =
              mapgl::match_expr(
                 column = "division"
                ,values = sort(unique(statesf$division))
                ,stops = RColorBrewer::brewer.pal(10,"Set3")
              )
            ,fill_opacity = .6
            ,fill_outline_color = "white"
            ,hover_options =  list(
              fill_color =
                "#AA0099"
              ,fill_opacity = .4
            )
          ) |>
          mapgl::enable_shiny_hover(
          ) |>
          enable_shiny_viewport_features("states")
          #mapgl::add_draw_control()

      })

      proxy <- mapgl::maplibre_proxy("map")

      # observeEvent(input$map_click, {
      #   browser()
      # })



      observeEvent(input$qry.bbox, {
        req(proxy)

        update_feature_query(
          proxy, "states"
        )
      })

      observeEvent( input$map_bbox_features, {

        vpf <- jsonlite::fromJSON(input$map_bbox_features) |>
          tibble() |>
          distinct()

        print( "currently visible: \n")
        print(head(select(vpf,c(1:3,"name"))) )
      })


      observeEvent(input$map_feature_query, {

        req(input$map_feature_query)
        sfx <- input$map_feature_query |>
          jsonlite::fromJSON() |>
          tibble() |>
          distinct()

        print(sfx$name)
      })

      observeEvent( input$qry.source, {
        req(proxy)
        update_source_query(proxy
                            ,source_id = "carto"
                            ,source_layer = input$source.layer)
      })

      observeEvent(input$map_source_query, {
        req(input$map_source_query)

        #browser()
        sfx <- input$map_source_query |>
          geojsonsf::geojson_sf()

        print(head(sfx))
      })
    }
  )
}

shiny::shinyApp(mapgl_hover_UI("dev"),
                server =
                  function(input,output,session)
                    mapgl_hover_Server("dev")
                )

[walkerke]

Awesome! Excellent timing - I've got a branch (not pushed) that's working on the same thing. I'll ask you to take a look / add anything you think is missing.

The big challenge I've had with implementing map.queryRenderedFeatures() is timing issues in Shiny. For example, an event might fire before a Shiny process is fully completed, which means that map.queryRenderedFeatures() would often return the previous result rather than the result the user expects to see.

I ended up going with a query_features() function that includes a callback argument to which another function could be passed, that runs immediately as the query is executed. This is working!

But I do like the implementation you have where we can set up input listeners in Shiny apps. Have you noticed any timing issues?

[kmcd39]

I had that exact same challenge with the timing issue. The while loop in the get_drawn_features function wasn't seeming to work either -- it would be the same issue you're describing, such that it would always return the previous result rather than what was expected.

A callback approach if it's working seems good? I'm not sure if the code is visible so i can't peek myself!

My implementation with the Shiny input and two observers seems to be really smooth on the user side and definitely seems to resolve timing issues, but it does seem clunky from a coding-in-R perspective. B/c it returns the raw JSON and requires the final processing in R. One possibility would be to make the a function like queried_feature_listener that creates a really small server-side Shiny module with the necessary observers to handle both sending the message and processing the returned JSON, although that also may be clunky/weird code.

[walkerke]

I pushed the branch I'm working on:

https://github.com/walkerke/mapgl/tree/query-rendered-features

I'm still seeing the timing issues, unfortunately. That's my big hesitation with merging this feature, it has to "just work" without users needing to do tricks in Shiny.

[walkerke]

hmm, looks like this is a known issue in the underlying libraries: mapbox/mapbox-gl-js#4222.

I think clear documentation will be important to help users with this.

[kmcd39]

Also, to be clear, the approach with shiny observers wasnt having the timing issue -- the minimal app above with my current mapgl branch works. I was noticing the timing issue coming up when i was trying my initial approaches.
I think having a function return a shiny module that updates the shiny inputs could be a "just works" implementation.

[walkerke]

Definitely. My hangup was always that I was trying to combine queryRenderedFeatures() with setFilter(), and the query operation is a synchronous operation but apparently the filter is async, so the results wouldn't line up.

If queryRenderedFeatures()' filter argument is used, this resolves it! So I think there is a way we can put this together.

[walkerke]

I needed the minimal implementation for a project so I'm merging that today to main; let's keep discussing the other enhancements as well!