Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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[])<=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!  