colorbar_at_threshold.R

# Create a color bar and breaks that center at a specific value
# Source: https://stackoverflow.com/a/10986203
colorbar <- function(min, max, threshold=0, palette="RdBu", palette_length=15) {
    pal <- rev(brewer.pal(9, palette))
    
    # Get all possible breaks
    my_breaks <- seq(min, max, length.out=palette_length)

    # Get number of breaks above threshold and below threshold
    above <- length(which(my_breaks > threshold))
    below <- length(which(my_breaks < threshold))

    # Generate vector of colors based on the larger value
    max_breaks <- max(above, below)

    # Make vector of colors for values below threshold
    rc1 <- colorRampPalette(c(pal[1:4], "white"))(max_breaks)
    
    # Make vector of colors for values above threshold
    rc2 <- colorRampPalette(c("white", pal[-5:-1]))(max_breaks)
    
    # For the smaller value, reduce vector to that amount of colors. This is so that 
    # the darker shades of the gradient will be hidden. It also ensures that the shade
    # at +1 is the same shade as -1.
    if (above == max_breaks) {
        rc1 <- rc1[-(length(rc1) - below):-1]
    } else {
        rc2 <- rc2[0:above]
    }
    
    rc <- c(rc1, rc2)
    
    rc[c(below, below+1)] <- "white"
    
    seq1 <- seq(min, threshold, length.out=below+1)
    seq2 <- seq(threshold, max, length.out=above+1)[-1]
    my_breaks <- c(seq1, seq2)
    return(list(col=rc, breaks=my_breaks))
}