2

My app has a leaflet object and a reactable object which interact via crosstalk.

When the user select a record from the table (using the checkbox), I want the app to add only the corresponding marker (using a different icon) and completely remove all others (not to show them shaded).

I am trying to achieve this using crosstalk and leafletproxy, but it seems the observeEvent is not working.

See below for reproducible example. Thank you for any help. António

library(shiny)
library(leaflet)
library(reactable)
library(crosstalk)

icon_x = makeIcon("https://icons.getbootstrap.com/assets/icons/arrow-up-circle-fill.svg",
                  iconWidth = 16, iconHeight = 16)

icon_y = makeIcon("https://icons.getbootstrap.com/assets/icons/arrow-up-circle-fill.svg",
                  iconWidth = 64, iconHeight = 64)

d <- data.frame(
  id = c(1,2,3),
  label = c("a","b","c"),
  long = c(-8,-8,-8.1),
  lat = c(39,39.1,39)
)

ui <- fluidPage(
  textOutput("texto"),
  reactableOutput("tbl"),
  leafletOutput(outputId = "map")
)

server <- function(input, output) {

  shared_d <- SharedData$new(d)
  
  output$map <- renderLeaflet({
    leaflet(shared_d) %>%
      addTiles()  %>%
      setView(-8.05,39.05,11) %>%
      addMarkers(lng = ~long, lat = ~lat, icon = icon_x)
  })
  
  output$tbl <- renderReactable({
  t<-  reactable(
      shared_d,
      onClick = "select",
      selection = "multiple",
      selectionId = "sel"
    )
    })
 
 d_new <- reactive({
   shared_d$data()[input$sel,]
  })   

  observeEvent(input$sel, {
  #  d_new <- d[d$id == input$sel,]
    output$texto <- renderText(print(input$sel))
       
    if (is.null(input$sel)){
      leafletProxy("map", data = d_new()) %>%
      clearMarkers() %>%
      addMarkers(lng = ~long, lat = ~lat, icon = icon_y)
    }
  })
}
shinyApp(ui = ui, server = server)
António
  • 43
  • 6

1 Answers1

2

I solved the problem using getReactableState instead of selectionID. And in the observeEvent, getReactableState must be converted to text.

Here's a working solution.

    library(shiny)
library(leaflet)
library(reactable)
library(crosstalk)

icon_x = makeIcon("https://icons.getbootstrap.com/assets/icons/arrow-up-circle-fill.svg",
                  iconWidth = 16, iconHeight = 16)

icon_y = makeIcon("https://icons.getbootstrap.com/assets/icons/arrow-up-circle-fill.svg",
                  iconWidth = 64, iconHeight = 64)

d <- data.frame(
  id = c(1,2,3),
  label = c("a","b","c"),
  long = c(-8,-8,-8.1),
  lat = c(39,39.1,39)
)

ui <- fluidPage(
#  textOutput("texto"),
  reactableOutput("tbl"),
  leafletOutput(outputId = "map")
)

server <- function(input, output) {

  shared_d <- SharedData$new(d)
  
  output$map <- renderLeaflet({
    leaflet(shared_d) %>%
      addTiles()  %>%
      setView(-8.05,39.05,11)
  })
  
  output$tbl <- renderReactable({
  t<-  reactable(
      shared_d,
      onClick = "select",
      selection = "multiple",
      selectionId = "sel"
    )
    })

 d_new <- reactive({
   shared_d$data()[getReactableState("tbl","selected"),]
  })   

  observeEvent(as.character(getReactableState("tbl","selected")), {
  #  output$texto <- renderText(print(getReactableState("tbl","selected")))

    if (is.null(getReactableState("tbl","selected"))){
      leafletProxy("map", data = shared_d) %>%
      clearMarkers() %>%
      addMarkers(lng = ~long, lat = ~lat, icon = icon_x)
      }
    else{
      leafletProxy("map", data = d_new()) %>%
      clearMarkers() %>%
      addMarkers(lng = ~long, lat = ~lat, icon = icon_y)
    }
  })
}
shinyApp(ui = ui, server = server)
António
  • 43
  • 6
  • Thanks for posting the solution @António! Is it possible to make it work the other way around, i.e., click on the point on the map to highlight the row in the table? – Tung Oct 13 '22 at 19:04