Fun with R and graphs on the dawn of 2014

December 31, 2013
By

(This article was first published on quantsignals » R, and kindly contributed to R-bloggers)

There is some secret message hidden in this graph

Image

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

HNY1

Wishing everyone a Happy New Year 2014, cheers!


To leave a comment for the author, please follow the link and comment on his blog: quantsignals » R.

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.