2d color gradient plot in R
Asked Answered
C

4

11

I want to produce a 2d color gradient rectangle like the ones in the picture below on the right hand side. How can I do this in R? Using colorRamp or RColorBrewer or other functions/packages I can produce nice 1D dolor ramps. But how do I do this for 2D including several colors in the corners, like e.g. the upper right rectangle?

Color gradients

What I want to get is e.g. the following two gradient types:

enter image description here enter image description here

BTY: I completely forgot to mention that I found the above chart here (produced by Luca Fenu).

Chyle answered 17/6, 2012 at 8:57 Comment(3)
This is a very nice technical question indeed, but I would also suggest that there might be other ways of displaying the data that would be easier to interpret ... a 2D colour spectrum would fall pretty far down Cleveland's hierarchy of graphical characteristics (although I'm sure he never explicitly considered it) (Looking at your legend, it seems that you actually have a 3D colour space?)Windmill
Hi Ben, currently this is the consensus in my working group that this is the graph we want.. though there really may be better visual approaches. In my case the underlying color representation does not need even to be 'exact'. I rather use it as a broad indicator for the audience to get an idea of what a position in the plane means.Chyle
hhm, yes, you are right. The upper right appears to include more difficult gradient types...Chyle
I
7

Thanks for commenting on my post - I'm glad it generated some discussion. Here's a minimal code to achieve the plots on the upper right - I'm sure there's other more efficient ways to do it... But this works without need for other libraries, and should be easy enough to follow... you can change saturation and alpha blending by playing with the max_sat and alpha_default variables...

#define extremes of the color ramps
rampk2r <- colorRampPalette(c(rgb(  0/255,   0/255,   0/255), rgb(218/255,   0/255,   0/255)))
rampk2g <- colorRampPalette(c(rgb(  0/255,   0/255,   0/255), rgb(  0/255, 218/255,   0/255)))

# stupid function to reduce every span of numbers to the 0,1 interval
prop <- function(x, lo=0, hi=100) {
    if (is.na(x)) {NA}
    else{
        min(lo,hi)+x*(max(lo,hi)-min(lo,hi))
    }
}

rangepropCA<-c(0,20)
rangepropCB<-c(0,20)

# define some default variables
if (!exists('alpha_default')) {alpha_default<-1} # opaque colors by default
if (!exists('palette_l')) {palette_l<-50} # how many steps in the palette
if (!exists('max_sat')) {max_sat<-200} # maximum saturation
colorpalette<-0:palette_l*(max_sat/255)/palette_l # her's finally the palette...

# first of all make an empy plot
plot(NULL, xlim=rangepropCA, ylim=rangepropCB, log='', xaxt='n', yaxt='n', xlab='prop A', ylab='prop B', bty='n', main='color field');
# then fill it up with rectangles each colored differently
for (m in 1:palette_l) {
    for (n in 1:palette_l) {
        rgbcol<-rgb(colorpalette[n],colorpalette[m],0, alpha_default);
        rect(xleft= prop(x=(n-1)/(palette_l),rangepropCA[1],rangepropCA[2]) 
            ,xright= prop(x=(n)/(palette_l),rangepropCA[1],rangepropCA[2])
            ,ytop= prop(x=(m-1)/(palette_l),rangepropCB[1],rangepropCB[2]) 
            ,ybottom= prop(x=(m)/(palette_l),rangepropCB[1],rangepropCB[2])
            ,col=rgbcol
            ,border="transparent"
        )
    }
}
# done!
Italian answered 19/6, 2012 at 14:42 Comment(0)
C
9

Try this:

 m = tcrossprod(sin(seq(0,pi,length=1e2)), cos(seq(0, 3*pi, length=1e2)))
 cols = matrix(hcl(h=scales::rescale(m, c(0, 360))), nrow(m))
 grid::grid.raster(cols)

You'll need to find which function describes the colour gradient that you want (I used sine waves for illustration).

enter image description here

Edit: linear interpolation between 4 corners

library(grid)
library(scales)

m = tcrossprod(seq(1,2,length=1e2), seq(2, 3, length=1e2))
pal <- gradient_n_pal(c("red","green","yellow","blue"), values = c(2, 3, 4, 6), space = "Lab")
cols = matrix(pal(m), nrow(m))
grid.raster(cols)

enter image description here

Edit 2: When the function is not separable, use outer,

fun_xy <- function(x, y){

  abs(y-x) * abs(y+x)

}

