R - 绘制六边形镶嵌

Question

我想生成一些内部有六边形阵列的正方形图，如绘制的 here。我想绘制规则（几何规则）和异常六边形镶嵌，所以我认为 "sp" 包中的工具不会起作用。

下面是我尝试使用 owin 和 plot 进行正六边形镶嵌的尝试。

library(maptools)
library(spatstat)

twid <- 20
theight <-  20
sideL <- 2
rp1 <- (sideL/2)*sqrt(3)
rp2 <- 2*(sideL/2)*sqrt(3)
rp3 <- 3*sideL

    bx <- c(1:floor(twid/rp3))
    by <- c(1:floor(theight/rp3))
    hex_array1 <- list(bx)
    hex_array2 <- list(by)

    for(i in 1:ceiling(twid/rp3)){
        bx[i] <- list(x=c(0+rp3*i,1+rp3*i,3+rp3*i,4+rp3*i,3+rp3*i,1+rp3*i)) 
        by[i] <- list(y=c(rp1,rp2,rp2,rp1,0,0))
            hex_array1[i] <- bx[i]
            hex_array2[i] <- by[i]
    }

    har1 <- list(x=c(0,1,3,4,3,1), y=c(rp1,rp2,rp2,rp1,0,0))

    har2 <- list(x=hex_array1,y=hex_array2)


hexig <- owin(poly=list(list(x=c(0,twid,twid,0), y=c(0,0,theight,theight)),
                        har1, har2
                        )
                )
    plot(hexig)

但是，上面的代码似乎出错了，因为 har2 没有被正确地格式化为列表的列表。

以上显然仅适用于单行六边形，但我想一旦我得到第一行，我只需将单行包装在一个 for 循环中，为每一行添加一组 x 和 y 距离。我只是不知道如何格式化 har2 以便我可以直接将它插入 owin 的 poly 函数。

我愿意完全改变我完成上述操作的方式，我对 R 还是比较陌生，所以我肯定仍然不知道如何以最 efficient/elegant 的方式做事。我目前运行 R 版本 3.3.2 在 Win 10 x64 运行 RStudio V0.99.903

感谢任何帮助。

谢谢！

Answer 1

只做一个 hexbin 图然后覆盖着色可能更容易（并不是说直接绘制六边形镶嵌线不是一个有趣的编程练习）。例如，使用 ggplot2:

library(ggplot2)

dat = data.frame(x=runif(5000, 0,10), y=runif(5000,0,10))

# Basic plot
p = ggplot(dat, aes(x,y)) + 
  geom_hex(colour="black", fill="white", bins=10) +
  theme_minimal() + 
  guides(fill=FALSE) +
  scale_y_continuous(limits=c(-0.4,10.6)) +
  scale_x_continuous(limits=c(-0.4,10.6)) +
  theme(axis.text=element_blank(),
        axis.title=element_blank())

# Regular hexagons
p + coord_equal(ratio=1)

# 2:1 aspect ratio
p + coord_equal(ratio=2)

geom_hex只对笛卡尔坐标有效，所以这种方法只能产生不同纵横比的六边形，不能产生剪切或其他变形。

Answer 2

我认为 spatstat 正好有您要找的功能：hextess 和 affine.tess.

查看 affine.tess 的示例。这里是您可以执行的操作的示例（添加 trim = FALSE 以避免边界框）：

library(spatstat)
H <- hextess(square(5), 0.2)
plot(H)

shear <- matrix(c(1,0,0.6,1), 2, 2)
sH <- affine(H, shear)
plot(sH)

Answer 3

规模 = 1

规模 = 2

我写了一个 hexagon() 函数，它是一个基本的 graphics::polygon() 方法。只需弄清楚六边形的一些几何形状并将其映射到有意义的索引即可。这是我想出的：

index_i = 1, index_j=1六边形是左下六边形。它的最左边的顶点位于笛卡尔坐标 (0,opp)。它将在 y=0 线（x 轴）上齐平。
index_i = 2, index_j=1 六边形将与 index_i = 1, index_j=1 六边形（左下方）的右侧相邻。它会稍微升高。
index_i=1, index_j=2 将位于 index_i = 1, index_j=1 六边形的正上方（左下方）。
以这种方式递增 index_i 引用右侧的六边形（将 index_i 视为 x 坐标位置）并递增 index_j 引用上方的六边形（将 index_j 视为 y 坐标位置）。
scale 使它们变大或变小
通过 fill_color
将颜色传递给每个六边形
使用双 for 循环进行细分

