Plot gradient circles - r

Question

I am attempting to reproduce a Stephen Few graphic with gradient circles that demonstrates the hard wired assumption that light appears from above. Here are the circles:
How can I recreate this? Drawing the circles isn't too bad but adding gradient is where I get thrown. I am thinking grid may create something more crisp but this may be a misconception I have.
Here is the start with drawing circles:
## John Fox circle function
source("http://dl.dropboxusercontent.com/u/61803503/wordpress/circle_fun.txt")
par(mar=rep(1, 4), bg = "grey80")
plot.new()
for (i in seq(0, 1, by = .2)) {
for (j in seq(.6, 1, by = .1)) {
circle(i, j, .5, "cm", , 1)
}
}
Related question: How to use R to build bubble charts with gradient fills
EDIT:
Thought I'd share the results:
And here's the code.

Answer 1

With some repeated use of clip, you can get there.
# set up a blank plot
par(mar=rep(0, 4))
par(bg="#cccccc")
plot(NA,xlim=0:1,ylim=0:1)
# define a function
grad.circ <- function(centrex,centrey,radius,col,resolution) {
colfunc <- colorRampPalette(col)
shades <- colfunc(resolution)
for (i in seq_along(shades) ) {
clip(
centrex - radius,
centrex + radius,
(centrey + radius) - ((i-1) * (radius*2)/length(shades)),
(centrey + radius) - (i * (radius*2)/length(shades))
)
symbols(
centrex,
centrey,
circles=radius,
bg=shades[i],
fg=NA,
add=TRUE,
inches=FALSE
)
}
}
# call the function
grad.circ(0.5,0.5,0.5,c("black", "white"),300)
Result:
EDIT (by Tyler Rinker):
I wanted to add the rest of the code I used to replicate the image:
FUN <- function(plot = TRUE, cols = c("black", "white")) {
plot(NA, xlim=0:1, ylim=0:1, axes=FALSE)
if (plot) {
grad.circ(0.5, 0.5, 0.5, cols, 300)
}
}
FUN2 <- function(){
lapply(1:3, function(i) FUN(,c("white", "black")))
FUN(F)
lapply(1:3, function(i) FUN())
}
X11(10, 4.5)
par(mfrow=c(3, 7))
par(mar=rep(0, 4))
par(bg="gray70")
invisible(lapply(1:3, function(i) FUN2()))

Answer 2

Here is a version using rasters and rasterImage:
image <- as.raster( matrix( seq(0,1,length.out=1001), nrow=1001, ncol=1001) )
tmp <- ( row(image) - 501 ) ^2 + ( col(image) - 501 )^2
image[tmp > 500^2] <- NA
image2 <- as.raster( matrix( seq(1,0, length.out=1001), nrow=1001, ncol=1001) )
image2[ tmp > 500^2 ] <- NA
image3 <- row(image) + col(image)
image3 <- image3/max(image3)
image3[tmp>500^2] <- NA
image4 <- 1-image3
image3 <- as.raster(image3)
image4 <- as.raster(image4)
plot( 0:1, 0:1, type='n', asp=1,ann=FALSE,axes=FALSE)
rect(0,0,1,1, col='grey')
rasterImage(image, 0.2, 0.2, 0.3, 0.3)
rasterImage(image2, 0.6, 0.6, 0.7, 0.7)
rasterImage(image3, 0.6, 0.3, 0.7, 0.4)
rasterImage(image4, 0.3, 0.7, 0.4, 0.8)
Other directions of shading can be made by changing the math a little.

Answer 3

You can do this using the (not on CRAN) package zernike . It's designed to produce various images related to Zernike polynomials, heavily used in optics & astronomy systems. Your desired images are pretty much the second Zernike term.
The author is Author: M.L. Peck (mpeck1#ix.netcom.com) ; I forget exactly where the R-package resides on hte web.

Answer 4

And here's an approach using sp and rgeos (similar application here and here).
library(sp)
library(rgeos)
library(raster)
Create two sets of 9 circles by buffering points, then plot their union to set up the plotting area.
b <- gBuffer(SpatialPoints(cbind(rep(1:3, 3), rep(1:3, each=3))), TRUE,
width=0.45, quadsegs=100)
b2 <- gBuffer(SpatialPoints(cbind(rep(5:7, 3), rep(1:3, each=3))), TRUE,
width=0.45, quadsegs=100)
plot(gUnion(b, b2), border=NA)
Step through the polygons and extract their bounding boxes.
bb <- sapply(b#polygons, bbox)
bb2 <- sapply(b2#polygons, bbox)
Plot stacked segments to simulate a gradient.
segments(rep(bb[1,], each=1000),
mapply(seq, bb[2,], bb[4,], len=1000),
rep(bb[3,], each=1000), col=gray.colors(1000, 0))
segments(rep(bb2[1,], each=1000),
mapply(seq, bb2[2,], bb2[4,], len=1000),
rep(bb2[3,], each=1000), col=rev(gray.colors(1000, 0)))
Difference the union of the SpatialPolygon objects and plot the differenced polygon to mask out the non-circles areas.
plot(gDifference(as(extent(par('usr')), 'SpatialPolygons'), gUnion(b, b2)),
col='gray80', border='gray80', add=TRUE)
For bonus circle smoothness, plot the circles once more, with colour equal to the background colour.
plot(gUnion(b, b2), border='gray80', lwd=2, add=TRUE)