muRtools: Mueller's R tools

Documented in colpal.cont plotColpal

#' Custom Color Paletes
#' 
#' \describe{
#'   \item{\code{colpal.cb}}{
#'         color blind friendly color palettes (adapted from http://wiki.stdout.org/rcookbook/Graphs/Colors%20%28ggplot2%29/)
#'   }
#' }
#'	
#' @export
#' @rdname colpal
#' @aliases colpal,colpal.cb,colpal.colpal.bde
#' @examples 
#' plotColpal(colpal.cb)
colpal.cb <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7","#999999","#000000")
#' \describe{
#'   \item{\code{colpal.bde}}{
#'         Enhanced Color Brewer palette 'Dark2'
#'   }
#' }
#' @rdname colpal
#' @export
#' @examples
#' plotColpal(colpal.bde)
colpal.bde <- c("#2166AC","#B2182B","#1B9E77","#D95F02","#7570B3","#E7298A","#66A61E","#E6AB02","#A6761D","#666666","#00441B","#40004B","#053061")
#' \describe{
#'   \item{\code{colpal.nature}}{
#'         Color palette inspired by Nature journal color scheme's.
#'   }
#' }
#' @rdname colpal
#' @export
#' @examples
#' plotColpal(colpal.nature)
colpal.nature <- c("#003D7C", "#D50911", "#0086A8", "#008136", "#7C68A4", "#8E1A47", "#E67800", "#709F28", "#008FB4", "#84486A", "#B5797F", "#7489A8",  "#6C9396", "#7D9FB1", "#84486A", "#7C698B", "#88A2C3")
#' \describe{
#'   \item{\code{colpal.nature}}{
#'         Color palette inspired by Nature journal color scheme's.
#'   }
#' }
#' @rdname colpal
#' @export
#' @examples
#' plotColpal(colpal.mu.cat)
colpal.mu.cat <- c("#009FE3", "#DE7E00", "#8EC041", "#FFCC00", "#951B81", "#BE1716", "#7C83B3", "#671719", "#775725", "#a6cee3", "#CC79A7", "#E0CDA6", "#ffffb3", "#8dd3c7", "#018D9D", "#8c1515", "#676D8D", "#000000")
#' \describe{
#'   \item{\code{colpal.iwh.cb01}}{
#'      A random color palette generated by algorithm of "I want hue" (colorblind friendly)
#'   }
#' }
#' @rdname colpal
#' @export
#' @examples
#' plotColpal(colpal.iwh.cb01)
colpal.iwh.cb01 <- c("#117ef6", "#b1005b", "#6c8900", "#ff724f", "#ff68af", "#ffb7f5", "#00883a", "#9138a9", "#71003c", "#016cae", "#610048", "#610063", "#00e3b5", "#bfdf91", "#bba2ff", "#964b00", "#ffc153", "#66ecaa", "#01276d", "#009770", "#074a00", "#2cebe8", "#692e00")
#' \describe{
#'   \item{\code{colpal.solarextra}}{
#'      Diverging color scheme often used by the Greenleaf lab
#'   }
#' }
#' @rdname colpal
#' @export
#' @examples
#' plotColpal(colpal.solarextra)
colpal.solarextra = c('#3361A5', '#248AF3', '#14B3FF', '#88CEEF', '#C1D5DC', '#EAD397', '#FDB31A', '#E42A2A', '#A31D1D')
#' \describe{
#'   \item{\code{colpals.topo}}{
#'         List of topgraphic color palettes from http://soliton.vm.bytemark.co.uk/pub/cpt-city/views/topo.html
#'   }
#' }
#' @rdname colpal
#' @export
#' @examples
#' plotColpal(colpals.topo[["dem_cut"]])
colpals.topo <- list(
  dem_cut = c('#008435', '#33CC00', '#F4F071', '#F4BD45', '#99642B', '#692e00'),
  schwarzwald = c('#B0F3BE', '#E0FBB2', '#B8DE76', '#27A52A', '#34883C', '#9CA429', '#F8B004', '#C04A02', '#870800', '#741805', '#6C2A0A', '#7D4A2B', '#9C8170', '#B5B5B5')
)
#' \describe{
#'   \item{\code{colpal.PhFr.[ab]}}{
#'      Photinia fraseri color schemes by Alexandro Trevino
#'   }
#' }
#' @rdname colpal
#' @export
#' @examples
#' plotColpal(colpal.PhFr.a)
colpal.PhFr.a = c('#57612F', '#B3B235', '#CECC2A', '#F8F39E', '#FEFBDE', '#F8AAA8', '#EA7E58', '#D46E2A', '#7B2718')
colpal.PhFr.b = c('#57612F', '#B3B235', '#CECC2A', '#F8F39E', '#FEFBDE', '#FDDEDA', '#F8AAA8', '#E34D4D', '#A32022')
#' \describe{
#'   \item{\code{colpal.PhFr.[ab]}}{
#'      Miniblaze/Moonblaze color schemes by Alexandro Trevino
#'   }
#' }
#' @rdname colpal
#' @export
#' @examples
#' plotColpal(colpal.PhFr.a)
colpal.miniblaze <- c("#d6947f", "#a6b769", "#566466", "#668ec9", "#191e4c", "#875b68")
colpal.moonblaze <- c("#d29e92", "#6d3423", "#d6947f", "#f4baa3", "#e1d29e", "#48483d",
"#f9fae8", "#a6b769", "#4a5233", "#c1cfbb", "#566466", "#668ec9",
"#191e4c", "#875b68", "#1f1b1a")
#' \describe{
#'   \item{\code{colpal.corpid}}{
#'         Color palette inspired by coorporate identities I worked with
#'   }
#' }
#' @rdname colpal
#' @export
#' @examples
#' plotColpal(colpal.corpid)
colpal.corpid <- c(
  "mpii.darkblue"="#1C1D3B",
  "mpii.lightblue"="#676D8D",
  "mpii.grey"="#C6C6B6",
  "deep.turq"="#018D9D",
  "deep.grey"="#C6C6C6",
  "stanford.cardinal"="#8c1515",
  "stanford.coolgrey"="#4d4f53",
  "stanford.black"="#2e2d29",
  "stanford.brightred"="#B1040E",
  "stanford.chocolate"="#2F2424",
  "stanford.fog"="#F4F4F4",
  "stanford.cloud"="#dad7cb",
  "stanford.lightsandstone"="#F9F6EF",
  "icb.lightblue"="#2face3",
  "icb.darkblue"="#114279",
  "icb.linkblue"="#0b7cac",
  "icb.paleblue"="#bae2ef",
  "icb.lightgrey"="#f1f1f1",
  "icb.darkgrey"="#4d4f53"
)
#' \describe{
#'   \item{\code{colpals.games}}{
#'         List of color palette inspired by board games
#'   }
#' }
#' @rdname colpal
#' @export
#' @examples
#' plotColpal(colpals.games[["rollgalaxy"]])
colpals.games <- list(
  bruges=c("#3B8FCF", "#B52622", "#8D5718", "#572978", "#FFC856", "#28A742", "#256CBF", "#C4292C", "#E0EB36"),
  mombasa=c("#009FE3", "#DE7E00", "#8EC041", "#FFCC00", "#951B81", "#BE1716", "#7C83B3", "#671719", "#E0CDA6", "#775725", "#000000"),
  dominantspecies=c("#0093E9", "#D93123", "#19B245", "#F9ED00", "#E5BCCF", "#F7D58A", "#9FC6E0", "#ACD499", "#D8D088", "#59413B", "#000000"),
  terramystica=c("#3B76BB", "#A9122A", "#235E31", "#996F58", "#EDE980", "#D69A30", "#000000", "#B6B6B6"),
  gaiaproject=c("#005AA6", "#D52429", "#FFCB28", "#F37124", "#744F30", "#858A91", "#56A744", "#A52181", "#697F9B", "#0C9DD9"),
  rollgalaxy=c("#6DCFF6", "#ED1C24", "#8DC63F", "#BD8CBF", "#FFF200", "#DBAC78", "#00A651", "#2E3192", "#EC008C")
  #c("#", "#", "#", "#", "#", "#", "#", "#")
)

