Plot gradient circles

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:

enter image description here

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: enter image description here

And here's the code.

Enough to retain the illusion but you can see the lines in the gradient above. — Tyler Rinker, Jun 27 '13 at 03:06
Perhaps you can create several rows of black-to-white gradients, then plot over them? This question on gradients: http://stackoverflow.com/questions/11070101/2d-color-gradient-plot-in-r — Ricardo Saporta, Jun 27 '13 at 03:08

score 9 · Accepted Answer · edited Jun 27 '13 at 13:56

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:

enter image description here

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

I've never seen clip used. I'm trying to extend this. How can I make the circles smaller? In other words what is controlling circle radius? — Tyler Rinker, Jun 27 '13 at 03:51
@TylerRinker - I have generalised the code now so hopefully it makes sense. — thelatemail, Jun 27 '13 at 03:59

score 3 · Answer 2 · answered Jun 27 '13 at 13:55

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.

score 2 · Answer 3 · answered Jun 27 '13 at 12:12

2

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.

answered Jun 27 '13 at 12:12

Carl Witthoft

20,573
9
43
73

Here's the link: http://wildlife-pix.com/rpackages/ but I couldn't apply it to this problem. And it was built pre R 3.0.0. – Tyler Rinker Jun 27 '13 at 12:58
@TylerRinker Thanks for finding it. I never build it; just use the R-functions included. – Carl Witthoft Jun 27 '13 at 13:36

score 2 · Answer 4 · edited May 23 '17 at 12:07

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

gradient bubbles

Looks very promising for smoothness. Where is the `extent` function from in step 4? — Tyler Rinker, Feb 16 '15 at 14:48

Plot gradient circles

4 Answers4

Linked