[This article was first published on R snippets, 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.
During holiday break I have decided to solve 9-puzzle, which is 3×3 variant of a well known 15-puzzle. The solution has proven to be a nice application of igraph package. Warning: this time the code takes a bit more tame than usual in my posts to execute.Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
9-puzzle is a problem where numbers from 1 to 8 are placed on a board that has size 3×3 tiles. One spot is left empty. We can slide numbers to empty tile. Starting from an arbitrary setup we want to put the numbers in order: 1, 2, 3 in the first row, 4, 5, 6 in the second row and 7,8 and empty in third row.
To solve it I represent each positioning of the numbers as vertex in the graph. Two vertexes are connected by an edge (undirected) if one of them can be reached from the other using only one move.
In order to encode the number setups I use 9 for empty space. Then each position can be encoded as permutation of numbers from 1 to 9. The encoding is row wise, so target setup has 123456789 encoding. Here is the code that writes to a file all edges in the graph:
library(gtools)< o:p>
moves <- list(c(2, 4), c(3, 5), 6, c(5, 7), c(6, 8), 9, 8, 9)< o:p>
cat(“Initializing permutations\n\n”)< o:p>
flush.console()< o:p>
positions <- permutations(9, 9)< o:p>
pos9 <- apply(positions, 1, function(x) { which(x == 9) } )< o:p>
max.val <- length(which(pos9 != 9))< o:p>
edge.write <- function(i) {< o:p>
percentage <- i / max.val< o:p>
setTxtProgressBar(progress.bar, percentage)< o:p>
pos9i <- pos9[i]< o:p>
if (pos9i == 9) {< o:p>
stop(“Should not happen”)< o:p>
}< o:p>
from <- positions[i,]< o:p>
to <- matrix(from, nrow = length(moves[[pos9i]]),< o:p>
ncol = 9, byrow = T)< o:p>
for (j in 1:nrow(to)) {< o:p>
to[j, pos9i] <- to[j, moves[[pos9i]][j]]< o:p>
to[j, moves[[pos9i]][j]] <- 9< o:p>
cat(paste(from, collapse=“”), “,”,< o:p>
paste(to[j,],collapse=“”), “\n”, file = out.file)< o:p>
}< o:p>
}< o:p>
file.name <- tempfile()< o:p>
cat(“Writing edge file to: “, file.name, “\n”,< o:p>
rep(“.”, 50), “\n”, sep=“”)< o:p>
progress.bar <- txtProgressBar(0, 1, 0, width = 50)< o:p>
out.file <- file(file.name, “w”)< o:p>
cat(“from, to\n”, file = out.file)< o:p>
for (i in which(pos9 != 9)) {< o:p>
edge.write(i)< o:p>
}< o:p>
close(progress.bar)< o:p>
close(out.file)Notice that the graph is undirected so we save only moves of empty tile “right” or “down”. This is encoded in moves variable. For example if position 2 is empty it can be moved to position 1, 3 or 5, but only 3 and 5 are encoded as move to 1 is “left”. In order to optimize the algorithm we remove all setups that have empty tile at position 9 as there are no moves “right” or “down” from such a setup.
Once the file is written it can be processed using igraph package as follows:
library(igraph)< o:p>
cat(“\nReading edge file to iGraph\n”)< o:p>
flush.console()< o:p>
edgelist <- read.csv(file.name)< o:p>
unlink(file.name)< o:p>
puzzle9.graph <- graph.data.frame(edgelist, directed = TRUE)< o:p>
cat(“Number of clusers in the graph:”,< o:p>
clusters(puzzle9.graph)$no, “\n\n”)< o:p>
v.names <-get.vertex.attribute(puzzle9.graph,“name”)< o:p>
v.start <- which(v.names==“123456789”)< o:p>
sp <- shortest.paths(puzzle9.graph,v.start)< o:p>
v.tough <- which(sp==max(sp[sp<Inf]))< o:p>
formatted.tough <- character(2)< o:p>
for (i in 1:length(v.tough)) {< o:p>
split.tough <- strsplit(v.names[v.tough[i]],split=“”)[[1]]< o:p>
split.tough[which(split.tough==“9”)] <- “.”< o:p>
split.tough <- matrix(split.tough, nrow = 3)< o:p>
formatted.tough[i] <- paste(apply(split.tough, 2, paste,< o:p>
collapse=“”),< o:p>
collapse=“\n”)< o:p>
}< o:p>
par(mar=c(4.5, 4.5, 0.5, 0.5))< o:p>
plot(prop.table(table(sp, exclude=Inf)),< o:p>
xlab = “Steps needed”, ylab = “Probability”)< o:p>
text(2, 0.12,“Tough cases:”, family = “mono”, pos = 4)< o:p>
text(2, 0.1, formatted.tough[1], family = “mono”, pos = 4)< o:p>
text(9, 0.1, formatted.tough[2], family = “mono”, pos = 4)< o:p>
cat(“Done!\n”)What we learn is that the graph has 2 clusters and only half of the possible setups can lead us to desired orderings (in fact we know that it is directly related to parity of the permutation). The code produces the graph given below. We see that most of the times 22-24 moves are needed to solve the puzzle if it is possible and in worst case 31 moves are needed. We find that there exactly 2 such tough cases and they are printed out on a graph:
To leave a comment for the author, please follow the link and comment on their blog: R snippets.
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.