Thanks for the response. How would I do this though? Here is the updated code.
The click gets captured. The problem is in the return in the server.
The error on the call module is
Warning: Error in module: unused argument (childScope)
# libraries ---------------------------------------------------------------
library(shiny)
library(sf)
library(tidyverse)
library(leaflet)
# data --------------------------------------------------------------------
# data in the sf package
nc <- st_read(system.file("shape/nc.shp", package="sf")) %>%
select(NAME, AREA, SID74) %>%
st_transform(4326)
# names for dropdown
nc_names <- sort(unique(nc$NAME))
# modules -----------------------------------------------------------------
map_ui <- function(id) {
ns <- NS(id)
tagList(
leafletOutput(ns("map"))
)
}
map_server <- function(id, dropdown){
moduleServer(id, function(input, output, session){
output$map <- renderLeaflet({
# initial map
leaflet() %>%
addProviderTiles("Stamen.TonerHybrid") %>%
# base layer
addPolygons(data = nc,
fillColor = "grey",
fillOpacity = 0.1,
weight = 1,
stroke = TRUE,
color = "black",
opacity = 1,
layerId = ~NAME) %>%
# initial selected layer
addPolygons(data = nc %>% filter(NAME == "Alamance"),
fillColor = "blue",
fillOpacity = 0.5,
weight = 1,
stroke = TRUE,
color = "black",
opacity = 1,
layerId = ~NAME)
})
# new polygon
new_poly <- reactive({nc %>%
filter(NAME == dropdown())})
# update polygon for new map
observe({
leafletProxy("map") %>%
clearShapes() %>%
# base layer
addPolygons(data = nc,
fillColor = "grey",
fillOpacity = 0.1,
weight = 1,
stroke = TRUE,
color = "black",
opacity = 1,
layerId = ~NAME) %>%
# highlighted
addPolygons(data = new_poly(),
weight = 3,
stroke = TRUE,
opacity = 1,
fillOpacity = 0,
layerId = ~NAME
)
})
# observe click and return it
observe({
event <- input$map_shape_click
# print(event)
return(reactive(event))
})
})
}
# app ---------------------------------------------------------------------
# Define UI for application that draws a histogram
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("name",
label = "Name",
selected = nc_names[1],
choices = nc_names)
),
mainPanel(
map_ui("map")
)
)
)
server <- function(input, output) {
# reactive values
drop_val <- reactive(input$name)
# map from server
map_server("map", dropdown = drop_val)
# Calling input module.
map_return <- callModule(map_server, "map") # Warning: Error in module: unused argument (childScope)
# update dropdown based on clicked map (thus updating map)
observe({
updateSelectInput(session,
"name",
selected = map_return$id) # then this doesn't work
})
}
shinyApp(ui, server)