﻿ Colorbar from Custom Colorramppalette - ITCodar

# Colorbar from Custom Colorramppalette

## Colorbar from custom colorRampPalette

I made a nice flexible function awhile ago to do this.

``# Function to plot color barcolor.bar <- function(lut, min, max=-min, nticks=11, ticks=seq(min, max, len=nticks), title='') {    scale = (length(lut)-1)/(max-min)    dev.new(width=1.75, height=5)    plot(c(0,10), c(min,max), type='n', bty='n', xaxt='n', xlab='', yaxt='n', ylab='', main=title)    axis(2, ticks, las=1)    for (i in 1:(length(lut)-1)) {     y = (i-1)/scale + min     rect(0,y,10,y+1/scale, col=lut[i], border=NA)    }}``

Then you can do something like:

``> color.bar(colorRampPalette(c("light green", "yellow", "orange", "red"))(100), -1)``

More examples at: http://www.colbyimaging.com/wiki/statistics/color-bars

## How to make a gradual color bar for representation of risk analysis results in R?

I will try to give a lot of detail with my answer.

I am assuming that you want just the colorbar and not the colorbar
added to some other graph. That is what is created below.

#### 0 Setup

``library(fields)     ## for the colorbar function## create the palettemyPalette = colorRampPalette(c("green", "yellow", "orange", "red"))``

#### 1 Create an empty plot.

``plot(0:1, 0:1, type="n", bty="n", xaxs="i",    xaxt="n", yaxt="n", xlab="", ylab="")   ``

When you run this, you should get an empty plot - no axes, nothing.
Both x and y range from 0 to 1.

#### 2 Create the color bar

``colorbar.plot(0.5, 0.05, 1:100, col=myPalette(100),    strip.width = 0.2, strip.length = 1.1)``

#### 3 Add the axis labels

``axis(side=1, at=seq(0,1,1/3), tick=FALSE,    labels=c("No Risk", "Low", "Moderate", "High Risk")) ``

``arrows(0.7, 0.18, 0.7, 0.1, length=0, lwd=8)arrows(0.7, 0.18, 0.7, 0.09, length=0.1, lwd=3, angle=45)``

This is a bit of a hack. If I made the lines in the arrow thick,

the arrowhead was rather blunt and ugly. So the first `arrows`
statement makes a thick line with no arrowhead and the second one

I have the arrow at 0.7. Adjust the x values to place it elsewhere.

## How to draw a colorbar in rgl?

You can use `bgplot3d()` to draw any sort of 2D plot in the background of an `rgl` plot. There are lots of different implementations of colorbars around; see Colorbar from custom colorRampPalette for a discussion. The last post in that thread was in 2014, so there may be newer solutions.

For example, using the `fields::image.plot` function, you can put this after your plot:

``bgplot3d(fields::image.plot(legend.only = TRUE, zlim = range(morph_data), col = col) )``

A documented disadvantage of this approach is that the window doesn't resize nicely; you should set your window size first, then add the colorbar. You'll also want to work on your definition of `col` to get more than 4 colors to show up if you do use `image.plot`.

## How to make discrete gradient color bar with geom_contour_filled?

I believe this is different enough to my previous answer to justify a second one. I answered the latter in complete denial of the new scale functions that came with ggplot2 3.3.0, and now here we go, they make it much easier. I'd still keep the other solution because it might help for ... well very specific requirements.

We still need to use metR because the problem with the continuous/discrete contour persists, and metR::geom_contour_fill handles this well.

I am modifying the `scale_fill_fermenter` function which is the good function to use here because it works with a binned scale. I have slightly enhanced the underlying `brewer_pal` function, so that it gives more than the original brewer colors, if `n > max(palette_colors)`.

update
You should use `guide_colorsteps` to change the colorbar. And see this related discussion regarding the longer breaks at start and end of the bar.