z <- outer(seq(-1,1,length=100), seq(-1,1,length=100), FUN = fun_xy)

cols = matrix(hcl(h=scales::rescale(z, c(0, 200))), nrow(z))
grid::grid.raster(cols)

enter image description here

You can also do the colour mixing directly inside the function instead of mapping values to a colour scale afterwards,

fun_xy <- function(x, y){

  R <- (x+1)/2
  G <- (1-x)/2
  B <- (y+1)/2
  A <- 1- 0.5*exp(-(x^2+y^2)/0.2)

  rgb(R, G, B, A)

}

z <- outer(seq(-1,1,length=100), seq(-1,1,length=100), FUN = fun_xy)

library(grid)
grid.newpage()
grid::grid.raster(z)

enter image description here

Circuitous answered 17/6, 2012 at 9:28 Comment(7)
Thanks for the answer! This clearly solves the technical part. So it comes down to te question of which function will do this. The upper 2D gradient in the pic above appears to be a very straightforward one. Still I have problems figuring out the proper function for this. Any ideas?Chyle
it's a little vague without the context. What is the underlying question you're trying to address? What do these colour maps represent?Circuitous
I have two variables A and B. Each is scaled between 0 and 1. 0 indicates bad, 1 good performance. I want to underlay the 2D plane with an appropriate color representation. E.g. lower left corner in red, upper left in green, upper right in green and lower right in green. The other position should get interpolated on a red - yellow- green gradient. I attached a new image how it should look like above (generated with PPT). What I do not understand is how to properly produce the colors that lay in between. I think as simple example of this kind would be enough for me to figure out the rest.Chyle
hi @Circuitous what would the function be for the author's examples with the X in the middle? i'm having a hard time figuring it out.. thanks!Sweptwing
@Circuitous thanks for the edit, but how do you do what you've done and still put four different colors in the four corners? i tried to answer this as well but i'm certain there's a better way..Sweptwing
@AnthonyDamico this isn't really about programming anymore but maths, and the question is ill-defined: we need to imagine a function (x,y) that gives this pattern based on approximate descriptions -- four corners, a bright cross (why?) etc.Circuitous
@Circuitous thank you yet again. this almost answers but i still don't understand how would you would do this with purple yellow orange and black instead of three of the primary colors? the cross in the middle is useful for mapping -- in fact, it's the reason that the mid= parameter defaults to 'white' on scale_colour_gradient2Sweptwing
I
7

Thanks for commenting on my post - I'm glad it generated some discussion. Here's a minimal code to achieve the plots on the upper right - I'm sure there's other more efficient ways to do it... But this works without need for other libraries, and should be easy enough to follow... you can change saturation and alpha blending by playing with the max_sat and alpha_default variables...

#define extremes of the color ramps
rampk2r <- colorRampPalette(c(rgb(  0/255,   0/255,   0/255), rgb(218/255,   0/255,   0/255)))
rampk2g <- colorRampPalette(c(rgb(  0/255,   0/255,   0/255), rgb(  0/255, 218/255,   0/255)))

# stupid function to reduce every span of numbers to the 0,1 interval
prop <- function(x, lo=0, hi=100) {
    if (is.na(x)) {NA}
    else{
        min(lo,hi)+x*(max(lo,hi)-min(lo,hi))
    }
}

rangepropCA<-c(0,20)
rangepropCB<-c(0,20)

# define some default variables
if (!exists('alpha_default')) {alpha_default<-1} # opaque colors by default
if (!exists('palette_l')) {palette_l<-50} # how many steps in the palette
if (!exists('max_sat')) {max_sat<-200} # maximum saturation
colorpalette<-0:palette_l*(max_sat/255)/palette_l # her's finally the palette...

# first of all make an empy plot
plot(NULL, xlim=rangepropCA, ylim=rangepropCB, log='', xaxt='n', yaxt='n', xlab='prop A', ylab='prop B', bty='n', main='color field');
# then fill it up with rectangles each colored differently
for (m in 1:palette_l) {
    for (n in 1:palette_l) {
        rgbcol<-rgb(colorpalette[n],colorpalette[m],0, alpha_default);
        rect(xleft= prop(x=(n-1)/(palette_l),rangepropCA[1],rangepropCA[2]) 
            ,xright= prop(x=(n)/(palette_l),rangepropCA[1],rangepropCA[2])
            ,ytop= prop(x=(m-1)/(palette_l),rangepropCB[1],rangepropCB[2]) 
            ,ybottom= prop(x=(m)/(palette_l),rangepropCB[1],rangepropCB[2])
            ,col=rgbcol
            ,border="transparent"
        )
    }
}
# done!
Italian answered 19/6, 2012 at 14:42 Comment(0)
S
0

