suppressPackageStartupMessages({
    library(tidyverse)
    library(cowplot)
    library(patchwork)
    library(colors3d)
    library(prismatic)
    library(pals)
    theme_set(theme_cowplot())
})
options(repr.plot.width=16,repr.plot.height=10)

map_to_color2d <- function(data, xvar, yvar, colors=c("yellow", "green", "blue", "magenta"), xtrans="rank", ytrans="rank", size=5, na.color='white') {
    data |>
    summarize(
        min_x = min({{xvar}},na.rm=T), max_x = max({{xvar}},na.rm=T),
        min_y = min({{yvar}},na.rm=T), max_y = max({{yvar}},na.rm=T)
    ) |>
    with(expand_grid(
        x = seq(min_x, max_x, length.out = size),
        y = seq(min_y, max_y, length.out = size)
    )) |>
    mutate(
        color = colors2d(tibble(x,y), xtrans = xtrans, ytrans = ytrans, colors=colors)
    ) |>
    ggplot(aes(x,y,fill=color)) +
    geom_raster() +
    scale_fill_identity() +
    labs(x=as_label(enquo(xvar)), y=as_label(enquo(yvar))) +
    coord_cartesian(expand=0) -> lgd

    data2 <-
    select(data, {{xvar}}, {{yvar}}) |>
    colors2d(xtrans = xtrans, ytrans = ytrans, colors=colors) |>
    bind_cols(data, color=_) |>
    mutate(color=ifelse(is.na({{xvar}}) | is.na({{yvar}}), na.color, color)) 

    list(data=data2, legend=lgd)
}

head(iris,3)

colors <- c('purple', 'blue', 'black', 'red')

r <- map_to_color2d(iris, xvar=Sepal.Length, yvar=Sepal.Width, colors=colors)

ggplot(r$data, aes(y=Petal.Length, x=Petal.Width, color=color, shape=Species, group=Species)) +
stat_ellipse(color='darkgray') +
geom_point(size=3) +
scale_color_identity() +
guides(custom = guide_custom(as_grob(r$legend), width=unit(0.4,'npc'), height=unit(0.4,'npc')))

color(arc.bluepink())

color(arc.bluepink()[c(16,4,1,13)])

r <- map_to_color2d(iris, xvar=Sepal.Length, yvar=Sepal.Width, colors=arc.bluepink()[c(16,4,1,13)], size=4)

ggplot(r$data, aes(y=Petal.Length, x=Petal.Width, color=color, shape=Species, group=Species)) +
stat_ellipse(color='darkgray') +
geom_point(size=3) +
scale_color_identity() +
guides(custom = guide_custom(as_grob(r$legend), width=unit(0.4,'npc'), height=unit(0.4,'npc')))

color(tolochko.redblue())

color(tolochko.redblue()[c(9,3,1,7)])

r <- map_to_color2d(iris, xvar=Sepal.Length, yvar=Sepal.Width, colors=tolochko.redblue()[c(9,3,1,7)], size=3)

ggplot(r$data, aes(y=Petal.Length, x=Petal.Width, color=color, shape=Species, group=Species)) +
stat_ellipse(color='darkgray') +
geom_point(size=3) +
scale_color_identity() +
guides(custom = guide_custom(as_grob(r$legend), width=unit(0.4,'npc'), height=unit(0.4,'npc')))

library(sf)

data(USCancerRates, package='latticeExtra')
data <- 
    maps::map("county", fill=TRUE, plot =FALSE, projection = "tetra") |>
    st_as_sf() |> 
    as_tibble() |>
    left_join(rownames_to_column(USCancerRates, 'ID'), by='ID')

head(data, 3)

library(paletteer)

data |>
ggplot(aes(fill=log2(rate.male/rate.female), geometry=geom)) +
geom_sf() +
scale_fill_paletteer_c(palette = 'grDevices::RdBu',limits=c(-1,1), oob=scales::squish, direction = -1)

color(stevens.pinkgreen())

color(stevens.pinkgreen()[c(9,3,1,7)])

r <- map_to_color2d(data, xvar=rate.male, yvar=rate.female, colors=stevens.pinkgreen()[c(9,3,1,7)], size=3, na.color='gray60')

r$data |>
mutate(lab=ifelse(rate.female>400, ID, NA)) |>
ggplot(aes(fill=color, geometry=geom)) +
geom_sf(color='black') +
scale_fill_identity() +
guides(custom = guide_custom(as_grob(r$legend), width=unit(0.4,'npc'), height=unit(0.4,'npc')))