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

208
app.R
View File

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