Status Quo
library(tidyverse)
library(ggincerta)
nc_counties <- tigris::counties(state = "NC", cb = TRUE, class = "sf") |>
select(county_name = NAME, geometry)
#
geom_county <- ggregions::write_geom_region_locale(ref_data = nc_counties)
# from emily
nc_midterms<- read_csv("https://raw.githubusercontent.com/EvaMaeRey/sf2stat/refs/heads/main/nc-midterms.csv")
head(nc_midterms)
## # A tibble: 6 × 4
## desc_county n cd_party ind_vote
## <chr> <dbl> <dbl> <dbl>
## 1 ONSLOW 24406 0.206 0.386
## 2 ROBESON 36367 0.506 0.407
## 3 RANDOLPH 15867 0.165 0.423
## 4 ANSON 9028 0.567 0.427
## 5 HALIFAX 21875 0.587 0.434
## 6 ROWAN 23667 0.242 0.434
nc_midterms |>
mutate(desc_county = str_to_title(desc_county)) |>
ggplot() +
aes(county_name = desc_county,
fill = duo(n,
ind_vote)) +
geom_county()
last_plot() +
scale_fill_bivariate(colors = c("gold", "transparent")) +
labs(title = "By population")
last_plot() +
scale_fill_bivariate(colors = c("transparent", "red4")) +
labs(title = "By turnout")
last_plot() +
scale_fill_bivariate() +
labs(title = "By population and turnout")
last_plot() +
aes(fill = cd_party) +
scale_fill_gradient2(midpoint = .5) +
labs(title = "By party")
how does it work?
duo(nc_midterms$n, nc_midterms$cd_party) |> head(2)
## [[1]]
## [[1]]$v1
## [1] 24406
##
## [[1]]$v2
## [1] 0.2059283
##
##
## [[2]]
## [[2]]$v1
## [1] 36367
##
## [[2]]$v2
## [1] 0.5061306
scale_fill_bivariate
## function (name1 = NULL, name2 = NULL, colors = c("gold", "red4"),
## n_breaks = 4, breaks = c("quantile", "equal"), flip = c("none",
## "vertical", "horizontal", "both"), guide_size = 1.5,
## na.value = NA, na.translate = TRUE, aesthetics = "fill",
## ...)
## {
## flip <- match.arg(flip)
## breaks <- match.arg(breaks)
## pal_safe <- function(n) {
## bivar_palette(colors, n_breaks = rep(round(sqrt(n)),
## 2), flip = flip)
## }
## sc <- discrete_scale(aesthetics = aesthetics, palette = pal_safe,
## guide = "legend", drop = FALSE, na.value = na.value,
## na.translate = na.translate, super = ScaleBivariate,
## ...)
## if (length(n_breaks) == 1L && is.numeric(n_breaks)) {
## n_breaks <- c(n_breaks, n_breaks)
## }
## stopifnot(length(n_breaks) == 2)
## sc$n_breaks <- n_breaks
## sc$breaks <- breaks
## sc$colors <- colors
## sc$name1 <- name1
## sc$name2 <- name2
## sc$guide_size <- guide_size
## sc
## }
## <bytecode: 0x7f9e623c4720>
## <environment: namespace:ggincerta>
ScaleBivariate$transform
## <ggproto method>
## <Wrapper function>
## function (...)
## transform(..., self = self)
##
## <Inner function (f)>
## function (self, x)
## {
## n_breaks <- self$n_breaks
## colors <- self$colors
## breaks <- self$breaks
## compute_bivariate <- function(x, y) {
## qx <- quantile(x, seq(0, 1, length.out = n_breaks[1] +
## 1), na.rm = TRUE)
## qy <- quantile(y, seq(0, 1, length.out = n_breaks[2] +
## 1), na.rm = TRUE)
## if (breaks == "equal" || length(unique(qx)) < n_breaks[1]) {
## qx <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE),
## length.out = n_breaks[1] + 1)
## }
## if (breaks == "equal" || length(unique(qy)) < n_breaks[2]) {
## qy <- seq(min(y, na.rm = TRUE), max(y, na.rm = TRUE),
## length.out = n_breaks[2] + 1)
## }
## xb <- unique(as.numeric(qx))
## yb <- unique(as.numeric(qy))
## bin1 <- cut(x, breaks = xb, include.lowest = TRUE, labels = FALSE)
## bin2 <- cut(y, breaks = yb, include.lowest = TRUE, labels = FALSE)
## combo <- (bin2 - 1L) * n_breaks[1] + bin1
## list(value = factor(combo, levels = 1:prod(n_breaks)),
## xb = xb, yb = yb)
## }
## if (inherits(x, "bivariate")) {
## res <- compute_bivariate(sapply(x, function(x) x$v1),
## sapply(x, function(x) x$v2))
## }
## n <- prod(n_breaks)
## cols <- self$palette(n)
## if (length(cols) < n) {
## cols <- rep_len(cols, n)
## }
## self$legend_cols <- unname(as.character(cols))
## self$guide <- guide_bivariate(key = setNames(list(self$legend_cols),
## self$aesthetics), value = as.character(seq_len(n)), label = as.character(seq_len(n)),
## n_breaks = n_breaks, label1 = format(res$xb, digits = 2),
## label2 = format(res$yb, digits = 2), title1 = self$name1 %||%
## attr(x, "vars")[1], title2 = self$name2 %||% attr(x,
## "vars")[2], size = self$guide_size, aesthetics = self$aesthetics)
## res$value
## }