Question

我正在尝试使用渐变圆重现一个Stephen Few图形，该图形演示了从上方出现光线的硬连线假设。以下是圈子：

enter image description here

我该如何重新创建？绘制圆圈并不算太糟糕，但添加渐变是我被抛出的地方。我认为网格可能会创造更清晰的东西，但这可能是我的误解。

这是绘制圆圈的开始：

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

相关问题：How to use R to build bubble charts with gradient fills

修改

以为我会分享结果： enter image description here

here's the code。

Answer 1

重复使用clip，你就可以到达那里。

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

结果：

enter image description here

编辑（作者Tyler Rinker）：

我想添加用于复制图像的其余代码：

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

以下是使用栅格和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)

可以通过稍微改变数学来制作其他阴影方向。

Answer 3

您可以使用（不在CRAN上）软件包zernike来执行此操作。它被设计用于产生与Zernike多项式相关的各种图像，大量用于光学和光学。天文系统。您想要的图像几乎是Zernike的第二个术语。

作者是作者：M.L。 Peck（mpeck1@ix.netcom.com）;我忘记了R-package在网站上的确切位置。

Answer 4

这是一种使用sp和rgeos的方法（类似的应用here和here）。

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

通过缓冲点创建两组9个圆圈，然后绘制它们的联合以设置绘图区域。

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)

逐步浏览多边形并提取其边界框。

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

绘制堆叠的段以模拟渐变。

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

区分SpatialPolygon个对象的并集，并绘制差异多边形以遮盖非圆形区域。

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

对于奖励圆圈的平滑度，再次绘制圆圈，颜色等于背景颜色。
```
plot(gUnion(b, b2), border='gray80', lwd=2, add=TRUE)
```

gradient bubbles

绘制渐变圆

4 个答案: