为图像/等高线图添加点画

时间:2012-07-31 09:26:40

标签: r plot ggplot2 lattice

有一些数据我想添加“点画”以显示它“重要”的位置,就像它们在IPCC图中所做的那样

http://www.ipcc.ch/graphics/ar4-wg1/jpg/fig-10-18.jpg

目前我正在努力尝试在R中这样做。

如果我编制一些测试数据并绘制它:

data <- array(runif(12*6), dim=c(12,6) )
over <- ifelse(data > 0.5, 1, 0 )
image(1:12, 1:6, data)

我最终要做的是根据当前图像上方的“over”数组过度绘制一些点。

任何建议!??

4 个答案:

答案 0 :(得分:8)

这应该有所帮助 - 我以前做过类似的事情并编写了一个我发布here的函数。

#required function from www.menugget.blogspot.com
matrix.poly <- function(x, y, z=mat, n=NULL){
 if(missing(z)) stop("Must define matrix 'z'")
 if(missing(n)) stop("Must define at least 1 grid location 'n'")
 if(missing(x)) x <- seq(0,1,,dim(z)[1])
 if(missing(y)) y <- seq(0,1,,dim(z)[2])
 poly <- vector(mode="list", length(n))
 for(i in seq(length(n))){
  ROW <- ((n[i]-1) %% dim(z)[1]) +1
  COL <- ((n[i]-1) %/% dim(z)[1]) +1

  dist.left <- (x[ROW]-x[ROW-1])/2
  dist.right <- (x[ROW+1]-x[ROW])/2
  if(ROW==1) dist.left <- dist.right
  if(ROW==dim(z)[1]) dist.right <- dist.left

  dist.down <- (y[COL]-y[COL-1])/2
  dist.up <- (y[COL+1]-y[COL])/2
  if(COL==1) dist.down <- dist.up
  if(COL==dim(z)[2]) dist.up <- dist.down

  xs <- c(x[ROW]-dist.left, x[ROW]-dist.left, x[ROW]+dist.right, x[ROW]+dist.right)
  ys <- c(y[COL]-dist.down, y[COL]+dist.up, y[COL]+dist.up, y[COL]-dist.down)
  poly[[i]] <- data.frame(x=xs, y=ys)
 }
 return(poly)
}

#make vector of grids for hatching
incl <- which(over==1)

#make polygons for each grid for hatching
polys <- matrix.poly(1:12, 1:6, z=over, n=incl)

    #plot
png("hatched_image.png")
image(1:12, 1:6, data)
for(i in seq(polys)){
    polygon(polys[[i]], density=10, angle=45, border=NA)
    polygon(polys[[i]], density=10, angle=-45, border=NA)
}
box()
dev.off()

enter image description here

或者,替代“点画”:

png("hatched_image2.png")
image(1:12, 1:6, data)
for(i in seq(polys)){
    xran <- range(polys[[i]]$x)
    yran <- range(polys[[i]]$y)
    xs <- seq(xran[1], xran[2],,5)
    ys <- seq(yran[1], yran[2],,5)
    grd <- expand.grid(xs,ys)
    points(grd, pch=19, cex=0.5)
}
box()
dev.off()

enter image description here

更新

在对Paul Hiemstra的评论(非常晚)的回应中,这里有两个具有更高分辨率矩阵的例子。孵化保持了一个很好的规则模式,但是在分解时看起来并不好看。点画的例子更好:

n <- 100
x <- 1:n
y <- 1:n
M <- list(x=x, y=y, z=outer(x, y, FUN = function(x,y){x^2 * y * rlnorm(n^2,0,0.2)}))
image(M)
range(M$z)
incl <- which(M$z>5e5)

polys <- matrix.poly(M$x, M$y, z=M$z, n=incl)

png("hatched_image.png", height=5, width=5, units="in", res=400)
op <- par(mar=c(3,3,1,1))
image(M)
for(i in seq(polys)){
  polygon(polys[[i]], density=10, angle=45, border=NA, lwd=0.5)
  polygon(polys[[i]], density=10, angle=-45, border=NA, lwd=0.5)
}
box()
par(op)
dev.off()

enter image description here

png("stippled_image.png", height=5, width=5, units="in", res=400)
op <- par(mar=c(3,3,1,1))
image(M)
grd <- expand.grid(x=x, y=y)
points(grd$x[incl], grd$y[incl], pch=".", cex=1.5)
box()
par(op)
dev.off()

enter image description here

答案 1 :(得分:3)

这是@mdsummer使用ggplot2评论精神的解决方案。我首先绘制网格,然后在超出某个值的位置绘制+。请注意,ggplot2适用于data.frame,而不适用于多维数组或矩阵。您可以使用melt包中的reshape将数组/ marix转换为data.frame平面结构。

以下是使用geom_tile文档中的示例数据的具体示例:

pp <- function (n,r=4) { 
 x <- seq(-r*pi, r*pi, len=n) 
 df <- expand.grid(x=x, y=x) 
 df$r <- sqrt(df$x^2 + df$y^2) 
 df$z <- cos(df$r^2)*exp(-df$r/6) 
 df 
} 

require(ggplot2)
dat = pp(200)
over = dat[,c("x","y")]
over$value = with(dat, ifelse(z > 0.5, 1, 0))
ggplot(aes(x = x, y = y), data = dat) + 
   geom_raster(aes(fill = z)) + 
   scale_fill_gradient2() +
   geom_point(data = subset(over, value == 1), shape = "+", size = 1)

enter image description here

答案 2 :(得分:3)

使用?image [1]的坐标定位机制来做。

data(volcano)
m <- volcano
dimx <- nrow(m)
dimy <- ncol(m)

d1 <- list(x = seq(0, 1, length = dimx), y = seq(0, 1, length = dimy), z = m)

通过这种方式构建“图像”,您可以将结构与对象及其对象保持在一起 坐标完整。您可以将多个矩阵收集到3D阵列中或作为多个矩阵 元素,但你需要扩充image()以便处理它,所以我保留它们 在这里分开。

制作数据副本以指定有趣的区域。

d2 <- d1
d2$z <- d2$z > 155

使用坐标指定哪些单元格有趣。如果你有一个非常大的光栅,这是昂贵的,但它是非常容易做到的。

pts <- expand.grid(x = d2$x, y = d2$y)
pts$over <- as.vector(d2$z)

设置图表。

op <- par(mfcol = c(2, 1))
image(d1)

image(d1)
points(pts$x[pts$over], pts$y[pts$over], cex = 0.7)

par(op)

不要忘记修改点的绘制以获得不同的效果,特别是具有大量点的非常密集的网格将花费很长时间来绘制所有这些小圆圈。 pch = "."是个不错的选择。

现在,你有一些真实的数据可以在这个漂亮的投影上进行绘图吗?有关以下选项,请参阅此示例:http://spatial-analyst.net/wiki/index.php?title=Global_datasets

[1] R具有用于更复杂处理栅格数据的类,请参阅包sp和栅格 两种不同的方法。

答案 3 :(得分:2)

这可能为时已晚,但我也希望将我的答案作为参考发布。

空间数据的一个不错选择是使用rasterVis包。一旦你有一个“基础”光栅对象,以及你将用来绘制点画的“mask”对象,你可以做类似的事情:

g.fillOval(this.getWidth()/2,this.getHeight()/2,30,30);

类似于OP正在寻找的地图。可以微调诸如颜色,大小和类型之类的点的参数。 ?sp.points提供了可用于执行此操作的所有参数。