2012-08-02 2 views
20

Come posso riempire il gradiente di colore a tre vie (heatmap) su un triplo (trama triangolare), come questo.riempimento sfumatura a colori a tre vie r

plot(NA,NA,xlim=c(0,1),ylim=c(0,sqrt(3)/2),asp=1,bty="n",axes=F,xlab="",ylab="") 
segments(0,0,0.5,sqrt(3)/2) 
segments(0.5,sqrt(3)/2,1,0) 
segments(1,0,0,0) 

enter image description here

colore dovrebbe funzionare in parallelo a triplot.

risposta

22

Ecco un modo per farlo - è un po 'di hack, utilizzando i punti per tracciare il pezzo di pendenza per pezzo:

plot(NA,NA,xlim=c(0,1),ylim=c(0,1),asp=1,bty="n",axes=F,xlab="",ylab="") 
segments(0,0,0.5,sqrt(3)/2) 
segments(0.5,sqrt(3)/2,1,0) 
segments(1,0,0,0) 
# sm - how smooth the plot is. Higher values will plot very slowly 
sm <- 500 
for (y in 1:(sm*sqrt(3)/2)/sm){ 
    for (x in (y*sm/sqrt(3)):(sm-y*sm/sqrt(3))/sm){ 
     ## distance from base line: 
     d.red = y 
     ## distance from line y = sqrt(3) * x: 
     d.green = abs(sqrt(3) * x - y)/sqrt(3 + 1) 
     ## distance from line y = - sqrt(3) * x + sqrt(3): 
     d.blue = abs(- sqrt(3) * x - y + sqrt(3))/sqrt(3 + 1) 
     points(x, y, col=rgb(1-d.red,1 - d.green,1 - d.blue), pch=19) 
    } 
} 

E l'output:

enter image description here

Forse vuoi usare questi gradienti per rappresentare i dati? In tal caso, potrebbe essere possibile modificare d.red, d.green e d.blue per farlo - Non ho ancora provato nulla del genere. Spero che questo sia un po 'utile, ma una soluzione adeguata utilizzando colorRamp, ad esempio, sarà probabilmente migliore.

MODIFICA: Come suggerito da baptiste, questo è come memorizzare le informazioni in vettori e tracciare tutto in una volta. Si è notevolmente più veloce (in particolare con sm impostato a 500, per esempio):

plot(NA,NA,xlim=c(0,1),ylim=c(0,1),asp=1,bty="n",axes=F,xlab="",ylab="") 
sm <- 500 
x <- do.call(c, sapply(1:(sm*sqrt(3)/2)/sm, 
         function(i) (i*sm/sqrt(3)):(sm-i*sm/sqrt(3))/sm)) 
y <- do.call(c, sapply(1:(sm*sqrt(3)/2)/sm, 
         function(i) rep(i, length((i*sm/sqrt(3)):(sm-i*sm/sqrt(3)))))) 
d.red = y 
d.green = abs(sqrt(3) * x - y)/sqrt(3 + 1) 
d.blue = abs(- sqrt(3) * x - y + sqrt(3))/sqrt(3 + 1) 
points(x, y, col=rgb(1-d.red,1 - d.green,1 - d.blue), pch=19) 
+0

grazie per la grande soluzione ... c'è modo per iniziare a colore più scuro (rosso, verde e blu) in modo che aspetto gradiente più tagliente – jon

+1

Ho provato un paio di diversa cose per rendere il gradiente più nitido, ma non sono riuscito a trovare un modo che non rendesse le aree del grafico molto scure e opache. Stai bene con rosso, verde e blu a partire negli angoli? Se lo sei, prova a sostituire l'ultima riga di codice con 'punti (x, y, col = rgb (d.red, d.green, d.blue), pch = 19) '- i gradienti per questi tre colori sembrano più nitidi poiché non si mescolano così tanto con gli altri colori all'origine. – Edward

+2

perché tracci ogni punto individualmente? È possibile memorizzare un vettore di colori e tracciare tutti i punti contemporaneamente. – baptiste

14

Ecco una soluzione un'immagine di sfondo rasterizzata con. Il parametro sharpness della funzione tricol controlla la velocità di dissolvenza dei colori in nero. Impostarlo su 1 ti dà i colori di Edward e impostandolo su 2 ti dà i colori qui sotto.

# Coordinates of the triangle 
tri <- rbind(sin(0:2*2/3*pi), cos(0:2*2/3*pi)) 

