Fun with R and graphs on the dawn of 2014
[This article was first published on quantsignals » R, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
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[[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!
To leave a comment for the author, please follow the link and comment on their blog: quantsignals » R.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

