R Notebook

library(sp)
library(ggplot2)

Objective

Create a diagram of tessellated hexagons the ranks hexagon tiles based on their distance from the centre.

Data

Dummy data

set.seed(123)
df <- dplyr::tibble(
  id = 1:40, 
  group = c(rep(1, 4), rep(2, 4), rep(3, 12), rep(4, 20)), 
  org = sample(c("A", "B", "C", "D"), 40, TRUE, c(0.5, 0.2, 0.2, 0.1))
  )

df |>
  dplyr::group_by(org) |>
  dplyr::count()

Method

Create a grid of hexagon

dx <- ceiling(sqrt(nrow(df)))
dy <- dx

## Helper functions
deg2rad <- function(deg) {(deg * pi) / (180)} # Function to convert degrees to radians 
hex_side <- function(area) {(3^0.25)*sqrt(2*(area/9))} # Get the length of a side of hexagon for a given area
hex_area <- function(side) ((3*sqrt(3))/2*side) # Get the area of a hexagon given its side length

# Function to draw a hexagon
draw_hex <- function(area=hex_area(1), offset_x = 0, offset_y = 0, id=1, tessellate=F){
  side_length <- hex_side(area)
  A <- sin(deg2rad(30)) * side_length
  B <- sin(deg2rad(60)) * side_length
  C <- side_length
  
  (x <- c(0, 0, B, 2*B, 2*B, B) + (offset_x*B*2) + ifelse(tessellate == T,  B, 0))
  (y <- c(A+C, A, 0, A, A+C, 2*C) + (offset_y*(A+C)))
  
  
  sp::Polygons(list(sp::Polygon(coords = matrix(c(x,y),ncol=2),hole = F)),ID=id)
}


# Draw a grid of hexagon tiles
draw_hexTiles <- function(area, offset_x_start=0, offset_x_end=4, offset_y_start=0, offset_y_end =4){
  grid <- expand.grid(offset_x_start:offset_x_end, offset_y_start:offset_y_end)
  grid$tessellate <- grid[,2] %% 2 == 0
  
  hexes <- sp::SpatialPolygons(lapply(1:nrow(grid), function(i){
    draw_hex(area, offset_x = grid[i,1], offset_y = grid[i,2], id =i, tessellate = grid[i,3])
    
  }))
  
  names(grid) <- c("offset_x", "offset_y", "tessellate")
  
  grid <- data.frame(id = 1:nrow(grid),grid)
  
  sp::SpatialPolygonsDataFrame(hexes, grid)
}


cellsize <- 1
C <- hex_side(cellsize)
A <- sin(deg2rad(30)) * C
B <- sin(deg2rad(60)) * C

hexAcross <- dx
hexUp <- dy

offset_x_start <- 0
offset_y_start <- 0
offset_x_end <- offset_x_start + hexAcross
offset_y_end <- offset_y_start + hexUp

hex_grid <- draw_hexTiles(
  cellsize, offset_x_start, offset_x_end, 
  offset_y_start, offset_y_end
  )

plot(hex_grid)

length(hex_grid)

## [1] 64

Calculate the distance of each tile from the centre.

# Get the centre hex
grid_centre <- rgeos::gCentroid(hex_grid)
hex_grid_centre_id <- over(grid_centre, hex_grid)$id
hex_grid_centre <- hex_grid[hex_grid@data$id == hex_grid_centre_id ,]

# get centroids of hexes
hex_grid_centroids <- rgeos::gCentroid(hex_grid, byid = TRUE) |> 
  as.data.frame() |>
  dplyr::rename(x1 = x, y1 = y)

hex_grid_centre_centroid <- rgeos::gCentroid(hex_grid_centre) |> 
  as.data.frame() |>
  dplyr::rename(x2 = x, y2 = y)

# calculate distance between centre hex and other hexes
d <- function(x1,x2, y1, y2){
  sqrt((x2-x1)^2 + (y2-y1)^2)
}

distance <- hex_grid_centroids |>
  dplyr::bind_cols(hex_grid_centre_centroid) |>
  dplyr::mutate(distance = d(x1, x2, y1, y2)) |>
  dplyr::pull(distance)

hex_grid@data <- cbind(hex_grid@data, hex_grid_centroids)

hex_grid@data$distance_from_centre <- distance
hex_grid@data$rank <- rank(distance, ties.method = "first")

Rank the tiles based on distance from centre.

# Version 1
ggplot(fortify(hex_grid)) + 
  geom_polygon(aes(long, lat, group = id), fill = NA, colour = "black") +
  geom_text(data = hex_grid@data, aes(label = rank, x = x1, y = y1))

## Regions defined for each Polygons

hex_grid@data <- hex_grid@data |>
  dplyr::left_join(
    df, by = c("rank" = "id")
  )

# Version 2
hex_grid@data$rank2 <- rank(rgeos::gDistance(hex_grid, hex_grid_centre, byid = TRUE), ties.method = "first")
ggplot(fortify(hex_grid)) + 
  geom_polygon(aes(long, lat, group = id), fill = NA, colour = "black") +
  geom_text(data = hex_grid@data, aes(label = rank2, x = x1, y = y1))

## Regions defined for each Polygons

