R - Plotting Hexagon Tessellations

Question

I'd like to generate some square plots that have arrays of hexagons inside of them, like drawn here. I'd like to plot both regular (geometrically regular) and abnormal hexagon tessellations, so I don't think tools from the "sp" package will work.

Below is my attempt at a regular hexagon tesselation using owin and 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)

However, the above seems to error out because har2 isn't formatted as a list of lists correctly.

The above is obviously only for a single row of hexagons but I figured once I got the first row I'd just wrap the single row in a for loop that added a set x and y distances for each row. I just can't figure out how to format har2 so that I can directly plug it into owin's poly function.

I'm open to completely changing the way I've done the above, I'm still relatively new to R so I definitely still don't know how to do things the most efficient/elegant way. I'm currently running R version 3.3.2 on Win 10 x64 running RStudio V0.99.903

Any help is appreciated.

Thank you!

Answer 1

scale = 1

scale = 2

I wrote a hexagon() function that is a base graphics::polygon() approach. Just had to figure out a little bit of the geometry of hexagons and map it to an indexing that made sense. This is what I came up with:

• The index_i = 1, index_j=1 hexagon is the lower left hexagon. It has its leftmost vertex at cartesian coordinate (0,opp). It will be flush on the y=0 line (x-axis).

• The index_i = 2, index_j=1 hexagon will be adjacent to the right from the index_i = 1, index_j=1 hexagon (lower left). It'll be slightly elevated.

• The index_i=1, index_j=2 will be right on top of the index_i = 1, index_j=1 hexagon (lower left).

• In this way incrementing index_i references hexagons to the right (think of index_i as the x-coordinate position) and incrementing index_j references hexagons above (think of index_j as the y-coordinate position).

• scale makes them bigger or smaller

• pass colors to each hexagon with fill_color

• Use a double for-loop to tessellate

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

Answer 2

I think spatstat has just the functions you are looking for: hextess and affine.tess.

Take a look at the examples for affine.tess. Here is an example of what you can do (add trim = FALSE to avoid the bounding box):

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

It might be easier to just do a hexbin plot and then override the coloring (not that it wouldn't be an interesting programming exercise to plot the hexagon tesselation lines directly). For example, using 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 only works with Cartesian coordinates, so this method can only produce hexagons with varying aspect ratios, but not shears or other distortions.