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的多功能。

我愿意完全改变我做上述事情的方式，我对R还是比较陌生的，所以我仍然不知道如何用最有效、最优雅的方式来做事情。我目前在Win 10 x64上运行RVersion3.3.2，运行RStudio V0.99.903

任何帮助都是非常感谢的。

谢谢!

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将颜色传递给每个六边形
• 使用双循环进行上诉。

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])