#' plotColpal
#' 
#' Get a continuous color palette
#' @param cp   color palette, i.e. vector of colors
#' @param type pie chart or stripes
#' @return nothing of particular interest
#' @author Fabian Mueller
#' @export 
plotColpal <- function(cp, type="pie"){
  if (type=="pie"){
    nns <- names(cp)
    if (is.null(nns)) nns <- cp
    pie(rep(1,length(cp)), labels=nns, col=cp, clockwise=TRUE)
  } else if (is.element(type, c("bar", "stripes"))){
    require(plotrix)
    plot.new()
    gradient.rect(0,0,1,1,col=cp,nslices=length(cp),gradient="x",border=NA)
  } else {
    stop(c("Unknown type for color plotting:", type))
  }
}

#' colpal.cont
#' 
#' Get a continuous color palette
#' @param n   number of colors returned
#' @param name   name of the color palette
#' @param ...  arguments passed to other functions
#' @return a character vector containing n colors
#' @author Fabian Mueller
#' @export
#' @examples
#' plotColpal(colpal.cont(5, "viridis"))
#' plotColpal(colpal.cont(5, "cb.BrBG"))
#' plotColpal(colpal.cont(9, "solarextra"))
#' plotColpal(colpal.cont(9, "cptcity.schwarzwald_cont"))
#' plotColpal(colpal.cont(9, "cptcity.europe_7"))
#' plotColpal(colpal.cont(9, "cptcity.spain"))
#' plotColpal(colpal.cont(9, "cptcity.nordisk"))
#' plotColpal(colpal.cont(9, "cptcity.cmocean_delta"))
#' plotColpal(colpal.cont(9, "cptcity.colombia"))
#' plotColpal(colpal.cont(9, "cptcity.blue_tan_d14"))
#' plotColpal(colpal.cont(9, "cptcity.arendal_temperature"))
#' plotColpal(colpal.cont(9, "cptcity.jjg_misc_temperature"))
#' plotColpal(colpal.cont(9, "cptcity.jjg_neo10_elem_rain"))
#' plotColpal(colpal.cont(9, "cptcity.es_vintage_57"))
#' plotColpal(colpal.cont(9, "cptcity.es_skywalker_02"))
colpal.cont <- function(n=3, name="viridis", ...){
  if (name=="viridis"){
    require(viridis)
    return(viridis(n, ...))
  } else if (name=="solarextra"){
    if (n < 1 || n > length(colpal.solarextra)) stop("invalid value for n")
    idx <- as.integer(round(seq(1, length(colpal.solarextra), length.out=n), 0))
    return(colpal.solarextra[idx])
  } else if (grepl("^cb\\.", name)){
    require(RColorBrewer)
    name <- gsub("^cb\\.", "", name)
    return(brewer.pal(n, name, ...))
  } else if (grepl("^at\\.", name)){
    # alex Trevino's color schemes
    atL <- list(
      PhFrA = c("")
    )
    name <- gsub("^cb\\.", "", name)
    return(brewer.pal(n, name, ...))
  } else if (grepl("^topo\\.", name)){
    name <- gsub("^topo\\.", "", name)
    cp <- colpals.topo[[name]]
    if (n < 1 || n > length(cp)) stop("invalid value for n")
    idx <- as.integer(round(seq(1, length(cp), length.out=n), 0))
    return(cp[idx])
  } else if (grepl("^cptcity\\.", name)){
    require(cptcity)
    name <- gsub("^cptcity\\.", "", name)
    nameMatches <- cptcity::find_cpt(name)
    if (length(nameMatches) < 1) stop(paste("Could not find cptcity color scheme:", name))
    return(cptcity::cpt(pal=nameMatches[1], n=n))
  } else {
    stop(c("Unknown name for color palette:", name))
  }
}