Reputation: 59
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
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