Leaflet Maps with barcharts

Mike Proctor 2025-08-22

Generate Leaflet maps based on USDA_NASS data

Setup and load data

Maps may look a little wonky because I’m only using 200 rows out 4800 do to file size constraints. That is affecting the palettes as well.

# Calculate centroids - convert to EPSG:4326 - extract coords -for leaflet

   df_centroid <- df_short |> st_centroid() |> 
                          st_transform(4326) |> 
                          select(ASD_DESC, county_name, geom) |> 
                          distinct() 
  
#plot(df_centroid$geom)

   df_short <- df_short |> st_transform(4326) 
  
   barchart_data <- df_short |>  st_centroid() |> # minichart can't deal with polygons
                                pivot_wider(id_cols = c(ASD_DESC, county_name, YEAR, geom), 
                                            names_from = c(Names),
                                            values_from = c(Percent) 
                                            )  

   coords <- barchart_data |> st_coordinates() |> as_tibble() |> select(1:2) # extract coords for minicharts
  
   df_bar <- bind_cols(barchart_data, coords) |> st_drop_geometry(df_long) # drop geom column for minicharts

# viewport
start_lat <-  31.1667
start_lng <- -99.1667

# set up palette for polygons
##################################################################
df_pal <- df_short |> filter(Names == "Total"
                        #& YEAR == max(YEAR)
                        ) # polygons for latest year

pal <- colorNumeric(
  palette = "viridis",
  domain = df_pal$Percent)

# titles etc
###############################################################
titleText <- paste("Percent of County in Production....sort of","<br/>", 
                   "Acres(the same) get counted for Males and Females", "<br/>", "Due to this total percent can exceed 100%")

tag.map.title <- tags$style(HTML("
  .leaflet-control.map-title { 
    transform: translate(-50%,20%);
    position: fixed !important;
    left: 50%;
    text-align: center;
    padding-left: 10px; 
    padding-right: 10px; 
    background: rgba(255,255,255,0.75);
    font-weight: bold;
    font-size: 28px;
  }
"))

title <- tags$div(
  tag.map.title, HTML(titleText)
)
# map
###################################################

years <- sort(unique(df_bar$YEAR))
#years <- c(2007)

for (i in seq_along(years)) {

  df <- df_short |> filter(YEAR == years[i])

  print(df$YEAR[1])
  
basemap <-
leaflet(df) %>%
  addProviderTiles(providers$Esri.WorldImagery) %>%
  
  setView( lat = start_lat,lng = start_lng, zoom = 6) %>%

  addControl(title, position = "topleft", className = "map-title") %>%

  addPolygons(data = df,
              weight = 1,
              color = "white"
              , fillColor = ~pal(df$Percent)
              , fillOpacity = 0.8) |>
  
  addCircleMarkers(data = df_centroid,
                 radius = 4,
                 fillColor = "white",
                 fillOpacity = 1,
                 stroke = FALSE,
                 weight = 0.0,
                 popup = paste0(df_centroid$county_name, " County"),
                 label = ~ df_centroid$county_name,
                 labelOptions = labelOptions(noHide = FALSE,
                                                   direction = 'top',
                                                   textOnly = TRUE,
                                                   style = list("color" = "black"))) %>%
  
  addLegend(pal = pal, values = df$Percent, opacity = 0.8, title = df$YEAR[1])

# barchart
##############################################################################

  df_year <- df_bar |> na.omit() # NA skewed the palette for 2007

  bar <- basemap |>

  addMinicharts(
              df_year$X, df_year$Y,
              chartdata = df_year |> select(FEMALE, MALE, Total),
              colorPalette = c("red", "blue", "darkgreen")
            )

  filename <- paste0(spatial_path, "leaflet_", df$YEAR[i], ".html")
  print(filename)

  #htmlwidgets::saveWidget(title = paste0(df$YEAR[i], " Production"),   basemap, filename, selfcontained = T)
  htmlwidgets::saveWidget(title = paste0(df$YEAR[i], " Production"),   bar, filename, selfcontained = T)

}

# viewport
start_lat <-  31.1667
start_lng <- -99.1667

# titles etc
###############################################################
titleText <- paste("Percent of County in Production....sort of","<br/>", 
                   "Acres(the same) get counted for Males and Females", "<br/>", "Due to this total percent can exceed 100%")

tag.map.title <- tags$style(HTML("
  .leaflet-control.map-title { 
    transform: translate(-50%,20%);
    position: fixed !important;
    left: 50%;
    text-align: center;
    padding-left: 10px; 
    padding-right: 10px; 
    background: rgba(255,255,255,0.75);
    font-weight: bold;
    font-size: 28px;
  }
"))

title <- tags$div(
  tag.map.title, HTML(titleText)
)

# map
###################################################
df <- df_short |> select(county_name) |> distinct(county_name, geom)

basemap <-
leaflet(df) %>%
  addProviderTiles(providers$Esri.WorldImagery) %>%
  setView( lat = start_lat,lng = start_lng, zoom = 6) %>%

  addControl(title, position = "topleft", className = "map-title") %>%
  #addControl(birdLegend, position = "topleft") %>%   
  
addPolygons(data = df,
            weight = 1,
            color = "white"
            #, fillColor = ~pal(df$Percent)
            #, fillOpacity = 0.8
            ) |> 

addCircleMarkers(data = df_centroid,
               radius = 4,
               fillColor = "white",
               fillOpacity = 1,
               stroke = FALSE,
               weight = 0.0,
               popup = paste0(df_centroid$county_name, " County"),
               label = ~ df_centroid$county_name,
               labelOptions = labelOptions(noHide = FALSE,
                                                 direction = 'top',
                                                 textOnly = TRUE,
                                                 style = list("color" = "black"))) 

#print(basemap)
##############################################################################

 df_year <- df_bar |> select(-FEMALE, -MALE) |> 
                      arrange(YEAR) |>
                      na.omit() |> 
                        pivot_wider(
                                   # id_cols = optional vector of unaffected columns,
                                   names_from = c(YEAR),
                                   values_from = c(Total) 
                        )  

  bar <- basemap |>

  addMinicharts(
              df_year$X, df_year$Y,
              type = "bar",
              chartdata = df_year |> select(`1997`:`2022`),
              colorPalette = c("red", "blue", "darkgreen", "brown", "white", "black" ),
              width = 45,
              height = 45,
              maxValues = 180
            )
  #
  # print(bar)
  filename <- paste0(spatial_path, "Tot_leaflet.html")
print(filename)

  htmlwidgets::saveWidget(title = "Total Production",   bar, filename, selfcontained = T)