``library(ggplot2)library(metR)mybreaks <- c(seq(-2,2,0.5), 3:5, seq(7,11,2))ggplot(faithfuld, aes(eruptions, waiting)) +  metR::geom_contour_fill(aes(z = 100*density)) +  scale_fill_craftfermenter(    breaks = mybreaks,     palette = "Spectral",     limits = c(-2,11),    guide = guide_colorsteps(      frame.colour = "black",       ticks.colour = "black", # you can also remove the ticks with NA      barwidth=20)  ) +  theme(legend.position = "bottom")#> Warning: 14 colours used, but Spectral has only 11 - New palette created based#> on all colors of Spectral``

``## with uneven steps, better representing the scale ggplot(faithfuld, aes(eruptions, waiting)) +  metR::geom_contour_fill(aes(z = 100*density)) +  scale_fill_craftfermenter(    breaks = mybreaks,     palette = "Spectral",     limits = c(-2,11),    guide = guide_colorsteps(      even.steps = FALSE,      frame.colour = "black",       ticks.colour = "black", # you can also remove the ticks with NA      barwidth=20, )  ) +  theme(legend.position = "bottom")#> Warning: 14 colours used, but Spectral has only 11 - New palette created based#> on all colors of Spectral``

Function modifications

``craftbrewer_pal <- function (type = "seq", palette = 1, direction = 1) {  pal <- scales:::pal_name(palette, type)  force(direction)  function(n) {    n_max_palette <- RColorBrewer:::maxcolors[names(RColorBrewer:::maxcolors) == palette]        if (n < 3) {      pal <- suppressWarnings(RColorBrewer::brewer.pal(n, pal))    } else if (n > n_max_palette){      rlang::warn(paste(n, "colours used, but", palette, "has only",                    n_max_palette, "- New palette created based on all colors of",                     palette))      n_palette <- RColorBrewer::brewer.pal(n_max_palette, palette)      colfunc <- grDevices::colorRampPalette(n_palette)      pal <- colfunc(n)    }    else {      pal <- RColorBrewer::brewer.pal(n, pal)    }    pal <- pal[seq_len(n)]    if (direction == -1) {      pal <- rev(pal)    }    pal  }}scale_fill_craftfermenter <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "fill") {  type <- match.arg(type, c("seq", "div", "qual"))  if (type == "qual") {    warn("Using a discrete colour palette in a binned scale.\n  Consider using type = \"seq\" or type = \"div\" instead")  }  binned_scale(aesthetics, "fermenter", ggplot2:::binned_pal(craftbrewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...)}``

## Changing the color bar font in R plots

This might be difficult to achieve with the default `plot` function from `raster`, which does not appear to allow changes of the font family of the legend.

You could use `ggplot2` to achieve that, using something like this (since you do not provide `GHI` you might have to adjust things):

``library(ggplot2)ggplot() +      geom_tile(data=as.data.frame(rasterToPoints(GHI)), aes(x=x, y=y, fill=layer)) +    scale_fill_gradientn(colours=pal(13), breaks=seq(1300, 1600, length.out=13)) +    theme_classic(base_size=12, base_family="serif") +    theme(panel.border=element_rect(fill=NA, size=1),          plot.title=element_text(hjust=0.5, size=12),          axis.text=element_text(size=12)) +    labs(x="Longitude", y="Latitude", title="Global horizontal irradiation")``

Edit:

I was wrong; the font family can be passed globally, but the font size depends on the graphics device, I believe, hence with `ggplot2` it might still be easier to get your target font size.

To get the same sizes with plot, you could try:

``par(family="serif")plot(GHI, breaks = cuts, col = pal(13),     xlab = "Longitude", ylab = "Latitude", cex.lab=1)title("Global horizontal irradiation", font.main = 1, cex.main=1)``

## colorRampPalette in R more than 2 clusters

I think I found a good solution, here's the cose:

``set.seed(50)mat<-matrix(,200,3) randC<-x[sample(nrow(x),3),]Distmatrix<- t(apply(x,1,function(r) apply(randC,1, function(s) euc.dist(r,                                                                          s))))mat<-apply(mat,2,function(x) x=apply(Distmatrix,1, prod))/DistmatrixP<-t(apply(mat, 1, function(x) x/sum(x)))D4<-data.frame(x,P)rbPal<-list()for(i in 1:k){  rbPal[[i]] <- colorRampPalette(c('white',col=I(i+1)))}for(i in 1:k){  D4[[dim(D4)[2]+1]] <- rbPal[[i]](10)[as.numeric(cut(D4[[2+i]],breaks = 10))]}for(i in 1:k){  D4[[dim(D4)[2]+1]]<-t(col2rgb(D4[[dim(D4)[2]-k+1]])) }prova<-matrix(0,dim(D4)[1],3)for(i in 1:k){  prova<-prova+D4[,(dim(D4)[2]-k+i)]*P[,i]}prova[is.nan(prova)] <- 0provcol=apply(prova,1, function(x) rgb(x[1], x[2], x[3], maxColorValue=255))plot(D4\$X1,D4\$X2,pch = 20,col = provcol, cex=1.5) points(randC, col="red")``

I basically created k different color palette each of them starting from white, which is the color in common of everybody. Then, according to probabilities, I mixed the rgb values of the k cluster probabilities with a weighted mixing.

## How to assign a maximum value shown on a colour ramp in R

There is at least one way to do this, see if this approach works for your use-case:

``library(tidyverse)library(palmerpenguins)#install.packages("cmocean")library(cmocean)library(cowplot)library(ggbeeswarm)plot_1 <- penguins %>%   na.omit() %>%  ggplot(aes(x = species, y = flipper_length_mm, color = body_mass_g)) +  geom_quasirandom()  +  scale_color_cmocean(name = "deep")plot_2 <- penguins %>%   na.omit() %>%  ggplot(aes(x = species,             y = flipper_length_mm,             color = body_mass_g)) +  geom_quasirandom()  +  scale_color_cmocean(name = "deep",                      limits = c(2500, 4000),                      oob = scales::squish,                      labels = c("2500", "3000", "3500", "4000+"))cowplot::plot_grid(plot_1, plot_2, labels = "AUTO")``

Explanation: Panel "A" (plot_1) doesn't have scale limits, Panel "B" (plot_2) has scale limits. The `oob` option ("Out Of Bounds) is also needed in addition to the scale limits in Panel "B" to 'keep' the darkest colour, otherwise the colours above 4000 are grey. I also altered the labels on the legend (`labels` option) to change "4000" to "4000+", but up to you whether you think that's useful or not.