# Function for calculating the color of a set of points `pt` 
# in relation to the triangle 
tricol <- function(pt, sharpness=2){ 
    require(splancs) 
    RGB <- sapply(1:3, function(i){ 
     a <- sweep(pt, 2, tri[,i]) 
     b <- apply(tri[,-i], 1, mean) - tri[,i] 
     sharpness*((a %*% b)/sum(b^2))-sharpness+1 
    }) 
    RGB[-inpip(pt,t(tri)),] <- 1 # Color points outside the triangle white 
    do.call(rgb, unname(as.data.frame(pmin(pmax(RGB, 0), 1)))) 
} 

# Plot 
res <- 1000       # Resolution 
xi <- seq(-1, 1, length=res)  # Axis points 
yi <- seq(-.8, 1.2, length=res) 
x <- xi[1] + cumsum(diff(xi))  # Midpoints between axis points 
y <- yi[1] + cumsum(diff(yi)) 
xy <- matrix(1:(length(x)*length(y)), length(x)) 
image(xi, yi, xy, col=tricol(as.matrix(expand.grid(x,y))), useRaster=TRUE) 
lines(tri[1,c(1:3,1)], tri[2,c(1:3,1)], type="l") 

Cosa tricol() fa è rappresentare ogni angolo i con un colore (rosso, verde, blu). Definisce una matrice a di vettori dall'angolo ai punti in pt e un vettore b dall'angolo al centro del bordo opposto. Quindi proietta a su b e ridimensiona per ottenere le distanze relative = intensità del colore (e applica una piccola modifica con sharpness per regolare leggermente i colori). Quando si tratta di problemi come questa semplice algebra può funzionare magicamente.

Si ottiene un leggero rumore intorno ai bordi a causa dell'aliasing, ma probabilmente è possibile modificarlo, o disegnare linee leggermente più larghe nel triangolo. Gradient triangle

+0

Stavo pensando a un'idea simile, ma con tre dischi (R, G, B) di raggio sul lato del triangolo, e un canale alfa che sfuma a 0. Credo che R farebbe quindi il colore mescolando automaticamente. – baptiste

+0

Sort of. Mostrerebbe però quale cerchio è stato disegnato sopra a quale altro. Diciamo che il rosso è in cima, poi verde, poi blu. Nel mezzo avresti il ​​50% di rosso, ma solo il 25% di verde (il 50% del rimanente 50%) e il 12,5% di blu. Praticamente tutti i diagrammi di Venn che ho visto ne soffrono, e una volta che l'ho visto non posso smettere di notarlo. [Prendi questi per esempio] (http://stackoverflow.com/questions/8713994/venn-diagram-in-r-proportional-and-color-shading-possible-semi-transparency-sup). – Backlin

1

Ecco un'implementazione ho lavorato su per il pacchetto phonR ... la funzione fillTriangle non viene esportata in modo da avere per utilizzare l'operatore ::: per accedervi. L'esempio mostra approcci basati su pch e raster.

# set up color scale 
colmap <- plotrix::color.scale(x=0:100, cs1=c(0, 180), cs2=100, cs3=c(25, 100), 
           alpha=1, color.spec='hcl') 
# specify triangle vertices and corner colors 
vertices <- matrix(c(1, 4, 2, 1, 3, 4, length(colmap), 1, 30), nrow=3, 
        dimnames=list(NULL, c("x", "y", "z"))) 
# edit next line to change density/resolution 
xseq <- yseq <- seq(0, 5, 0.01) 
grid <- expand.grid(x=xseq, y=yseq) 
grid$z <- NA 
grid.indices <- splancs::inpip(grid, vertices[,1:2], bound=FALSE) 
grid$z[grid.indices] <- with(grid[grid.indices,], 
          phonR:::fillTriangle(x, y, vertices)) 
# plot it 
par(mfrow=c(1,2)) 
# using pch 
with(grid, plot(x, y, col=colmap[round(z)], pch=16)) 
# overplot original triangle 
segments(vertices[,1], vertices[,2], vertices[c(2,3,1),1], 
     vertices[c(2,3,1),2]) 
points(vertices[,1:2], pch=21, bg=colmap[vertices[,3]], cex=2) 

# using raster 
image(xseq, yseq, matrix(grid$z, nrow=length(xseq)), col=colmap) 
# overplot original triangle 
segments(vertices[,1], vertices[,2], vertices[c(2,3,1),1], 
     vertices[c(2,3,1),2]) 
points(vertices[,1:2], pch=21, bg=colmap[vertices[,3]], cex=2) 

example graphs of gradient triangle filling