Tyler Rinker
Tyler Rinker

Reputation: 109874

Plot gradient circles

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.

Upvotes: 10

Views: 1562

Answers (4)

jbaums
jbaums

Reputation: 27388

And here's an approach using sp and rgeos (similar application here and here).

library(sp)
library(rgeos)
library(raster)
  1. 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)
    
  2. Step through the polygons and extract their bounding boxes.

    bb <- sapply(b@polygons, bbox)
    bb2 <- sapply(b2@polygons, bbox)
    
  3. 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)))
    
  4. 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)
    
  5. 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

Upvotes: 2

thelatemail
thelatemail

Reputation: 93813

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

Upvotes: 9

Greg Snow
Greg Snow

Reputation: 49640

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.

Upvotes: 3

Carl Witthoft
Carl Witthoft

Reputation: 21502

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 ([email protected]) ; I forget exactly where the R-package resides on hte web.

Upvotes: 2

Related Questions