r - R - 绘制六边形镶嵌

Question

我想生成一些里面有六边形数组的正方形图，就像在这里绘制的一样。我想绘制规则（几何规则）和异常六边形镶嵌，所以我不认为“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 还比较陌生，所以我绝对不知道如何以最有效/优雅的方式做事。我目前正在运行 RStudio V0.99.903 的 Win 10 x64 上运行 R 版本 3.3.2

任何帮助表示赞赏。

谢谢！

Answer 1

我认为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 2

只做一个六边形图然后覆盖着色可能更容易（并不是说直接绘制六边形镶嵌线不是一个有趣的编程练习）。例如，使用 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 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])