António
António

Reputation: 59

Interaction between reactable and Leaflet in shiny app (crosstalk, leafletproxy)

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)

Upvotes: 2

Views: 530

Answers (1)

Ant&#243;nio
Ant&#243;nio

Reputation: 59

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)

Upvotes: 2

Related Questions