Join the data in and plot

hex_grid2 <- hex_grid[!is.na(hex_grid@data$org),] 
hex_grid2_gg <- fortify(hex_grid2)  |>
  dplyr::left_join(hex_grid2@data |>
                     dplyr::mutate(id = as.character(id)) |>
                     dplyr:::select(id, cohort = group, rank2, org))

## Regions defined for each Polygons

## Joining, by = "id"

ggplot(hex_grid2_gg) + 
  geom_polygon(aes(long, lat, group = id, fill = as.factor(cohort)), colour = "black") +
  geom_text(data = hex_grid2@data, aes(label = rank, x = x1, y = y1))

I may be able to get a better grouping (i.e. in concentric circles) if I de-tesselate the grid calculate distance then tesselate again. This could be done with the offset_x and offset_y variables.

Disolve the shapes by cohort

cohort_1 <- rgeos::gUnaryUnion(hex_grid2[hex_grid2@data$group == 1,], )
cohort_2 <- rgeos::gUnaryUnion(hex_grid2[hex_grid2@data$group == 2,], )
cohort_3 <- rgeos::gUnaryUnion(hex_grid2[hex_grid2@data$group == 3,], )
cohort_4 <- rgeos::gUnaryUnion(hex_grid2[hex_grid2@data$group == 4,], )
ggplot(hex_grid2_gg) + 
  geom_polygon(aes(long, lat, group = id, fill = as.factor(org), alpha = 1/cohort), colour = "black") +
  geom_text(data = hex_grid2@data, aes(label = rank, x = x1, y = y1)) +
  geom_polygon(data = cohort_1, aes(long, lat, group=group), 
               colour = "black", size =1,  fill = NA) +
  geom_polygon(data = cohort_2, aes(long, lat, group=group), 
               colour = "black", size =1,  fill = NA) +
  geom_polygon(data = cohort_3, aes(long, lat, group=group), 
               colour = "black", size =1,  fill = NA) 

This looks at the offset variables

hex_grid3 <- hex_grid
hex_grid3@data <- hex_grid3@data |> 
  dplyr::select(id, offset_x, offset_y, tessellate)

hex_grid3@data$centre <- hex_grid3@data$id == hex_grid_centre_id

centre_coords <- hex_grid3@data |>
  dplyr::filter(centre == TRUE) |>
  dplyr::select(offset_x, offset_y)

hex_grid3@data$offset_x2 <- centre_coords$offset_x
hex_grid3@data$offset_y2 <- centre_coords$offset_y

hex_grid3@data <- cbind(
  hex_grid3@data, 
  rgeos::gCentroid(hex_grid3, byid = TRUE) |> 
    as.data.frame()
  )

hex_grid3@data <- hex_grid3@data |>
  dplyr::mutate(x1 = ifelse(tessellate == TRUE, offset_x + 0.5 , offset_x),
                y1 = offset_y) |>
  dplyr::mutate(x2 = ifelse(centre == TRUE, x1, NA),
                y2 = ifelse(centre == TRUE, y1, NA)) |>
  tidyr::fill(c(x2,y2), .direction = "updown") |>
  dplyr::mutate(distance = d(x1, x2, y1, y2)) |>
  dplyr::mutate(rank  = rank(distance, ties = "first"))

ggplot(hex_grid3) +
  geom_polygon(aes(long, lat, group = group), fill = NA, colour = "black") +
  geom_text(data = hex_grid3@data, aes(x, y, label = rank))

## Regions defined for each Polygons

hex_grid32 <- hex_grid3
hex_grid32@data <- hex_grid32@data |>
  dplyr::left_join(
    df, by = c("rank" = "id")
  ) |>
  dplyr::rename(cohort = group)

hex_grid32 <- hex_grid32[!is.na(hex_grid32@data$cohort),]
hex_grid32f <- fortify(hex_grid32) |>
 dplyr::left_join(hex_grid32@data |>
                     dplyr::mutate(id = as.character(id)) |>
                     dplyr:::select(id, cohort, rank, org))

## Regions defined for each Polygons

## Joining, by = "id"

ggplot(hex_grid32f) +
  geom_polygon(aes(long, lat, group = group, fill = cohort), colour = "black") +
  geom_text(data = hex_grid32@data, aes(x, y, label = rank))

cohort_groups <- (hex_grid32@data$cohort |> unique())[-1] |>
  purrr::map_df(~{
    x <- hex_grid32[hex_grid32@data$cohort == .x,]
    rgeos::gUnaryUnion(x) |>
      fortify() |>
      dplyr::mutate(cohort = .x) |>
      dplyr::mutate(group = paste0(cohort, ".", group))
  })

ggplot(hex_grid32f) +
  geom_polygon(aes(long, lat, group = group, fill = as.factor(cohort), alpha = cohort != 4), 
               colour = "grey") +
  geom_text(data = hex_grid32@data, aes(x, y, label = rank, alpha = cohort != 4)) +
  geom_polygon(data = cohort_groups, 
               aes(long, lat, group = group), 
               colour = "black", size = 1,
               fill = NA) +
  scale_fill_viridis_d() +
  coord_cartesian() +
  theme_void()

## Warning: Using alpha for a discrete variable is not advised.