R/RHWpal.R

perLightness = function(x){
  L = (100 * 0.5 * (max(col2rgb(x)) + min(col2rgb(x)))) / 255
  L
}

plotPal = function(x, NAAM=NULL){
  df = data.frame(xx = rep(names(x), each = 500),
                  yy = rep(rep(1, length(x)), each = 500),
                  state = factor(names(x)[rep(1:length(x), each = 500)]))
  df$state = factor(df$state, levels = names(x))
  require(ggplot2)
  require(RHWlib)
  G = ggplot(df, aes(x=xx,y=yy,col = (state))) +
    RHWlib::RHWtheme() +
    scale_colour_manual(values = (x))+
    geom_jitter() +
    guides(col = F) +
    theme( axis.text = element_text(),
           axis.title = element_blank(),
           axis.ticks = element_blank()) +
    scale_y_continuous(breaks = NULL) +
    theme(aspect.ratio = 1/length(x))+
    ggtitle(NAAM)
  print(G)

}


#' RHWpal
#'
#' @param whichPal Choose a palette from crisp (default), eels, mondrian, muted, NKI or quins.
#' @param N Output N colors
#' @param vector only return a unnamed vector
#' @param plot Plot a simple plot to showcase the colors
#' @param plotAll plot all palettes
#' @return A df:
#' \itemize{
#'  \item{name: }{The categories of the colours.}
#'  \item{hex: }{The hex-values of the colours.}
#'  \item{lightness: }{The perceived lightness of the colours.}
#' }
#' @export
RHWpal = function(whichPal = 'crisp', N = NULL, vector = T, plot = F, plotAll = F){

  palList = list()

  palList[['mondrian']] = c('red' = '#950D19',
                            'yellow' = '#EED82D',
                            'blue' = '#22579D',
                            'grey' = '#E6E6E6',
                            'black' = '#1F1D1E')
  palList[['quins']] = c('cherry' = '#dd085a',
                         'light' = '#b3b3b3',
                         'blue' = '#2283c3',
                         'dark' = '#333333',
                         'green' = '#2eb84c')
  palList[['muted']] = c('paleGold' = '#c0b283',
                         'charcoal' ='#373737',
                         'paper' = '#f4f4f4',
                         'silk' = '#dcd0c0')
  palList[['crisp']] = c('ice' = '#99D3DF',
                         'plaster' = '#CDCDCD',
                         'linen' ='#E9E9E9',
                         'freshWater' = '#88BBD6')
  palList[['NKI']] = c('AVLred' = '#ba2340',
                       'AVLgray' = '#999999',
                       'AVLyellow' = '#fbc81c')
  palList[['eels']] = c('blue' = '#006eb5',
                        'yellow' = '#ffd327',
                        'green' = '#90c84bff')

  if(plotAll){
    tmp = as.data.frame(unlist(palList))
    tmp = cbind(tmp, do.call('rbind',strsplit(rownames(tmp), split = '\\.')))
    rownames(tmp) = NULL
    colnames(tmp) = c('hex', 'pal', 'col')
    require(ggplot2)
    G = ggplot(tmp ,aes( x = col, y = 1, fill = hex))+
      facet_wrap('pal', scales = 'free', ncol = 1, strip.position = 'right') +
      geom_raster() +
      RHWtheme() +
      scale_fill_identity() +
      scale_y_continuous(breaks = NULL) +
      theme( axis.text = element_text(),
             axis.title = element_blank(),
             axis.ticks = element_blank()) +
      coord_flip(expand = F)
  print(G)
  }



  thisPal = NULL
  if(whichPal %in% names(palList)){
    thisPal = palList[[whichPal]]
  } else {
    stop('Please give a correct pal-name')
  }

  if(!is.null(N)){
    lpal = length(thisPal)
    if(lpal >= N){
      thisPal = thisPal[1:N]
    } else {
      warning('Chosen pallette does not have so many colors. Will output all of them.')
    }
  }

  if(plot){
    require(ggplot2)
    plotPal(thisPal, NAAM = whichPal)
  }

  coldf = cbind(names(thisPal),
                as.data.frame(thisPal),unlist(lapply(thisPal, perLightness)))
  colnames(coldf) = c('name',  'hex','lightness')
  rownames(coldf) = NULL

  if(vector){
    return(as.character(unname(coldf$hex)))
  } else {
    return(coldf)
  }
}
robinweide/RHWlib documentation built on May 7, 2019, 8:03 a.m.