I am certain there is a more elegant way to do this. Anyway, here you go: the last line is a pretty close recreation of your original image in the question.

library(scales)

four.color.matrix <-
    function( mycols ){

        m <- matrix( NA , 100 , 100 )

        m[ 1 , 1 ] <- mycols[ 1 ] 
        m[ 1 , 100 ] <- mycols[ 2 ]
        m[ 100 , 1 ] <- mycols[ 3 ]
        m[ 100 , 100 ] <- mycols[ 4 ]

        m[ 1 , 1:100 ] <- gradient_n_pal( c( mycols[ 1 ] , 'white' , mycols[ 2 ] ) , values = c( 1 , 50 , 100 ) )(1:100)
        m[ 1:100 , 1 ] <- gradient_n_pal( c( mycols[ 1 ] , 'white' , mycols[ 3 ] ) , values = c( 1 , 50 , 100 ) )(1:100)
        m[ 1:100 , 100 ] <- gradient_n_pal( c( mycols[ 2 ] , 'white' , mycols[ 4 ] ) , values = c( 1 , 50 , 100 ) )(1:100)
        m[ 100 , 1:100 ] <- gradient_n_pal( c( mycols[ 3 ] , 'white' , mycols[ 4 ] ) , values = c( 1 , 50 , 100 ) )(1:100)

        a <- gradient_n_pal( c( mycols[ 1 ] , 'white' , mycols[ 4 ] ) , values = c( 1 , 50 , 100 ) )
        diag(m)<-a(1:100)

        b <- gradient_n_pal( c( mycols[ 3 ] , 'white' , mycols[ 2 ] ) , values = c( 1 , 50 , 100 ) )
        for(i in 1:(nrow(m) - 1)){ 
          for (j in 1:nrow(m)) if (i + j == nrow( m )+1){
              m[i,j] <- b(j)
            }
        }

        for ( i in 2:50 ){

            m[ i , i:(101-i) ] <- 
                gradient_n_pal( c( mycols[ 1 ] , 'white' , mycols[ 2 ] ) , values = c( 0 , 50 , 100 ) )(  i:(101-i) )

            m[ i:(101-i) , i ] <- 
                gradient_n_pal( c( mycols[ 3 ] , 'white' , mycols[ 1 ] ) , values = c( 0 , 50 , 100 ) )( (101-i):i )

        }



        for ( i in 51:99 ){

            m[ i , i:(101-i) ] <- 
                gradient_n_pal( c( mycols[ 3 ] , 'white' , mycols[ 4 ] ) , values = c( 0 , 50 , 100 ) )(  i:(101-i) )

            m[ i:(101-i) , i ] <- 
                gradient_n_pal( c( mycols[ 4 ] , 'white' , mycols[ 2 ] ) , values = c( 0 , 50 , 100 ) )( (101-i):i )

        }

        m
    }


z <- four.color.matrix( c( 'red' , 'yellow' , 'green' , 'blue' ) )
library(grid)
grid.raster( z )

# original question asked for something like this
grid.raster( four.color.matrix( c( 'darkgreen' , 'darkgreen' , 'darkred' , 'darkgreen' ) ) )
Sweptwing answered 26/10, 2014 at 13:2 Comment(0)
E
0

you may try this and see result plot

rotate <- function(x) t(apply(x, 2, rev))
n <- 3
library(grid)
mm <- tcrossprod(seq(1,0,length.out = n))
tmp1 <- sapply(col2rgb("orange")/255, function(x) 1-mm*(1-x))
tmp2 <- sapply(col2rgb("cyan")/255, function(x) 1-rotate(mm)*(1-x))
tmp3 <- sapply(col2rgb("purple")/255, function(x) 1-rotate(rotate(mm))*(1-x))
tmp4 <- sapply(col2rgb("grey")/255, function(x) 1-rotate(rotate(rotate(mm)))*(1-x))

tmp <- (tmp1*tmp2*tmp3*tmp4)
grid.raster(matrix(rgb(tmp), nrow = n))

result plot

Enwomb answered 2/5, 2018 at 5:25 Comment(0)

© 2022 - 2024 — McMap. All rights reserved.