function to pass the paletter database to pal packages

paletter_to_pal.R

hex_to_Labspace <- function(hex) { 
  hextolab <- function(x)
    convertColor(x,from="sRGB",to="Lab")
  rgb_col <- col2rgb(hex)/255
  labspace <- apply(rgb_col, 2, hextolab) %>% t
  colnames(labspace) <- c('L','a','b')
  return(labspace)
}

Labspace_to_hex <- function(lab) {
  labtohex <- function(x) {
    rgb_space <- convertColor(x,from="Lab",
                              to="sRGB")
    r <- rgb_space[1,1]
    g <- rgb_space[1,2]
    b <- rgb_space[1,3]
    rgb(r, g, b, maxColorValue = 1)
  }
  return(apply(lab, 1, labtohex))
}


paletteer_c <- function(package, palette, n, direction = 1) {
  
  if (abs(direction) != 1) {
    stop("direction must be 1 or -1")
  }
  
  package <- match.arg(package, names(wrapper_c))
  
  gen_fun <- wrapper_c[[package]]
  
  out <- gen_fun(name = palette, n = n)
  
  if (direction == -1) {
    rev(out)
  } else {
    out
  }
}

# paletteer to pal
library(tidyverse)
library(paletteer)
library(ggthemes)
library(devtools)
#install_github('csaybar/paletteer')
library(paletteer)

# 1 continuous palletes 
pal_c = list() 
#palettes_c_names$package
for (x in 1:nrow(palettes_c_names)) { 
  package = palettes_c_names$package[x] 
  palette = palettes_c_names$palette[x]
  tags <- sprintf('%s__%s',package,palette)
  colors <- paletteer_c(package = package,
                        palette = palette,2) 
  n <- 2 
  matrix <- hex_to_Labspace(colors) 
  type <- 'continous' 
  alpha <- FALSE
  df_c <- data_frame(tags = tags, 
                     colors = list(colors),
                     n = n,
                     matrix = list(matrix),
                     type = type, 
                     alpha = alpha) 
  pal_c[[x]] <- df_c 
  print(x)
}
R_continous <- bind_rows(pal_c)


#discrete palletes to pal 
load("palettes_d_names.rda") 
load("palettes_d.rda")

pal_d <- list()
for (x in 1:nrow(palettes_d_names)) {
  package <- palettes_d_names[x,][[1]]
  palette <- palettes_d_names[x,][[2]]
  
  tags <- sprintf('%s__%s',package,palette)
  colors <- palettes_d[[package]][[palette]]
  n <- palettes_d_names[x,]$length
  matrix <- hex_to_Labspace(colors) 
  type <- palettes_d_names[x,]$type
  alpha <- FALSE
  df_d <- data_frame(tags = tags, 
                     colors = list(colors),
                     n = n,
                     matrix = list(matrix),
                     type = type, 
                     alpha = alpha) 
  pal_d[[x]] <- df_d
  print(x)
}

R_discrete <- bind_rows(pal_d)

load("palettes_dynamic_names.rda") 
load("palettes_dynamic.rda") 

pal_dyn <- list()
for (x in 1:nrow(palettes_dynamic_names)) {

  package <- palettes_dynamic_names[x,][[1]]
  palette <- palettes_dynamic_names[x,][[2]]
  tags <- sprintf('%s__%s',package,palette)
  colors <- palettes_dynamic[[package]][[palette]]
  
  dynam_list = list()
  for (z in 1:length(colors)) {
    n <- length(colors[[z]])
    matrix <- hex_to_Labspace(colors[[z]]) 
    type <- palettes_dynamic_names[x,]$type
    alpha <- FALSE
    df_d <- data_frame(tags = sprintf('%s__dynamic%02d',tags,n), 
                       colors = list(colors[[z]]),
                       n = n,
                       matrix = list(matrix),
                       type = type, 
                       alpha = alpha) 
    dynam_list[[z]] = df_d
  }
  df_dynamic <- bind_rows(dynam_list)
  pal_dyn[[x]] <- df_dynamic
  print(x)
}

R_dynamics <- bind_rows(pal_d)