Status Quo
library(tidyverse)
library(deeptime)
scale_fill_geopattern <- function(na.value = "grey50", ...) {
discrete_scale(
"fill", palette = NULL, ..., na.value = na.value,
super = ScaleDiscreteGeoPattern
)
}
# TODO: is there a way to support colors and scaling?
bigpal <- c("plum", "coral", "darkgreen",
"orange", "turquoise", "black",
"dimgrey", "sienna", "maroon",
"beige", "chartreuse", "slateblue", "pink")
library(mall)
options(.mall_chat = ellmer::chat_google_gemini())
## Using model = "gemini-2.5-flash".
#' @importFrom ggplot2 ggproto ScaleDiscrete
#' @keywords internal
ScaleDiscreteGeoPattern <- ggproto("ScaleDiscreteGeoPattern", ScaleDiscrete,
map = function(self, x, limits = self$get_limits()) {
na_value <- if (self$na.translate) self$na.value else NA
# clean limits
limits <- limits[!is.na(limits)]
# if no limits, just return a bunch of NA values
if (length(limits) < 1) {
return(rep(list(na_value), length(x)))
}
# convert to character
if (is.factor(x)) {
x <- as.character(x)
}
# filter to limits
x[is.na(match(x, limits))] <- NA
# get patterns
sapply(x, function(code) {
if (is.na(code)) {
na_value
} else {
code |>
llm_vec_classify(bigpal)
# deeptime:::geo_pattern(code)
}
},
simplify = FALSE)
}
)
tribble(~animal, ~count,
"cat", 1,
"peacock", 2,
"piglet", 3) |>
ggplot() +
aes(fill = animal,
x = animal,
y = count) +
geom_col() +
scale_fill_geopattern()
layer_data()
## x y fill PANEL group flipped_aes ymin ymax xmin xmax colour linewidth
## 1 1 1 plum 1 1 FALSE 0 1 0.55 1.45 NA 0.5
## 2 2 2 turquoise 1 2 FALSE 0 2 1.55 2.45 NA 0.5
## 3 3 3 pink 1 3 FALSE 0 3 2.55 3.45 NA 0.5
## linetype alpha width
## 1 1 NA 0.9
## 2 1 NA 0.9
## 3 1 NA 0.9
tribble(~animal, ~count,
"cat", 1,
"peacock", 2,
"piglet", 3) |>
uncount(count) |>
ggplot() +
aes(fill = animal,
x = animal) +
geom_bar() +
scale_fill_geopattern()
layer_data()
## count prop x flipped_aes fill PANEL group y ymin ymax xmin xmax colour
## 1 1 1 1 FALSE plum 1 1 1 0 1 0.55 1.45 NA
## 2 2 1 2 FALSE turquoise 1 2 2 0 2 1.55 2.45 NA
## 3 3 1 3 FALSE pink 1 3 3 0 3 2.55 3.45 NA
## linewidth linetype alpha width
## 1 0.5 1 NA 0.9
## 2 0.5 1 NA 0.9
## 3 0.5 1 NA 0.9
# library(ggplot2)
# vals <- c("101", "313", "603", "733")
# ggplot(mpg, aes(factor(cyl), fill = vals[factor(cyl)])) +
# geom_bar() +
# scale_fill_geopattern(name = NULL)