10

我正在尝试使用渐变圆圈重现 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)
    }
}

相关问题：如何使用 R 构建带有渐变填充的气泡图

编辑：

以为我会分享结果： 在此处输入图像描述

这是代码。

4

4 回答 4

9

通过一些重复使用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)

结果：

在此处输入图像描述

编辑（由泰勒林克）：

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

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()))
于 2013-06-27T03:39:09.183 回答
3

这是一个使用栅格和 的版本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)

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

于 2013-06-27T13:55:22.260 回答
2

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

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

于 2013-06-27T12:12:31.673 回答
2

这是一种使用spand的方法rgeos（类似的应用程序在这里和这里）。

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

  1. 通过缓冲点创建两组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)

  2. 遍历多边形并提取它们的边界框。

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

  3. 绘制堆叠段以模拟渐变。

    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. 差分SpatialPolygon对象的并集并绘制差分多边形以屏蔽非圆形区域。

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

  5. 对于额外的圆平滑度，再次绘制圆，颜色等于背景颜色。

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

渐变气泡

于 2015-02-16T13:28:22.047 回答