Coding hex flowers in R

Goblin’s Henchman has done a lot of work on hex flowers, culminating in The Hex Flower Cookbook. The basic idea is to have a random table, but one with memory such that the last result affects the next. A “hex flower” is a hex of hexes, where the big hex is three small hexes to a face, resulting in 19 hexes in the flower. You roll 2d6, which tells you which way to move from the current hex. As you’d expect from 2d6, some values are more likely than others and so the tendency is to move down and to the left. Mostly the map rolls over the edge (like PacMan) but a few paths are blocked.

The most obvious thing to use the method for is weather, which will also be my example, but Goblin’s Henchman has other examples for terrain and dungeon generation. Likewise, Planar Compass #2 uses a hex flower to describe both astral sailing and what t would be like to be D&D Jonah in the belly of a space whale.

In this post, I adapt the algorithm, and especially GH’s weather hex flower, to run in R. Here is an illustration of what it does.

> hexflower.chain(starthex=2,n=20)
      [,1] [,2]           
 [1,] "2"  "partial cloud"
 [2,] "5"  "cloudy"       
 [3,] "1"  "cloudy"       
 [4,] "6"  "rain"         
 [5,] "16" "rainstorm"    
 [6,] "13" "dark clouds"  
 [7,] "15" "cloudy"       
 [8,] "17" "hot"          
 [9,] "15" "cloudy"       
[10,] "12" "sunny"        
[11,] "7"  "partial cloud"
[12,] "9"  "sunny"        
[13,] "14" "sunny"        
[14,] "9"  "sunny"        
[15,] "4"  "drizzling"    
[16,] "14" "sunny"        
[17,] "12" "sunny"        
[18,] "9"  "sunny"        
[19,] "4"  "drizzling"    
[20,] "7"  "partial cloud"
[21,] "9"  "sunny" 

Here is the R code it takes to run that.

hf.1  <- c( 5, 3, 4, 1, 6, 2)
hf.2  <- c( 7, 5, 1,17,11, 4)
hf.3  <- c( 8, 6, 9,18, 1, 5)
hf.4  <- c( 9, 7, 2,14,16, 1)
hf.5  <- c(10, 8, 3, 1, 2, 7)
hf.6  <- c(11, 1,14,16, 3, 8)
hf.7  <- c(12,10, 5, 2, 4, 9)
hf.8  <- c(13,11, 6, 3, 5,10)
hf.9  <- c(14,12, 7, 4,18, 3)
hf.10 <- c(15,13, 8, 5, 7,12)
hf.11 <- c(16, 2,17, 6, 8,13)
hf.12 <- c(17,15,10, 7, 9,14)
hf.13 <- c(18,16,11, 8,10,15)
hf.14 <- c( 4,17,12, 9,19, 6)
hf.15 <- c(19,18,13,10,12,17)
hf.16 <- c( 6, 4,19,11,13,18)
hf.17 <- c( 2,19,15,12,14,11)
hf.18 <- c( 3, 9,16,13,15,19)
hf.19 <- c(19,19,18,15,17,19)

hf.mat <- rbind(hf.1, hf.2, hf.3, hf.4, hf.5, hf.6, hf.7, hf.8, hf.9,hf.10,
            hf.11,hf.12,hf.13,hf.14,hf.15,hf.16,hf.17,hf.18,hf.19)
colnames(hf.mat) <- c("a","b","c","d","e","f")
rownames(hf.mat) <- 1:19

hex.values <- c("cloudy","partial cloud","overcast","drizzling","cloudy",
                "rain","partial cloud","rain","sunny","drizzling",
                "heavy rain","sunny","dark clouds","sunny","cloudy",
                "rainstorm","hot","lightning storm","hazard")
roll2d6 <- function() {sum(sample(1:6,2,replace = T))}

hexflower.step <- function(starthex=1) {
  dice.val <- roll2d6()
  nh.val <- ifelse(dice.val==12,1,
            ifelse(dice.val==2 | dice.val==3,2,
            ifelse(dice.val==4 | dice.val==5,3,
            ifelse(dice.val==6 | dice.val==7,4,
            ifelse(dice.val==8|dice.val==9,5,
            ifelse(dice.val==10 | dice.val==11,6,NA))))))
  destination <- hf.mat[starthex,nh.val]
  return.obj <- c(destination,hex.values[destination])
  return(return.obj)
}

hexflower.chain <- function(starthex=1, n=1) {
  val_1 <- c(starthex,hex.values[starthex])
  val.mat <-  matrix(val_1,nrow = 1, byrow = TRUE)
  for (i in 1:n) {
    vals_i <- hexflower.step(val.mat[i,1])
#    val.mat <- rbind(val.mat,vals_i)
    val.mat <- rbind(val.mat,hexflower.step(val.mat[i,1]))
  }
  return(val.mat)
}