another experiment

Intro Thoughts

Experiment

library(tidyverse)

translate_unique <- function(from = c("peacock", "dolphin", "dolphin", "bat", "bat", "dog"), 
                             lookup = data.frame(id1 = c("peacock", "dolphin", "bat"),
                                                 id_sp = c("pavo real", "delfín", "murciélago"),
                                                 id3 = c(   NA,    NA, "bunny"),
                                                 .to = c("blue", "turquoise", "black")), 
                             to_column = .to, 
                             missing_value = "grey" |> alpha(.5)){
  
  from_unique <- unique(from)
  
  lookup_long <- lookup |> 
    pivot_longer(cols = -{{to_column}})
  
  data.frame(value = from) |>
    left_join(lookup_long, by = "value") |> 
    pull({{to_column}}) |> 
    replace_na(missing_value)
  
}

translate_unique()

## [1] "blue"      "turquoise" "turquoise" "black"     "black"     "#BEBEBE80"

tribble(~animal,
        "dolphin",
        "peacock",
        "peacock",
        "bat",
        "dog",
        "dog") |> 
  ggplot() + 
  aes(x = animal,
      fill = animal |> translate_unique() |> I()) + 
  geom_bar()

us_map_ref <- usmapdata::us_map() |> rename(.to = geom)

head(us_map_ref)

## Simple feature collection with 6 features and 3 fields
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -2584074 ymin: -2602555 xmax: 1431301 ymax: -39590.54
## Projected CRS: NAD27 / US National Atlas Equal Area
##   fips abbr       full                            .to
## 1   02   AK     Alaska MULTIPOLYGON (((-2390688 -2...
## 2   01   AL    Alabama MULTIPOLYGON (((1091785 -13...
## 3   05   AR   Arkansas MULTIPOLYGON (((482022.2 -9...
## 4   04   AZ    Arizona MULTIPOLYGON (((-1386064 -1...
## 5   06   CA California MULTIPOLYGON (((-1716581 -1...
## 6   08   CO   Colorado MULTIPOLYGON (((-787705.6 -...

to_state_geometry <- function(from = c("Texas"), lookup = us_map_ref, to_column = .to, missing_value = NA){
  
  translate_unique(from, lookup, {{to_column}}, missing_value)
  
}

to_state_geometry()

## Geometry set for 1 feature 
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -629945.5 ymin: -2116769 xmax: 621063.5 ymax: -939319.8
## Projected CRS: NAD27 / US National Atlas Equal Area

## MULTIPOLYGON (((-628450.4 -1427710, -628653.6 -...

tribble(~state,
        "Texas",
        "Texas",
        "North Carolina",
        "Illinois",
        "California",
        "Argentina") |> 
  count(state) |>
  ggplot() + 
  aes(geometry = state |> to_state_geometry()) + # no I() required...
  geom_sf() + 
  aes(fill = n) 

animals_emoji_lookup <- 
  tribble(~en_animal, ~sp_animal, ~.to,
          "peacock",  "pavo real",  "🦚", 
          "dolphin",  "delfín",     "🐬", 
          "bat",      "murciélago", "🦇")
                                          

to_animal_emoji <- function(from, 
                            lookup = animals_emoji_lookup, 
                            to_column = .to, 
                            missing_value = "🤷‍♀️"){
  
  translate_unique(from, lookup, {{to_column}}, missing_value)
  
}


tribble(~animal,
        "dolphin",
        "peacock",
        "peacock",
        "bat",
        "dog",
        "dog") |> 
  ggplot() + 
  aes(x = animal, y = animal,
      shape = animal |> to_animal_emoji() |> I()) + 
  geom_point(size = 15)

df_geopattern <- tibble( 
  id_numerical = c("601", "603", "605"),
  id_name = c("gravel1", "crossbedded gravel", "breccia1"),
  id_name2 = c("gravel", NA, "breccia")) |> 
  mutate(.to = purrr::map(id_numerical, deeptime::geo_pattern))


to_geopattern <- function(from){
  
    translate_unique(from, lookup = df_geopattern, .to, missing_value = NA)

}


to_geopattern(c("101", "603"))

## [[1]]
## NULL
## 
## [[2]]
## $f
## function () 
## {
##     grid.draw(gTree(children = gList(grob), gp = gp), recording = FALSE)
## }
## <bytecode: 0x11a8d4a90>
## <environment: 0x1078af158>
## 
## $x
## [1] 0.5npc
## 
## $y
## [1] 0.5npc
## 
## $width
## [1] 2cm
## 
## $height
## [1] 2cm
## 
## $hjust
## [1] 0.5
## 
## $vjust
## [1] 0.5
## 
## $extend
## [1] "repeat"
## 
## $group
## [1] TRUE
## 
## attr(,"class")
## [1] "GridTilingPattern" "GridPattern"

tribble(~material,
        "gravel",
        "gravel",
        "breccia") |> 
  ggplot() + 
  aes(x = material) + 
  geom_bar() + 
  aes(fill = material |> to_geopattern()) 

library(ggplot2)
library(deeptime)
vals <- c("101", "313", "603", "733")
ggplot(mpg, aes(factor(cyl), fill = vals[factor(cyl)])) +
  geom_bar() +
  scale_fill_geopattern(name = NULL)

library(ggfoundry)

tribble(~stuff,
        "cup", 
        "pumpkin",
        "bowl0") |> 
  ggplot() + 
  aes(x = stuff, y = stuff) + 
  geom_casting(fill = "steelblue1") + 
  aes(shape = I(stuff))

tribble(~stuff,
        "cup", 
        "pumpkin",
        "bowl0") |> 
  ggplot() + 
  aes(x = stuff, 
      y = stuff,
      shape = stuff) + 
  geom_casting(fill = "steelblue1") + 
  scale_discrete_identity(aesthetic = "shape", guide = "legend")

last_plot() + 
  scale_shape_identity(guide = "legend")  # this error felt weird to me

## Scale for shape is already present.
## Adding another scale for shape, which will replace the existing scale.

## Error in `scale_shape_identity()`:
## ! Discrete value supplied to a continuous scale.
## ℹ Example values: "bowl0" and "pumpkin".