# INDIVIDUAL COLORS
#' Reach brand reds
#'
reach_style_color_red<-function(lightness=1){
if (lightness==1){rgb(238/255,88/255,89/255)}
else if (lightness==2){rgb(238/255,88/255,89/255,0.5)}
else if (lightness==3){rgb(238/255,88/255,89/255,0.3)}
}
#' Reach brand dark greys
#'
#'
#'
reach_style_color_darkgrey<-function(lightness=1){
if (lightness==1){rgb(88/255,88/255,90/255)}
else if (lightness==2){rgb(88/255,88/255,90/255,0.5)}
else if (lightness==3){rgb(88/255,88/255,90/255,0.3)}
}
#' reach brand light greys
#'
#'
#'
reach_style_color_lightgrey<-function(lightness=1){
if (lightness==1){rgb(209/255,211/255,212/255)}
else if (lightness==2){rgb(209/255,211/255,212/255,0.5)}
else if (lightness==3){rgb(209/255,211/255,212/255,0.3)}
}
#' reach brand beiges
#'
#'
reach_style_color_beige<-function(lightness=1){
if (lightness==1){rgb(210/255,203/255,184/255)}
else if (lightness==2){rgb(210/255,203/255,184/255,0.5)}
else if (lightness==3){rgb(210/255,203/255,184/255,0.3)}
}
# COLOUR TRIPLES
#' Reach brand reds triples
#'
#'
#'
#'
#'
reach_style_color_reds<-function(){
vapply(1:3,FUN.VALUE = vector(mode = 'character',length = 1),reach_style_color_red)
}
# COLOUR TRIPLES
#' Reach brand dark grey triples
#'
#'
#'
#'
#'
reach_style_color_darkgreys<-function(){
vapply(1:3,FUN.VALUE = vector(mode = 'character',length = 1),reach_style_color_darkgrey)
}
# COLOUR TRIPLES
#' Reach brand light greys triples
#'
#'
#'
reach_style_color_lightgreys<-function(){
vapply(1:3,FUN.VALUE = vector(mode = 'character',length = 1),reach_style_color_lightgrey)
}
# COLOUR TRIPLES
#' Reach brand beige triples
#'
#'
#'
reach_style_color_beiges<-function(){
vapply(1:3,FUN.VALUE = vector(mode = 'character',length = 1),reach_style_color_beige)
}
reach_style_color_rainbow<-function(n){
cols<-c(rev(reach_style_color_darkgreys()[1]),(reach_style_color_reds()[3]),rev(reach_style_color_beiges()[1]))
# cols<-rep(cols,ceiling(n/12))[1:3]
colorRampPalette(cols)(n)
}
reach_style_color_rainbow<-function(n){
cols<-c(rev(reach_style_color_darkgreys()[1]),(reach_style_color_reds()[3]),rev(reach_style_color_beiges()[1]))
# cols<-rep(cols,ceiling(n/12))[1:3]
colorRampPalette(cols)(n)
}
# GGPLOT GRADIENTS
scale_fill_reach <- function(color=NULL,name="",...){
if(is.null(color)){
}else{
structure(list(
scale_fill_manual(values= get(paste0('reach_style_color_',color,'s'))(),name=name,...)
))}
}
scale_fill_reach_categorical<-function(n,name="",...){
structure(list(
scale_fill_manual(values= reach_style_color_categorical(n),name=name,...)
))
}
scale_color_reach_categorical<-function(n,name="",...){
structure(list(
scale_color_manual(values= reach_style_color_categorical(n),name=name,...)
))
}
reach_style_color_categorical<-function(n){
m<-4
cols<-colorRampPalette(c(reach_style_color_darkgreys()[3],
reach_style_color_reds()[1],
reach_style_color_beiges()[1],
reach_style_color_lightgreys()[2]
# reach_style_color_re()[3]
))(n)
# .show_colors(cols)
# colorder<-sapply(1:(n/m),function(x){x+(c(0:(m-1))*n/m)}) %>% as.vector %>% rank
# cols<-cols[colorder[1:length(cols)]]
# .show_colors(cols)
cols
}
categorical_col_order<-function(n){
orders<-list(
1,
c(1:2),
c(1:3),
c(1:4)
)
}
scale_color_discrete_reach <- function(color='red'){
structure(list(
scale_color_manual(values= get(paste0('reach_style_color_',color,'s'))())
))
}
scale_color_continuous_reachn <- function(color='red'){
structure(list(
scale_color_gradientn(colours = get(paste0('reach_style_color_',color,'s'))())
))
}
.show_colors<-function(cols){
plot(1:length(cols),1:length(cols),cex=20,pch=20,col=cols,axes=FALSE)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.