Wolfram’s rules

Today, we’re going to use base R and the pheatmap package to produce elementary cellular automata and see if we can figure out how to evaluate the complexity of what we see. First, we’ll set up the functioon:

library(tidyverse)
## ── Attaching packages ───────────────────────────────────────────────── tidyverse 1.3.0 ──
## ✓ ggplot2 3.2.1     ✓ purrr   0.3.3
## ✓ tibble  2.1.3     ✓ dplyr   0.8.4
## ✓ tidyr   1.0.2     ✓ stringr 1.4.0
## ✓ readr   1.3.1     ✓ forcats 0.5.0
## ── Conflicts ──────────────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
# Define a rule
#state <- c("111", "110", "101", "100", "011", "010", "001", "000")
state <- lapply(seq(0, 7), function(i) {
    result <- intToBits(i)[1:3] %>% as.numeric() %>% rev() %>% paste(collapse = "")
    return(result)
}) %>% as.character() 

outcome <- lapply(seq(0, 255), function(i) {
    result <- intToBits(i)[1:8] %>% as.numeric()
    return(result)
}) %>% do.call(cbind, .) %>% as_tibble()
## Warning: `as_tibble.matrix()` requires a matrix with column names or a `.name_repair` argument. Using compatibility `.name_repair`.
## This warning is displayed once per session.
names(outcome) <- paste("rule", seq(0, 255), sep = "_")

rule_set <- bind_cols(state = state, outcome = outcome)

# The procedure
ApplyRule <- function(v, rule_set, rule_num) {
    # Set the rule
    rule <- tibble(state = state, outcome = rule_set[[rule_num + 2]])
    
    # Iterate through the vector
    result <- lapply(seq_along(v), function(i) {
        # Edge case
        if(i == 1 | i == length(v)) {
            return(0)
        }
        
        # The rule
        curr <- paste(v[i - 1], v[i], v[i + 1], sep = "") 
        out <- rule[rule$state == curr,]$outcome
        return(out)
    }) %>% unlist()
}

We will visualize rule space with a clustered heatmap to see what rules are similar to each other:

pheatmap::pheatmap(rule_set[,-1], cluster_cols = FALSE, cluster_rows = FALSE, fontsize = 4)

Now, we’ll try it:

# Define a vector 
v <- c(rep(0, 30), 1, rep(0, 30))

# Define an output matrix
top <- v
mat <- lapply(seq(30), function(i) {
    curr <- ApplyRule(v = v, rule_set = rule_set, rule = 30)
    v <<- curr
    return(curr)
}) %>% do.call(rbind, .)

mat <- rbind(top, mat)


# Visualize
pheatmap::pheatmap(mat, cluster_rows = FALSE, cluster_cols = FALSE)

Now, we’re going to try every rule:

for(i in seq(0, 255)) {
    # Define a vector 
    v <- c(rep(0, 200), 1, rep(0, 200))

    # Define an output matrix
    top <- v
    mat <- lapply(seq(200), function(n) {
        curr <- ApplyRule(v = v, rule_set = rule_set, rule = i)
        v <<- curr
        return(curr)
    }) %>% do.call(rbind, .)

    mat <- rbind(top, mat) %>% unname()

    # Visualize
    pheatmap::pheatmap(mat, 
                       cluster_rows = FALSE, 
                       cluster_cols = FALSE, 
                       main = paste("rule", i))
    
}