Diagramma con gradiente di colore 2D in R

Question

Voglio produrre un rettangolo con sfumatura di colore 2d come quelli nell'immagine in basso a destra. Come posso farlo in R? Usando colorRamp o RColorBrewer o altre funzioni/pacchetti posso produrre belle rampe dolor 1D. Ma come faccio questo per 2D includendo diversi colori negli angoli, come per es. il rettangolo in alto a destra?

Quello che voglio ottenere è per esempio i seguenti due tipi: gradiente

BTY: Sono completamente dimenticato di dire che ho trovato il grafico sopra here (prodotto da Luca Fenu).

Answer 1

Grazie per commentando il mio post - Sono contento che hanno generato qualche discussione. Ecco un codice minimo per ottenere i grafici in alto a destra - Sono sicuro che ci sono altri modi più efficienti per farlo ... Ma questo funziona senza bisogno di altre librerie, e dovrebbe essere abbastanza facile da seguire ... puoi cambiamento saturazione e alpha blending, giocando con le variabili max_sat e alpha_default ...

#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! 

Answer 2

Prova questo:

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) 

Avrete bisogno di trovare quale funzione descrive il gradiente di colore che si desidera (ho usato onde sinusoidali per l'illustrazione).

Edit: interpolazione lineare tra 4 angoli

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) 

Edit 2: Quando la funzione non è separabile, utilizzare esterno,

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) 

Si può anche fare il colore di miscelazione direttamente all'interno della funzione, invece di valori di mappatura ad una scala di colori in seguito,

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) 

Answer 3

sono certo c'è un più elegante modo per farlo. Ad ogni modo, ecco qua: l'ultima riga è una ricreazione piuttosto ravvicinata della tua immagine originale nella domanda.

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')))