In the shiny app below I want when the app starts to display a map with the selected from the widget counties and also a table below.
Then if I click on a county on the map the table to be affected and show only the data from the clicked county also the shiny widget should show only the selected county.
Then if I select more counties from the shiny widget the map and the table and the map should be affected accordingly.
library(shiny)
library(leaflet)
library(sp)
library(rgdal) # Make sure you have this package installed
library(raster)
library(shinyWidgets)
# Sample dataframe (replace this with your actual data)
df <- data.frame(
Indicator = c("primary", "primary", "primary", "primary", "primary", "primary"),
Geography = c("Ventura", "Orange", "Alameda", "Alpine", "Amador", "Butte"),
State = c(rep("California",6)),
Year = c(2008, 2008, 2008, 2008, 2008, 2008),
Category = c("Total Population", "Total Population", "Total Population", "Total Population", "Total Population", "Total Population"),
Subcategory = c("Total population", "Total population", "Total population", "Total population", "Total population", "Total population"),
Numerator = c(NA, 2618, 124, 0, 0, 13),
Denominator = c(NA, 532102, 20483, 11, 295, 2466),
Rate = c(60.3, 49.2, 60.5, 0.0, 0.0, 52.7)
)
# Load USA polygon data
USA <- getData("GADM", country = "usa", level = 2)
ui <- fluidPage(
titlePanel("County Rate Map"),
pickerInput(
inputId = "gr",
label = "County",
choices = unique(df$Geography),
selected = unique(df$Geography),
multiple = T
),
leafletOutput("map"),
dataTableOutput("dt")
)
server <- function(input, output, session) {
# Merge the USA polygon data with the dataframe
merged_data <- sp::merge(USA, df, duplicateGeoms = TRUE, by.x = c("NAME_1","NAME_2"), by.y = c("State","Geography"))
dfpls<-reactive({
df<-subset(merged_data,NAME_2%in%input$gr)
df
})
#calls map
output$map<-renderLeaflet({
# Load your data for the choropleth
#data <- read.csv("your_data.csv") # Replace with the path to your data file
# Merge the data with the US states geojson data
#merged_data <- merge(us_states, data, by.x = "state", by.y = "State", all.x = TRUE)
# temp <- sp::merge(USA, df, duplicateGeoms = TRUE, by.x = c("NAME_2"), by.y = c("Geography"))
temp <- dfpls()
# Determine the maximum value excluding NA values
max_value <- max(temp$Rate, na.rm = TRUE)
# Calculate the maximum value rounded up to the nearest multiple of 20
max_rounded <- ceiling(max_value / 9)
# Create the bins vector
bins <- c(seq(0, max_value, by = max_rounded), max_value)
pal <- colorBin("Blues", domain = as.numeric(temp$Rate), bins = bins)
leaflet(temp) %>%
setView(lng = -118.2437, lat = 34.0522, zoom = 7)%>%
addProviderTiles("CartoDB.Positron")%>%
addPolygons(
fillColor = ~pal(Rate),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
layerId = temp$NAME_2,
highlightOptions = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = lapply(
paste0(
"County: ", temp$NAME_2, "<br>",
"Rate: ",temp$Rate, "<br>",
"Denominator: ", temp$Denominator,"<br>",
"Numerator:",temp$Numerator
),
HTML
),
labelOptions = labelOptions(
style = list("font-weight" = "normal"
, padding = "3px 8px"
, textsize = "15px"
, direction = "auto" ))
) %>%
addLegend(title = "Measure Rate Map",pal = pal, values = ~Rate, opacity = 0.7,
position = "bottomright")
})
# Create a reactive subset of data based on selected county
selected_county_data <- reactive({
# click_county <- input$map_click
click_county <- input$map_shape_click
# print(click_county)
if (is.null(click_county)) {
dfpls()
} else {
clicked_county <- click_county$id
subset(dfpls(), NAME_2 == clicked_county)
}
})
output$dt<-renderDataTable({
selected_county_data()
})
}
shinyApp(ui, server)
In the merged_data object other states with the same name counties are still kept. So, define a data frame while creating selected_county_data() object and keep only the state(s) available in the df object. Also, in output$map keep in temp only the states in df. Then, use updatePickerInput to display the counties clicked on the map.
Lastly, if Rate is 0, it is hard to see where the selected county is since you are using fillColor = ~pal(Rate). So, I have defined it as 33 (arbitrary number). You can define it as you wish.
Try this.
library(shiny)
library(leaflet)
library(sp)
library(rgdal) # Make sure you have this package installed
library(raster)
library(shinyWidgets)
# Sample dataframe (replace this with your actual data)
df <- data.frame(
Indicator = c("primary", "primary", "primary", "primary", "primary", "primary"),
Geography = c("Ventura", "Orange", "Alameda", "Alpine", "Amador", "Butte"),
State = c(rep("California",6)),
Year = c(2008, 2008, 2008, 2008, 2008, 2008),
Category = c("Total Population", "Total Population", "Total Population", "Total Population", "Total Population", "Total Population"),
Subcategory = c("Total population", "Total population", "Total population", "Total population", "Total population", "Total population"),
Numerator = c(NA, 2618, 124, 0, 0, 13),
Denominator = c(NA, 532102, 20483, 11, 295, 2466),
Rate = c(60.3, 49.2, 60.5, 33, 33, 52.7) ### If zero, it is not highlighted in map as you are using fillColor = ~pal(Rate); randomly assigned 33
)
# Load USA polygon data
USA <- getData("GADM", country = "usa", level = 2)
ui <- fluidPage(
titlePanel("County Rate Map"),
pickerInput(
inputId = "gr",
label = "County",
choices = unique(df$Geography),
selected = unique(df$Geography),
multiple = T
),
leafletOutput("map"),
dataTableOutput("dt")
)
server <- function(input, output, session) {
# Merge the USA polygon data with the dataframe
merged_data <- sp::merge(USA, df, duplicateGeoms = TRUE, by.x = c("NAME_1","NAME_2"), by.y = c("State","Geography"))
dfpls<- eventReactive(input$gr, {
df<- subset(merged_data,NAME_2%in%input$gr)
df
})
#calls map
output$map<-renderLeaflet({
states <- unique(df$State)
temp <- subset(dfpls(), NAME_1 %in% states)
# Determine the maximum value excluding NA values
max_value <- max(temp$Rate, na.rm = TRUE)
# Calculate the maximum value rounded up to the nearest multiple of 20
max_rounded <- ceiling(max_value / 9)
# Create the bins vector
bins <- c(seq(0, max_value, by = max_rounded), max_value)
pal <- colorBin("Blues", domain = as.numeric(temp$Rate), bins = bins)
leaflet(temp) %>%
setView(lng = -118.2437, lat = 36.0522, zoom = 5)%>%
addProviderTiles("CartoDB.Positron")%>%
addPolygons(
fillColor = ~pal(Rate),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
layerId = temp$NAME_2,
highlightOptions = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = lapply(
paste0(
"County: ", temp$NAME_2, "<br>",
"Rate: ",temp$Rate, "<br>",
"Denominator: ", temp$Denominator,"<br>",
"Numerator:",temp$Numerator
),
HTML
),
labelOptions = labelOptions(
style = list("font-weight" = "normal"
, padding = "3px 8px"
, textsize = "15px"
, direction = "auto" ))
) %>%
addLegend(title = "Measure Rate Map",pal = pal, values = ~Rate, opacity = 0.7,
position = "bottomright")
})
observeEvent(input$map_shape_click,{
click_county <- input$map_shape_click
choices <- unique(df$Geography)
selected <- click_county$id
updatePickerInput(session = session,"gr",choices=choices, selected=selected)
},ignoreNULL = TRUE)
# Create a reactive subset of data based on selected county
selected_county_data <- reactive({
req(dfpls())
click_county <- input$map_shape_click
states <- unique(df$State)
dfa <- as.data.frame(dfpls())
if (is.null(click_county)) {
df <- dfa[dfa$NAME_1 %in% states,]
} else {
clicked_county <- click_county$id
df <- subset(dfa, NAME_1 %in% states & NAME_2 %in% input$gr)
}
df
})
output$dt<-renderDataTable({
req(selected_county_data())
})
}
shinyApp(ui, server)