I have an app that renders some data using reactable and shows the same data in a map (using leaflet).
the table object is selectable and the selected rows are shown in the map.
when I clear the selection in the table (with an actionButton), I want the original map to render (with all data points).
Below is a working example with the quakes dataset.
library(shiny)
library(leaflet)
library(reactable)
ui <- fluidPage(
reactableOutput("t"),
actionButton(inputId = "clean", label="Clear selection"),
leafletOutput("m")
)
server <- function(input, output) {
output$t <- renderReactable({
reactable(quakes[1:10,],
selection = "multiple")
})
output$m <- renderLeaflet({
leaflet(quakes[1:100,]) %>%
addTiles() %>%
addMarkers()
})
observeEvent(input$clean,
list( updateReactable("t", selected = NA),
leafletProxy("m", data = quakes) %>%
addMarkers())
)
observeEvent(getReactableState("t","selected"),
leafletProxy("m", data = quakes[getReactableState("t","selected"),]) %>%
clearMarkers() %>%
addMarkers()
)
}
shinyApp(ui,server)
When I try to write the same app with modules, it does not work. Below is one of the many attempts.
I am trying to use modules, since this is part of a larger app, and it would make it much easier to manage...
library(shiny)
library(leaflet)
library(reactable)
tUI <- function(id){
ns <- NS(id)
tagList(
reactableOutput(outputId = ns("t")),
actionButton(ns("clean"), label="Clear selection")
)
}
tServer <- function(id, mapa){
moduleServer(id,
function(input, output, session){
output$t <- renderReactable({
reactable(quakes[1:10,],
selection = "multiple"
)
})
observeEvent(input$clean, {
list(
updateReactable("t", selected = NA)#,
# leafletProxy(mapa(), data = quakes) %>%
# addMarkers())
)})
}
)
}
mUI <- function(id){
ns <- NS(id)
tagList(
leafletOutput(ns("m"))
)
}
mServer <- function(id){
moduleServer(id,
function(input, output, session){
output$m <- renderLeaflet({
leaflet(quakes[1:100,]) %>%
addTiles() %>%
addMarkers()
})
m2 <- reactive("m")
})}
##########################################################
ui <- fluidPage(
tUI("tt"),
mUI("mm")
)
server <- function(input, output) {
ttt <- tServer("tt", mmm$m2)
mmm <- mServer("mm")
}
shinyApp(ui,server)
Any help, please? Thanks.
In order to have cross-talk between modules, you need to return reactive objects from one module and input it to the other module. Here, I've returned clean and getReactableState from the tServer module and input it to mServer. For an introduction to this concept, you might find my tutorial on shiny modules helpful.
library(shiny)
library(leaflet)
library(reactable)
tUI <- function(id){
ns <- NS(id)
tagList(
reactableOutput(outputId = ns("t")),
actionButton(ns("clean"), label="Clear selection")
)
}
tServer <- function(id, mapa){
moduleServer(id,
function(input, output, session){
output$t <- renderReactable({
reactable(quakes[1:10,],
selection = "multiple"
)
})
observeEvent(input$clean, {
list(
updateReactable("t", selected = NA)
)})
return(
list(
clean = reactive({input$clean}),
selected_items = reactive({getReactableState("t","selected")})
)
)
}
)
}
mUI <- function(id){
ns <- NS(id)
tagList(
leafletOutput(ns("m"))
)
}
mServer <- function(id, clean, selected_items){
moduleServer(id,
function(input, output, session){
output$m <- renderLeaflet({
leaflet(quakes[1:100,]) %>%
addTiles() %>%
addMarkers()
})
observeEvent(clean(), {
leafletProxy("m", data = quakes) %>%
addMarkers()
}
)
observeEvent(selected_items(), {
leafletProxy("m", data = quakes[selected_items(),]) %>%
clearMarkers() %>%
addMarkers()
})
})}
##########################################################
ui <- fluidPage(
tUI("tt"),
mUI("mm")
)
server <- function(input, output) {
ttt <- tServer("tt")
mServer("mm", clean = ttt$clean, selected_items = ttt$selected_items)
}
shinyApp(ui,server)