绘制渐变圆答案

【问题标题】：Plot gradient circles绘制渐变圆
【发布时间】：2013-06-24 09:41:45
【问题描述】：

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

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

这里是画圈的开始：

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

编辑：

我想我会分享结果：

还有here's the code。

【问题讨论】：

您需要渐变的平滑程度如何？
足以保留错觉但你可以看到上面渐变中的线条。
也许您可以创建几行黑白渐变，然后在上面绘制？这个关于渐变的问题：stackoverflow.com/questions/11070101/…

标签： r

【解决方案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)

结果：

编辑（由 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()))

【讨论】：

我从未见过使用过的剪辑。我正在尝试扩展它。我怎样才能使圆圈变小？换句话说，什么是控制圆半径？
@TylerRinker - 我现在已经概括了代码，希望它有意义。

【解决方案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)

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

【讨论】：

【解决方案3】：

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

作者是作者：M.L.啄 (mpeck1@ix.netcom.com) ;我忘记了 R 包在 hte web 上的确切位置。

【讨论】：

这是链接：wildlife-pix.com/rpackages 但我无法将其应用于此问题。它是在 R 3.0.0 之前构建的。
@TylerRinker 感谢您找到它。我从不建造它；只需使用包含的 R 函数。

【解决方案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)
```

【讨论】：

看起来很平滑。第 4 步中的 extent 函数在哪里？
@Tyler - raster ... 抱歉。
很好，工作得很好，故障也很好。