three-way color gradient fill in r

。_饼干妹妹 提交于 2019-11-28 04:24:01

Here is one way to do it - it's a bit of a hack, using points to plot the gradient piece by piece:

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

And the output:

Did you want to use these gradients to represent data? If so, it may be possible to alter d.red, d.green, and d.blue to do it - I haven't tested anything like that yet though. I hope this is somewhat helpful, but a proper solution using colorRamp, for example, will probably be better.

EDIT: As per baptiste's suggestion, this is how you would store the information in vectors and plot it all at once. It is considerably faster (especially with sm set to 500, for example):

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)

Here's a solution with a rasterized background image. The sharpness parameter of the tricol function controls how fast the colors fade to black. Setting it to 1 gives you Edward's colors and setting it to 2 gives you the colors below.

# 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")

What tricol() does is represent each corner i with a color (red, green, blue). It defines a matrix a of vectors from the corner to the points in pt and a vector b from the corner to the center of the opposite edge. It then projects a onto b and scales to get the relative distances = color intensity (and applies a small hack with sharpness to adjust the colors a bit). When it comes to problems like this simple algebra can work magic.

You get a litte noise around the edges due to aliasing, but you could probably tweak that away, or draw slightly wider lines in the triangle.

Here is an implementation I worked up for the phonR package... the fillTriangle function is not exported so you have to use the ::: operator to access it. Example shows both pch-based and raster-based approaches.

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

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!