Plot gradient circles

Question

Sto tentando di riprodurre un'immagine di Stephen Few con cerchi sfumati che dimostra l'ipotesi del fatto che la luce appaia dall'alto. Qui ci sono i cerchi:

Come posso ricreare questo? Disegnare i cerchi non è poi così male, ma aggiungere il gradiente è il punto in cui mi butto. Sto pensando che la griglia possa creare qualcosa di più nitido, ma questo potrebbe essere un equivoco che ho.

Ecco l'inizio con i cerchi di disegno:

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

questione connessa: How to use R to build bubble charts with gradient fills

EDIT:

ho pensato di condividere i risultati:

E here's the code.

Answer 1

Con un uso ripetuto di clip, è possibile arrivarci.

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

Risultato:

EDIT (da Tyler Rinker):

ho voluto aggiungere il resto del codice che ho usato per replicare l'immagine:

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

È possibile farlo utilizzando il pacchetto (non su CRAN) zernike. È progettato per la produzione di varie immagini relative ai polinomi di Zernike, molto utilizzate nell'ottica dei sistemi di astronomia &. Le tue immagini desiderate sono praticamente il secondo termine di Zernike.

L'autore è autore: M.L. Peck (mpeck1@ix.netcom.com); Ho dimenticato esattamente dove si trova il pacchetto R su hte web.

Answer 3

Ecco una versione con raster e 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) 

Altre direzioni di ombreggiatura possono essere effettuate cambiando la matematica un po '.

Answer 4

Ed ecco un approccio utilizzando sp e rgeos (applicazione simile here e here).

library(sp) 
library(rgeos) 
library(raster) 

1. Creare due gruppi di 9 cerchi da punti di buffering, quindi tracciano la loro unione per impostare l'area di plottaggio.

   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. Attraversare i poligoni ed estrarre i relativi riquadri di delimitazione.

   bb <- sapply(b@polygons, bbox) 
   bb2 <- sapply(b2@polygons, bbox) 
   

3. Tracciare segmenti accatastati per simulare un gradiente.

   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. Differenza l'unione dei SpatialPolygon oggetti e tracciare il poligono differenziata per mascherare le aree non cerchi.

   plot(gDifference(as(extent(par('usr')), 'SpatialPolygons'), gUnion(b, b2)), 
       col='gray80', border='gray80', add=TRUE) 
   

5. Per bonus cerchio scorrevolezza, tracciare i cerchi ancora una volta, con il colore uguale al colore di sfondo.

   plot(gUnion(b, b2), border='gray80', lwd=2, add=TRUE)