set_filter() not working within rhino framework

[RWParsons]

This could well be a me problem as I'm just figuring out my way around mapgl today.

I'm working on a larger app which uses rhino but have found that I can't get mapgl::set_filter() to work. I've made a smaller app here - https://github.com/RWParsons/test-app. This has a rhino app with a map shown in the main module https://github.com/RWParsons/test-app/blob/main/app/main.R but the filter does not trigger changes on the map.

I have made the same app but without the modules/rhino framework and it works fine: https://github.com/RWParsons/test-app/blob/main/normal-app.R

Any help would be greatly appreciated

Thanks for your work on this package, @walkerke, I'm very keen be able to work mapgl into this project of mine 😄

[walkerke]

Appreciate your note! I've never used Rhino before so this might take me a little more time to figure out. However, I'd like to make sure that the package works within any of the frameworks in which it might be used.

[walkerke]

I can't get your app to run (an issue with PROJ I'm having within packrat it seems) but can you try this in your module's server code?

ns <- NS(id)

observe({
    mapgl$mapboxgl_proxy(ns("map")) |>
      mapgl$set_filter("polygon_layer",
                       list(">=", mapgl$get_column("measure"), input$slider))
  })

If that works, I can look at ways to avoid that step in the future.

[RWParsons]

Hi @walkerke

Partially my mistake - I didn't have an ns() around the slider input!

It does work with the ns() on the server side as you mention once I have fixed up the slider input.

#' @export
ui <- function(id) {
  ns <- NS(id)
  bootstrapPage(
    sliderInput(ns("slider"), "min value:", value = 0, min = -3, max = 3),
    mapgl$mapboxglOutput(ns("map"))
  )
}

#' @export
server <- function(id) {
  moduleServer(id, function(input, output, session) {
    map_shapes <- strayr$read_absmap("sa32021")
    map_shapes$measure <- stats::rnorm(n = nrow(map_shapes))
    
    ns <- NS(id)
    cat(ns('map'))
    
    output$map <- mapgl$renderMapboxgl({
      mapgl$mapboxgl(mapgl$mapbox_style("streets")) |>
        mapgl$fit_bounds(map_shapes, animate = FALSE) |>
        mapgl$add_fill_layer(id = "polygon_layer",
                             source = map_shapes,
                             fill_color = "blue",
                             fill_opacity = 0.5)
    })
    
    observe({
      mapgl$mapboxgl_proxy(ns("map")) |>
        mapgl$set_filter(
          "polygon_layer",
          list(">=", mapgl$get_column("measure"), input$slider)
        )
    })
    
  })
}

But also, I had a look into leaflet::leafletProxy() and they seem to do the work for me for that namespacing.

Using this function (adapted from leaflet's) to create the mapboxgl_proxy means that I don't have to have the ns() in the server module.

mapboxgl_proxy <- function(mapId, session = shiny::getDefaultReactiveDomain()){
  if (is.null(session)) {
    stop("mapboxgl_proxy must be called from the server function of a Shiny app")
  }
  if (!is.null(session$ns) && nzchar(session$ns(NULL)) && substring(mapId, 1, nchar(session$ns(""))) != session$ns("")) {
    mapId <- session$ns(mapId)
  }
  structure(
    list(
      session = session, 
      id = mapId
    ), 
    class = "mapboxgl_proxy"
  )
}

[RWParsons]

Quick follow up: adding the ns() to the existing call to mapboxgl_proxy from within the server module does work (as is in the above example and in the test-app repo that I linked to) if it's in the main module but doesn't work when it is part of a submodule. The new function I have included above DOES work in this case though.

There's a slight issue still with this implementation that I think leaflet has figured out by having a deferUntilFlush part of the leaflet::leafletProxy(). In the example in the test-app, the map is shown as complete despite the default selection of the sliderInput. If the proxy were deferred until flushed to execute on it's inputs, then I think it would observe the sliderInput for the initial view of the map. (This isn't an immediate issue for my current project as my default view of the map is to not show anything on the map but may be an issue for others.)

[RWParsons]

Perhaps this is a separate issue but would it be possible to use a %in% (or some other aribtrary function) for use within set_filter()?

My use case is where I want to filter to keep a selection based on several inputs (I'd be likely to make the set_filter() act on some 'shape_id'-like column which I get from filtering a copy of the input data by those multiple inputs).

[walkerke]

Thanks @RWParsons! I'll make those edits.

Perhaps this is a separate issue but would it be possible to use a %in% (or some other aribtrary function) for use within set_filter()?

My use case is where I want to filter to keep a selection based on several inputs (I'd be likely to make the set_filter() act on some 'shape_id'-like column which I get from filtering a copy of the input data by those multiple inputs).

I've done some work to try to get set_filter() to accommodate R expressions like %in% and I haven't figured it out yet. However, what you are describing is possible with Mapbox GL-like syntax. For example, let's say you have a selectInput() which accommodates multiple selections. This should work:

mapboxgl_proxy("your_map") |> 
  set_filter("your_layer_id", list("in", "your_column_name", input$select_input_id))

I would love to be able to do this:

mapboxgl_proxy("your_map") |> 
  set_filter("your_layer_id", filter_expr(column %in% input$select_input_id))

But I haven't gotten it working yet.

[RWParsons]

Thanks quick responses @walkerke!

I've just tested it out and with the use of "in" as you've shown, it works for when the input is a single value but not when it is a vector. Here is the example that I'm working with:

library(shiny)
library(bslib)
library(colourpicker)
library(dplyr)
library(sf)
library(mapgl)
library(shinyWidgets)

ui <- bootstrapPage(
  sliderInput("slider", "min value:", value = 0, min = -3, max = 3),
  numericRangeInput("area_range", label = "numeric range input for area", value = c(0.03, 0.25), step = 0.01),
  mapboxglOutput("map")
)



server <- function(input, output, session) {
  nc <- st_read(system.file("shape/nc.shp", package = "sf"))
  nc$var1 <- rnorm(n = nrow(nc))
  nc$CNTY_ID <- as.character(nc$CNTY_ID)

  output$map <- renderMapboxgl({
    mapboxgl(mapgl::mapbox_style("streets")) |>
      fit_bounds(nc, animate = FALSE) |>
      add_fill_layer(
        id = "polygon_layer",
        source = nc,
        fill_color = "blue",
        fill_opacity = 0.5,
        tooltip = "AREA"
      )
  })


  observe({
    ids <- nc |>
      filter(
        AREA >= min(input$area_range),
        AREA <= max(input$area_range)
      ) |>
      pull(CNTY_ID)
    
    cat(length(ids))
    
    mapboxgl_proxy("map") |>
      set_filter(
        "polygon_layer",
        list("in", "CNTY_ID", ids)
      )
  })
}

shinyApp(ui, server)

[RWParsons]

Hi @walkerke,

I've made a PR for the proxy functions to fix the namespacing issue. I think this covers the OP of this issue but I'm happy to make separate issues for the following things that have come out of the discussion.

• deferUntilFlush functionality in the proxy functions so that inputs with default values are effective on the initial display of the map. (similar to what is done in {leaflet})
• (unless there is something that I'm missing from my attempt in the previous comment) fix the "in" operator in set_filter() to work for when there is a vector or list of values to which the variable in the source data is being compared.

Let me know if these are sensible from your perspective and I'll write them up with reprexes in separate issues.

Thanks!

[RWParsons]

I've made two more issues to address the points above and will now close this issue.

Thanks, @walkerke!