Skip to content

Instantly share code, notes, and snippets.

@vgXhc
vgXhc / metro.R
Created May 14, 2025 20:32
Metro rider charts 2025
library(tidyverse)
library(scales)
madison_vrh <- get_ntd(agency = "City of Madison", ntd_variable = "VRH")
extrafont::loadfonts()
madison_vrh |>
filter(modes == "MB") |>
mutate(year = year(month), mo = month(month)) |>
filter(mo == 3) |>
summarize(mean_vrh = mean(value), .by = year) |>
ggplot(aes(year, mean_vrh)) +
@vgXhc
vgXhc / bps.R
Created May 3, 2025 14:37
Download monthly building permit data and summarize total and multi-family units for a given time period
download_bps_monthly <- function(bps_year, bps_month) {
bps_url <- paste0("https://www.census.gov/construction/bps/xls/cbsamonthly_",
bps_year,
bps_month,
".xls")
bps_dest <- paste0("data/bps/bps_",
bps_year,
bps_month,
".xls")
@vgXhc
vgXhc / madison_dsm_imagery.R
Created March 29, 2025 22:37
Code to take DSM data and imagery data to render a 3D map of Madison
# Load packages ----
library(sf)
library(terra)
library(dplyr)
library(ggplot2)
library(rayshader)
library(rgl)
library(tidyverse)
# Data sources
@vgXhc
vgXhc / birth_marriage_counties.R
Created January 30, 2025 22:19
Map to compare percentage of married population and percent of people who gave birth in past 12 mo to US average
library(tidycensus)
library(tidyverse)
library(sf)
library(tmap)
birth <- get_acs(geography = "county", year = 2023, table = "B13002", geometry = TRUE,
summary_var = "B13002_001")
marriage <- get_acs(geography = "county", year = 2023, table = "B12001",
summary_var = "B12001_001")
@vgXhc
vgXhc / is_feb_warmer_than_jan.R
Created January 25, 2025 14:15
R code to make a chart that compares historic average temperatures in Madison in January and February
library(tidyverse)
clim <- read_csv("c:/Users/user1/Downloads/StnData.csv", col_names = c("date",
"avg",
"hi",
"lo"))
clim |> group_by(yr = year(date), mo = month(date, label = T, abbr = TRUE)) |>
summarize(avg_temp = mean(avg)) |>
filter(mo %in% c("Jan", "Feb")) |>
pivot_wider(names_from = mo, values_from = avg_temp) |>
mutate(feb_warmer = if_else(Feb > Jan, TRUE, FALSE)) |>
@vgXhc
vgXhc / sentinel_true_color.R
Last active December 23, 2024 13:20
R script to implement true color transformation for Sentinel-2 Quarterly Mosaic raw data, based on https://custom-scripts.sentinel-hub.com/sentinel-2/l2a_optimized/ and @[email protected]'s R implementation
# input: ["B04", "B03", "B02"],
DN <- 10000 # unit scaling. See page 40 in https://sentinel.esa.int/documents/247904/685211/Sentinel-2-MSI-L2A-Product-Format-Specifications.pdf
# make list of bands. any order, we'll use names
# adjust aggregation factor for quick testing
smp <- list(B02 = rast("B02.tif") |> aggregate(2) / DN,
B03 = rast("B03.tif") |> aggregate(2) /DN,
B04 = rast("B04.tif") |> aggregate(2) /DN
)
@vgXhc
vgXhc / september_crash_stats.R
Created September 2, 2024 23:34
Creates a graph of bike crashes by month, with September highlighted
library(pins)
library(sf)
library(tidyverse)
library(lubridate)
library(jsonlite)
board <- board_s3("vzpins",
region = "us-east-1",
access_key = "",
@vgXhc
vgXhc / harambe.R
Created January 15, 2024 21:18
Demographics in Harambee
harambee_tracts <- c(44, 45, 67, 69, 70, 81, 106, 1856, 1857, 1860)
milwaukee_tracts_2022 <- get_acs(geography = "tract",
state = 55,
county = "Milwaukee",
table = "B02001",
# summary_var = "B02001_001",
year = 2022,
output = "wide")
@vgXhc
vgXhc / gist:98e2825649484fde5c068eb8eb74570d
Last active September 10, 2024 21:01
Madison Metro ridership chart
madison <- x |> filter(agency == "City of Madison" & modes == "MB" & tos == "DO" & year(month) >2018)
max_month <- madison |> filter(year(month) == max(year(month))) |>
summarize(max(month(month, label = T, abbr = F))) |> pull()
madison |>
mutate(month_label = month(month, label = T, abbr = T)) |>
ggplot(aes(month, value)) +
geom_col(aes(fill = month_label)) +
geom_line() +
theme_minimal() +
@vgXhc
vgXhc / ntdr_hex_sticker.R
Created June 25, 2023 22:01
Code for making the hex sticker for the ntdr package
library(hexSticker)
library(ggplot2)
library(ntdr)
library(cowplot)
library(tidyverse)
bus <- magick::image_read_svg("c:/Users/user1/Downloads/train bus ferry.svg")
madison_bus <- get_ntd(agency = "City of Madison", modes = "MB")
p <- madison_bus |>