R help - Jun 2009 - gradient fill of a grid.polygon

Dear list,

Following a recent enquiry, I've been playing with the idea of creating a
colour gradient for a polygon, using the Grid package. The idea is to draw a
number of stripes of different colours, using the grid.clip function. Below
is my current attempt at this,


library(grid)

rotate.polygon <- function(g, angle=0){ # utility function, works fine

matR <- matrix(c(cos(angle), -sin(angle), sin(angle), cos(angle)),
        nrow = 2)
gravity.x = unit(mean(g$x),"npc")
gravity.y = unit(mean(g$y),"npc")

x.center = convertX(g$x - gravity.x ,"npc",TRUE)
y.center = convertY(g$y - gravity.y ,"npc",TRUE)

new.xy <- matrix(c(x.center, y.center),
                ncol=2) %*% matR

    editGrob(g, x=unit(new.xy[,1],"npc") + gravity.x,
                y=unit(new.xy[,2],"npc") + gravity.y)
}


gradient.polygon <- function(g, n=100,
 cols=colorRampPalette(c("#E41A1C", "#377EB8",
"#4DAF4A", "#984EA3"))(n),
 alpha=0.5,
 stripe=FALSE, angle=0){

vp = viewport(angle = angle)
g =  rotate.polygon(g, - angle)

gx <- grobWidth(g)
gy <- grobHeight(g)

dx <- unit(convertX(gx, "npc", valueOnly = TRUE)/(n-1),
"npc") # width of
the stripes

startx <- min(g$x)
starty <- min(g$y)


for(ii in seq(1, n)){
 grid.clip(x= startx + (ii-1) * dx , y=starty,
           width= 1.0*dx, # fudge factor of 1.2 seems needed to overlap well
           height=gy,
           just="bottom")
if(stripe){
  if(ii%%2)# plotting only every other slice
grid.draw(editGrob(g, gp=gpar(fill=cols[ii], col=cols[ii], alpha=alpha)))
}else{
grid.draw(editGrob(g, gp=gpar(fill=cols[ii], col=cols[ii], alpha=alpha)))
    }
}

}

g <-
polygonGrob(x=c(0, 0.5, 1), y=c(0.5, 1, 0.5), gp=gpar(fill=NA,
col="grey90"))
g2 <-
polygonGrob(x=c(0, 0.5, 1), y=c(0.5, 0, 0.5), gp=gpar(fill=NA,
col="grey90"))

grid.rect(gp=gpar(fill="black"))
grid.rect(y=1, gp=gpar(fill="white"))
gradient.polygon(g)
gradient.polygon(g2)


Now, I have a (large) number of issues here,

1) the stripes don't exactly blend well, at least on the quartz device. I
can add a "fudge factor" for their width but then the overlap might be
visible if alpha is not unity.

2) a serious flaw is the rotation that's not working at the moment. My
initial thought was to rotate the grob (triangle here), paint it with the
gradient, and plot the result in a rotated viewport with opposite rotation
angle. I'm still hopeful it might work, but see 3).

3) each stripe is directly plotted, as opposed to saved as a grob. I tried
to use either a gList or a gTree to store the output of the for loop, but I
didn't understand why the result wouldn't appear on screen with
grid.draw.
What's the best structure to hold together these different slices? It is
presumably this object that I should be plotting eventually in the right
orientation.


Sorry for the length of this email, I hope it's clear with the code above.


Best regards,

baptiste

	[[alternative HTML version deleted]]

Following up on my previous post.

I've managed to have the function return a gList rather than plot everything
directly, but I get a rather obscure error message when I try to wrap the
grobs in a gTree with a rotated viewport,

Error in x$children[[i]] : attempt to select less than one element

however the same syntax works for simpler gTree such as,

g <-
polygonGrob(x=c(0, 0.5, 1), y=c(0.5, 1, 0.5), gp=gpar(fill=NA,
col="grey90"))
gg <- gTree(children=gList(gList(clipGrob(), g)))
grid.draw(gg)

Any idea?

Below is the new code,

library(grid)

rotate.polygon <- function(g, angle=0){

matR <- matrix(c(cos(angle), -sin(angle), sin(angle), cos(angle)),
        nrow = 2)
gravity.x = unit(mean(g$x),"npc")
gravity.y = unit(mean(g$y),"npc")

x.center = convertX(g$x - gravity.x ,"npc",TRUE)
y.center = convertY(g$y - gravity.y ,"npc",TRUE)

new.xy <- matrix(c(x.center, y.center),
                ncol=2) %*% matR

    editGrob(g, x=unit(new.xy[,1],"npc") + gravity.x,
                y=unit(new.xy[,2],"npc") + gravity.y)
}


gradient.polygon <- function(g, n=10,
 cols=colorRampPalette(c("#E41A1C", "#377EB8",
"#4DAF4A", "#984EA3"))(n),
alpha=0.5,
 stripe=FALSE, angle=pi/3){

gx <- grobWidth(g)
gy <- grobHeight(g)

dx <- unit(convertX(gx, "npc", valueOnly = TRUE)/(n-1),
"npc")

startx <- min(g$x)
starty <- min(g$y)

vp = viewport(angle = angle)
g =  rotate.polygon(g, - angle)
g.all <- gList()
for(ii in seq(1, n)){
clip.tmp <- clipGrob(x= startx + (ii-1) * dx , y=starty,
           width= 1.0*dx, # fudge factor to overlap well
           height=gy,
           just="bottom")
if(stripe){
  if(ii%%2)# testing with every other masked
g.tmp <- editGrob(g, gp=gpar(fill=cols[ii], col=cols[ii], alpha=alpha))
}else{
g.tmp <- editGrob(g, gp=gpar(fill=cols[ii], col=NA,lwd=0, alpha=alpha))
    }
g.all[[ii]] <- gList(clip.tmp, g.tmp)

}
## return(gTree(children=g.all, vp=vp)) # this fails

g.all # simply return the gList for now
}

g <-
polygonGrob(x=c(0, 0.5, 1), y=c(0.5, 1, 0.5), gp=gpar(fill=NA,
col="grey90"))

g4 <- gradient.polygon(g)

grid.draw(g4) # fine but not in the correct orientation

g6 <- gTree(children=g4, vp=viewport(angle=30))
grid.draw(g6)
# Error in x$children[[i]] : attempt to select less than one element
grid.ls(g6) # looks similar to the minimal example of above

	[[alternative HTML version deleted]]