library(RColorBrewer)
mypalette<-brewer.pal(5,"PuOr")[c(-1,-3)]
lwd.in<-1

hexagon<-function(index_i=1, index_j=1, scale=1, fill_color=sample(rev(mypalette)[2],1)){
  
  opp=tan(pi/3)*scale; 
  adj=1*scale;

  side_length <- sqrt(adj^2+opp^2)

vertex_a <- c(  0                ,   opp)
vertex_b <- c(adj                , 2*opp)
vertex_c <- c(adj+side_length    , 2*opp)
vertex_d <- c(adj+adj+side_length,   opp)
vertex_e <- c(  adj+side_length  , 0)
vertex_f <- c(adj                , 0)

cpoint <- c(adj+0.5*side_length,opp)


if( index_i %% 2 == 1){
  
  odds_up_to_index_i <- seq(1,index_i,by=2)
  
  key <- data.frame(      i = seq(from=0, by=3, length.out = length(odds_up_to_index_i)),
                    index_i = odds_up_to_index_i)
  
  i <- key$i[key$index_i == index_i]
  j <- 2*(index_j - 1)
  
  return_hex <-
    polygon(x = c(vertex_a[1],vertex_b[1],vertex_c[1],vertex_d[1],vertex_e[1],vertex_f[1]) + cpoint[1]*i,
            y = c(vertex_a[2],vertex_b[2],vertex_c[2],vertex_d[2],vertex_e[2],vertex_f[2]) + cpoint[2]*j,
            col=fill_color,
            lwd=lwd.in,
            border=sample(c("white","black")[1],1)
            
            
    )
}

if( index_i %% 2 == 0){
  
  i <- index_i - 1
  j <- 2*(index_j - 1)
  
  return_hex <-
    polygon(x = c(vertex_a[1],vertex_b[1],vertex_c[1],vertex_d[1],vertex_e[1],vertex_f[1]) + (cpoint[1]+0.5*side_length)*(i),
            y = c(vertex_a[2],vertex_b[2],vertex_c[2],vertex_d[2],vertex_e[2],vertex_f[2]) + cpoint[2]*(j+1),
            col=fill_color,
            lwd=lwd.in,
            border=sample(c("white","black")[1],1)
    )
  }
}

par(pty="s", mai=c(0,0,0,0)+0.1)
plot(NA,NA,xlim=c(0,200),ylim=c(0,200), axes = FALSE, xlab="", ylab="") ## if you adjust `opp` and `adj` from (7,4)
#box()
abline(v=0)
abline(h=0)

for(i in 1:100){
  for(j in 1:100){
    hexagon(index_i = i, index_j = j)
  }
}

hexagon(index_i = 1, index_j = 1)
hexagon(index_i = 1, index_j = 2)
hexagon(index_i = 1, index_j = 3)
hexagon(index_i = 1, index_j = 4)
hexagon(index_i = 1, index_j = 5)

hexagon(index_i = 2, index_j = 1)
hexagon(index_i = 2, index_j = 2)
hexagon(index_i = 2, index_j = 3)
hexagon(index_i = 2, index_j = 4)
hexagon(index_i = 2, index_j = 5)

hexagon(index_i = 3, index_j = 1)
hexagon(index_i = 3, index_j = 2)
hexagon(index_i = 3, index_j = 3)
hexagon(index_i = 3, index_j = 4)
hexagon(index_i = 3, index_j = 5)

hexagon(index_i = 4, index_j = 1)
hexagon(index_i = 4, index_j = 2)
hexagon(index_i = 4, index_j = 3)
hexagon(index_i = 4, index_j = 4)
hexagon(index_i = 4, index_j = 5)

hexagon(index_i = 5, index_j = 1)
hexagon(index_i = 5, index_j = 5)
hexagon(index_i = 6, index_j = 1)
hexagon(index_i = 6, index_j = 4)
hexagon(index_i = 7, index_j = 2)
hexagon(index_i = 7, index_j = 3)
hexagon(index_i = 7, index_j = 4)

## Infected: color, white border
hexagon(index_i = 5, index_j = 3, fill_color=rev(mypalette)[3])
## Vaccinated:  deeper color, black border (nah, just white)
hexagon(index_i = 5, index_j = 2, fill_color=rev(mypalette)[1])
hexagon(index_i = 6, index_j = 3, fill_color=rev(mypalette)[1])
hexagon(index_i = 6, index_j = 2, fill_color=rev(mypalette)[1])
hexagon(index_i = 5, index_j = 4, fill_color=rev(mypalette)[1])
hexagon(index_i = 4, index_j = 2, fill_color=rev(mypalette)[1])
hexagon(index_i = 4, index_j = 3, fill_color=rev(mypalette)[1])



