(This article was first published on

During holiday break I have decided to solve 9-puzzle, which is 3x3 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.**R snippets**, and kindly contributed to R-bloggers)9-puzzle is a problem where numbers from 1 to 8 are placed on a board that has size 3x3 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**)**moves

**<-**list**(**c**(**2, 4**)**, c**(**3, 5**)**, 6, c**(**5, 7**)**, c**(**6, 8**)**, 9, 8, 9**)**cat

**(**"Initializing permutations\n\n"**)**flush.console

**()**positions

**<-**permutations**(**9, 9**)**pos9

**<-**apply**(**positions, 1,**function****(**x**)****{**which**(**x**==**9**)****}****)**max.val

**<-**length**(**which**(**pos9**!=**9**))**edge.write

**<-****function****(**i**)****{** percentage

**<-**i**/**max.val setTxtProgressBar

**(**progress.bar, percentage**)** pos9i

**<-**pos9**[**i**]****if**

**(**pos9i

**==**9

**)**

**{**

stop

**(**"Should not happen"**)****}**

from

**<-**positions**[**i,**]** to

**<-**matrix**(**from, nrow**=**length**(**moves**[[**pos9i**]])**, ncol

**=**9, byrow**=**T**)****for**

**(**j

**in**1

**:**nrow

**(**to

**))**

**{**

to

**[**j, pos9i**]****<-**to**[**j, moves**[[**pos9i**]][**j**]]** to

**[**j, moves**[[**pos9i**]][**j**]]****<-**9 cat

**(**paste**(**from, collapse**=**""**)**, ",", paste

**(**to**[**j,**]**,collapse**=**""**)**, "\n", file**=**out.file**)****}**

**}**

file.name

**<-**tempfile**()**cat

**(**"Writing edge file to: ", file.name, "\n", rep

**(**".", 50**)**, "\n", sep**=**""**)**progress.bar

**<-**txtProgressBar**(**0, 1, 0, width**=**50**)**out.file

**<-**file**(**file.name, "w"**)**cat

**(**"from, to\n", file**=**out.file**)****for**

**(**i

**in**which

**(**pos9

**!=**9

**))**

**{**

edge.write

**(**i**)****}**

close

close**(**progress.bar**)****(**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**)**cat

**(**"\nReading edge file to iGraph\n"**)**flush.console

**()**edgelist

**<-**read.csv**(**file.name**)**unlink

**(**file.name**)**puzzle9.graph

**<-**graph.data.frame**(**edgelist, directed**=****TRUE****)**cat

**(**"Number of clusers in the graph:", clusters

**(**puzzle9.graph**)$**no, "\n\n"**)**v.names

**<-**get.vertex.attribute**(**puzzle9.graph,"name"**)**v.start

**<-**which**(**v.names**==**"123456789"**)**sp

**<-**shortest.paths**(**puzzle9.graph,v.start**)**v.tough

**<-**which**(**sp**==**max**(**sp**[**sp**<****Inf****]))**formatted.tough

**<-**character**(**2**)****for**

**(**i

**in**1

**:**length

**(**v.tough

**))**

**{**

split.tough

**<-**strsplit**(**v.names**[**v.tough**[**i**]]**,split**=**""**)[[**1**]]** split.tough

**[**which**(**split.tough**==**"9"**)]****<-**"." split.tough

**<-**matrix**(**split.tough, nrow**=**3**)** formatted.tough

**[**i**]****<-**paste**(**apply**(**split.tough, 2, paste, collapse

**=**""**)**, collapse

**=**"\n"**)****}**

par

**(**mar**=**c**(**4.5, 4.5, 0.5, 0.5**))**plot

**(**prop.table**(**table**(**sp, exclude**=****Inf****))**, xlab

**=**"Steps needed", ylab**=**"Probability"**)**text

**(**2, 0.12,"Tough cases:", family**=**"mono", pos**=**4**)**text

**(**2, 0.1, formatted.tough**[**1**]**, family**=**"mono", pos**=**4**)**text

cat**(**9, 0.1, formatted.tough**[**2**]**, family**=**"mono", pos**=**4**)****(**"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 his blog:**R snippets**.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...