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.