Fun with R and graphs on the dawn of 2014

There is some secret message hidden in this graph

Let’s decode it

library(graphics)
library(igraph)

# Can you traverse the graph of letters to decode the secret message that decrypt's as
# hashcode(message) = 2055263931398168510404

# Function to convert a string to a hash number 
hashcode <- function(s){ 
  sapply(s, function(si){sum(as.numeric(charToRaw(si))*31^( (1:nchar(si))-1)) } )}

# Define a list of vertices and neighbors
# For example from P one can reach P and Y
edges <- list("W"=c(" "),
              "P"=c("P","Y"),
              "H"=c("A"),
              "E"=c("A","W"),
              "Y"=c(" ","E"),
              "R"=c(" "),
              " "=c("N","H","Y"),
              "N"=c("E"),
              "A"=c("P","R"))

# reformat edgelist into a matrix of paired vertices that is expected by the igraph graphing package
el <-        (do.call(rbind, 
              (Reduce(append,lapply(names(edges), function(e) 
              { lapply(edges[[e]], function(ei){ matrix(c(e,ei),nrow=1)})})) ) ))

# create graph, for plotting only
g <- graph.edgelist(el)
# color edges
E(g)$color <- "grey"
plot(g)

# Paths are represented by strings, for example going from "Y" to "F" and "W" would be "YFW"
# Let's start traversing the path from three starting nodes H, N and Y
paths <- c("H","N","Y")

# Function that looks up the current node given a path
# for example currnode("YFW") returns "W"
currnode <- function(s){substring(s,nchar(s),nchar(s))}

# Starting from the initial points, traverse graph by appending the next vertices 
# according to the edge list until a path length of 13 steps
# For example currnode("PYF") returns "F"  
# edges[["F"]] returns "A" and "W"
# which creates paths "PYFA" and "PYFW"

# Run for 13 steps
while(nchar(paths[[1]])<=13) {
  paths <- Reduce(append,lapply(paths,function(p){ lapply(
    edges[[currnode(p)]] , function(nxt){paste0(p,nxt)} ) } ))
}

# Check if we found the 'secret message' ?
HNY <- which(hashcode(paths)==2055263931398168510404)
# Print the decoded message
msg <- paths[[HNY]]
msg
#print all paths
#unlist(paths)

# color the solution path 
# (use <<- to assign the color within mapply)
path <- unlist(strsplit(msg,""))
invisible(mapply(function(x,y,col){
  E(g, path=c(x,y))$color <<- col}, 
                 path[-length(path)], 
                 path[-1],heat.colors(length(path)-1) ))
plot(g)     

Resulting in

Wishing everyone a Happy New Year 2014, cheers!