## Infected: color, white border
hexagon(index_i = 20, index_j = 20, fill_color=rev(mypalette)[3])
## Vaccinated:  deeper color, black border (nah, just white)
hexagon(index_i = 20, index_j = 19, fill_color=rev(mypalette)[1])
hexagon(index_i = 20, index_j = 21, fill_color=rev(mypalette)[1])

hexagon(index_i = 19, index_j = 20, fill_color=rev(mypalette)[1])
hexagon(index_i = 19, index_j = 21, fill_color=rev(mypalette)[1])

hexagon(index_i = 21, index_j = 20, fill_color=rev(mypalette)[1])
hexagon(index_i = 21, index_j = 21, fill_color=rev(mypalette)[1])



par(pty="s", mai=c(0,0,0,0)+0.1)
plot(NA,NA,xlim=c(0,200),ylim=c(0,200), axes = FALSE, xlab="", ylab="") ## if you adjust `opp` and `adj` from (7,4)
#box()
abline(v=0)
abline(h=0)

scale.in <- 2

for(i in 1:100){
  for(j in 1:100){
    hexagon(index_i = i, index_j = j, scale=scale.in)
  }
}

hexagon(index_i = 1, index_j = 1, scale=scale.in)
hexagon(index_i = 1, index_j = 2, scale=scale.in)
hexagon(index_i = 1, index_j = 3, scale=scale.in)
hexagon(index_i = 1, index_j = 4, scale=scale.in)
hexagon(index_i = 1, index_j = 5, scale=scale.in)

hexagon(index_i = 2, index_j = 1, scale=scale.in)
hexagon(index_i = 2, index_j = 2, scale=scale.in)
hexagon(index_i = 2, index_j = 3, scale=scale.in)
hexagon(index_i = 2, index_j = 4, scale=scale.in)
hexagon(index_i = 2, index_j = 5, scale=scale.in)

hexagon(index_i = 3, index_j = 1, scale=scale.in)
hexagon(index_i = 3, index_j = 2, scale=scale.in)
hexagon(index_i = 3, index_j = 3, scale=scale.in)
hexagon(index_i = 3, index_j = 4, scale=scale.in)
hexagon(index_i = 3, index_j = 5, scale=scale.in)

hexagon(index_i = 4, index_j = 1, scale=scale.in)
hexagon(index_i = 4, index_j = 2, scale=scale.in)
hexagon(index_i = 4, index_j = 3, scale=scale.in)
hexagon(index_i = 4, index_j = 4, scale=scale.in)
hexagon(index_i = 4, index_j = 5, scale=scale.in)

hexagon(index_i = 5, index_j = 1, scale=scale.in)
hexagon(index_i = 5, index_j = 5, scale=scale.in)
hexagon(index_i = 6, index_j = 1, scale=scale.in)
hexagon(index_i = 6, index_j = 4, scale=scale.in)
hexagon(index_i = 7, index_j = 2, scale=scale.in)
hexagon(index_i = 7, index_j = 3, scale=scale.in)
hexagon(index_i = 7, index_j = 4, scale=scale.in)

## Infected: color, white border
hexagon(index_i = 5, index_j = 3, scale=scale.in, fill_color=rev(mypalette)[3])
## Vaccinated:  deeper color, black border (nah, just white)
hexagon(index_i = 5, index_j = 2, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 6, index_j = 3, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 6, index_j = 2, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 5, index_j = 4, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 4, index_j = 2, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 4, index_j = 3, scale=scale.in, fill_color=rev(mypalette)[1])



## Infected: color, white border
hexagon(index_i = 20, index_j = 20, scale=scale.in, fill_color=rev(mypalette)[3])
## Vaccinated:  deeper color, black border (nah, just white)
hexagon(index_i = 20, index_j = 19, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 20, index_j = 21, scale=scale.in, fill_color=rev(mypalette)[1])

hexagon(index_i = 19, index_j = 20, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 19, index_j = 21, scale=scale.in, fill_color=rev(mypalette)[1])

hexagon(index_i = 21, index_j = 20, scale=scale.in, fill_color=rev(mypalette)[1])
hexagon(index_i = 21, index_j = 21, scale=scale.in, fill_color=rev(mypalette)[1])

R - 绘制六边形镶嵌

R - Plotting Hexagon Tessellations

plot

r

hexagonal-tiles

tesselation

spatstat

规模 = 1

规模 = 2