Write scale_fill_semantic()

So we’ll use deeptime::scale_fill_geopattern as a basis, but instead of deeptime:::geo_pattern(code) we’ll use llm_vec_classify(code, bigpal)… where code is the variable to encode…

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".
library(tidyverse)
library(deeptime)

geo_pattern
## function (code, scale = 2, col = NULL, fill = NULL, alpha = NULL, 
##     bg = "white") 
## {
##     img_grob <- geo_grob(code, col = col, fill = fill, alpha = alpha, 
##         bg = bg)
##     scale_vp <- img_grob$children[[1]]$vp[[2]]
##     ar <- abs(diff(scale_vp$xscale))/abs(diff(scale_vp$yscale))
##     if (!is.null(scale) && !is.na(scale)) 
##         scale <- 2
##     img_grob$vp <- viewport(width = unit(ar * scale, "cm"), height = unit(scale, 
##         "cm"))
##     pattern(img_grob, width = unit(ar * scale, "cm"), height = unit(scale, 
##         "cm"), extend = "repeat")
## }
## <bytecode: 0x12193d900>
## <environment: namespace:deeptime>
scale_fill_translate <- function(na.value = "grey50", ...) {
  discrete_scale(
    "fill", 
    palette = NULL, ..., 
    na.value = na.value,
    super = ScaleDiscreteTranslate
  )
}
vec_to_vec <- function(x, to = NULL, table = NULL){ifelse(x == "cat", "black", "white")}

translator <- function(mapped, to = NULL, table = NULL) {
      if (is.na(mapped)) {
        na_value
      } else {
        if(is.null(table)){
          mapped |> vec_to_vec(to)
        } else {
            # lookup routine
          }
        
        
        # deeptime:::geo_pattern(code)   #<<< this is the only change
      }
    }

#' @importFrom ggplot2 ggproto ScaleDiscrete
#' @keywords internal
ScaleDiscreteTranslate <- ggproto("ScaleDiscreteTranslate", 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, translator, simplify = FALSE)
  }
)
tribble(~animal, ~count,
        "cat",        1,
        "peacock",    2,
        "piglet",    3) |> 
ggplot() + 
  aes(fill = animal,
      x = animal,
      y = count) + 
  geom_col() + 
  scale_fill_translate()

layer_data()
##   x y  fill PANEL group flipped_aes ymin ymax xmin xmax colour linewidth
## 1 1 1 black     1     1       FALSE    0    1 0.55 1.45     NA       0.5
## 2 2 2 white     1     2       FALSE    0    2 1.55 2.45     NA       0.5
## 3 3 3 white     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",        10,
        "peacock",    20,
        "piglet",    30) |> 
  uncount(count) |>
  ggplot() + 
  aes(fill = animal,
      x = animal) + 
  geom_bar() + 
  scale_fill_translate()

layer_data()
##   count prop x flipped_aes  fill PANEL group  y ymin ymax xmin xmax colour
## 1    10    1 1       FALSE black     1     1 10    0   10 0.55 1.45     NA
## 2    20    1 2       FALSE white     1     2 20    0   20 1.55 2.45     NA
## 3    30    1 3       FALSE white     1     3 30    0   30 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)