rkw/stAndrews
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: improve filtering logic and map updates in Shiny app

Browse Source 
Co-authored-by: aider (deepseek/deepseek-chat) <aider@aider.chat>
This commit is contained in:
Rob Wiederstein
2026-03-13 06:29:44 -04:00
parent e0cf03df2f
commit 1b75760496
1 changed files with 121 additions and 89 deletions
Download Patch File Download Diff File Expand all files Collapse all files

210
app.R
View File

@@ -359,115 +359,147 @@ server <- function(input, output, session) {
} }
}) })
filteredSbdvn <- reactive({ # Initialize filteredOwners with all owners
if (is.null(input$sub_name) || input$sub_name == "All") { filteredOwners <- reactiveVal(owners)
return(unique(sbdvn$max_sub_id))
} else { # Update filtered owners when filter button is clicked
return( observeEvent(input$filterButton, {
sbdvn %>% # Start with all owners
filtered <- owners
# Filter by subdivision if specified
if (!is.null(input$sub_name) && input$sub_name != "All") {
# Get the subdivision IDs for the selected subdivision name
sub_ids <- sbdvn %>%
filter(sub_name == input$sub_name) %>% filter(sub_name == input$sub_name) %>%
pull(max_sub_id) pull(max_sub_id)
) filtered <- filtered %>%
filter(subdivision %in% sub_ids)
} }
})
# Filter by name if specified
filteredOwners <- reactiveVal(owners) if (!is.null(input$name) && input$name != "") {
filtered <- filtered %>%
observeEvent(input$filterButton, {
filtered_owners <-
owners %>%
filter(subdivision %in% filteredSbdvn()) %>%
filter( filter(
grepl(input$name, owner_1, ignore.case = TRUE) | grepl(input$name, owner_1, ignore.case = TRUE) |
grepl(input$name, owner_2, ignore.case = TRUE) grepl(input$name, owner_2, ignore.case = TRUE)
) %>% )
}
# Filter by location if specified
if (!is.null(input$location) && input$location != "") {
filtered <- filtered %>%
filter(grepl(input$location, location, ignore.case = TRUE)) filter(grepl(input$location, location, ignore.case = TRUE))
}
filteredOwners(filtered_owners)
filteredOwners(filtered)
})
# Also update when the app starts
observe({
# Trigger initial update
filteredOwners(owners)
}) })
mean_lat <- reactive({ mean_lat <- reactive({
filteredOwners() %>% if (!is.null(filteredOwners()) && nrow(filteredOwners()) > 0) {
st_coordinates() %>% filteredOwners() %>%
.[, "Y"] %>% st_coordinates() %>%
mean() .[, "Y"] %>%
mean()
} else {
27.076199
}
}) })
mean_lng <- reactive({ mean_lng <- reactive({
filteredOwners() %>% if (!is.null(filteredOwners()) && nrow(filteredOwners()) > 0) {
st_coordinates() %>% filteredOwners() %>%
.[, "X"] %>% st_coordinates() %>%
mean() .[, "X"] %>%
mean()
} else {
-82.362253
}
}) })
output$map <- renderLeaflet({ output$map <- renderLeaflet({
if (!is.null(filteredOwners()) && nrow(filteredOwners()) > 0) { leaflet() %>%
leaflet() %>% addProviderTiles("CartoDB.Voyager") %>%
addProviderTiles("CartoDB.Voyager") %>% addPolygons(
addPolygons( data = sbdvn,
data = sbdvn, color = "red",
color = "red", weight = 2,
weight = 2, opacity = 0.5,
opacity = 0.5, fillOpacity = 0.2,
fillOpacity = 0.2, label = ~sub_name,
label = ~sub_name, group = "Subdivisions"
group = "Subdivisions" )
) %>% })
addMarkers(
data = filteredOwners(), # Update map markers when filteredOwners changes
#color = ~ifelse(homestead == 1, "green", "red"), observe({
popup = popupTable( leafletProxy("map") %>%
filteredOwners(), clearGroup("Owners") %>%
row.numbers = FALSE, addMarkers(
feature.id = FALSE, data = filteredOwners(),
zcol = c( popup = popupTable(
"label", filteredOwners(),
"owner_1", row.numbers = FALSE,
"owner_2" feature.id = FALSE,
) zcol = c(
), "label",
group = "Owners" "owner_1",
) %>% "owner_2"
addLayersControl( )
overlayGroups = c("Subdivisions", "Owners"), ),
options = layersControlOptions(collapsed = FALSE) group = "Owners"
) %>% ) %>%
setView(lng = mean_lng(), lat = mean_lat(), zoom = 16) addLayersControl(
} else { overlayGroups = c("Subdivisions", "Owners"),
leaflet() %>% options = layersControlOptions(collapsed = FALSE)
addProviderTiles("CartoDB.Voyager") %>% ) %>%
addPolygons( setView(lng = mean_lng(), lat = mean_lat(), zoom = 16)
data = sbdvn,
color = "red",
weight = 2,
opacity = 0.5,
fillOpacity = 0.2,
label = ~sub_name,
group = "Subdivisions"
) %>%
setView(lng = -82.362253, lat = 27.076199, zoom = 16)
}
}) })
output$table <- renderDT({ output$table <- renderDT({
my_table <- if (!is.null(filteredOwners()) && nrow(filteredOwners()) > 0) {
filteredOwners() %>% my_table <-
st_drop_geometry() %>% filteredOwners() %>%
select(label, owner_1, owner_2, homestead) st_drop_geometry() %>%
datatable(my_table, select(label, owner_1, owner_2, homestead)
colnames = c("Address", "Owner 1", "Owner 2", "Homestead"), datatable(my_table,
rownames = FALSE, colnames = c("Address", "Owner 1", "Owner 2", "Homestead"),
options = list( rownames = FALSE,
pageLength = 10, options = list(
scrollX = TRUE, pageLength = 10,
searching = FALSE, scrollX = TRUE,
lengthMenu = c(5, 10, 25, 50), searching = FALSE,
dom = 'tpi' lengthMenu = c(5, 10, 25, 50),
) dom = 'tpi'
) )
)
} else {
# Return empty table with same structure
my_table <- data.frame(
label = character(0),
owner_1 = character(0),
owner_2 = character(0),
homestead = numeric(0)
)
datatable(my_table,
colnames = c("Address", "Owner 1", "Owner 2", "Homestead"),
rownames = FALSE,
options = list(
pageLength = 10,
scrollX = TRUE,
searching = FALSE,
lengthMenu = c(5, 10, 25, 50),
dom = 'tpi'
)
)
}
}) })
prep_mailing <- function(data) { prep_mailing <- function(data) {
data |> data |>