👨‍💻 about me home CV/Resume 🖊️ Contact Github LinkedIn I’m a Haskeller 📝 Blog Freedom, privacy, tutorials… 🏆 Best of panda upp Haskell abp pp hCalc bl lapp todo pwd TPG Nextcloud Git BitTorrent

💣 Kick GAFAMs out (✔️ ǝlƃooפ, ✔️ ʞooqǝɔɐℲ, ✔️ uozɐɯ∀): Stop giving our soul and money to evils, be free and respectful!
📰 Friday 2. April 2021: upp is a panda companion. It’s a Lua-scriptable lightweight text preprocessor.
🆕 since December 2020: Playing with the actor model in an embedded multicore context. C imperative components become C stream pure functions with no side effect ➡️ C low level programming with high level pure functional programming properties 🏆
📰 Saturday 30. January 2021: Playing with Pandoc Lua filters in Lua. panda is a lightweight alternative to abp providing a consistent set of Pandoc filters (text substitution, file inclusion, diagrams, scripts, …).
🆕 Sunday 24. May 2020: Working at EasyMile for more than 5 years. Critical real-time software in C, simulation and monitoring in Haskell ➡️ perfect combo! It’s efficient and funny ;-)
🚌 And we are recruiting! Contact if you are interested in Haskell or embedded softwares (or both).

Snake Puzzle Solver in Haskell

Christophe Delord

24 May 2018

License

This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with this program. If not, see http://www.gnu.org/licenses/.

Introduction

Once I have been offered a snake puzzle. It’s made of 64 cubes of wood, some of them can turn. The goal is to fold this snake into a 4x4x4 cube.

After a while trying to solve this cube I decided to write a solver in Prolog. I present here an Haskell version of this solver.

Model of the snake

The snake is made of 64 cubes. Cubes are joined in a way that the next cube is either in the same direction, either in a perpendicular direction. We will model theses constraints by a list of terms F or T:

import Data.Array
import Control.Parallel
import Control.Parallel.Strategies

data SnakeSection = F | T deriving (Eq) -- Forward or Turn

snake :: [SnakeSection]
snake = [ F,F,T,T,F,T,T,T,
          F,F,T,T,F,T,T,F,
          T,T,F,T,T,T,T,T,
          T,T,T,T,F,T,F,T,
          T,T,T,T,T,F,T,F,
          F,T,T,T,T,F,F,T,
          T,F,T,T,T,T,T,T,
          T,T,T,T,F,F,T   ]

Model of the cube

The cube is a 4x4x4 array of booleans. True means the cell is occupied by the partial solution and False means the cells is still available.

type Cube = Array (Int,Int,Int) Bool
type Position = (Int,Int,Int)
type Direction = (Int,Int,Int)

Solutions

A solution is a list of terms indicating the direction to follow in the cube to fill it while walking throught the snake.

data Move = Forward | Backward | Left | Right | Up | Down deriving (Show)
type Solution = [Move]

Solver

The solver is a brute force backtracking solver. Given a partial solution, a current position and direction it tries all the possibilities and concat them. solve returns a list of all the solutions. Thanks to the lazyness of Haskell we will only compute the first one. There are a lot of solutions because of symetries.

So the solver starts with:

solve :: [SnakeSection] -> [Solution]
solve snake = concat [ solve [] (emptyCube//[(p,True)]) p d snake
                     | p <- r3D, d <- dirs
                     ]
    where

The size of the cube is \(\sqrt[3]{1 + length(snake)}\)1. The cube is a 3D array. i3D and r3D are the coordinates of each small cubes.

        size = round (fromIntegral (length snake + 1) ** (1/3))
        i3D = ((1,1,1),(size,size,size))
        r3D = range i3D

The initial empty cube is filled with False values (no cube occupied yet).

        emptyCube :: Cube
        emptyCube = array i3D [(p,False) | p <- r3D]

Here is the real solver. There are two possibilities at each stage.

        solve :: Solution -> Cube -> Position -> Direction -> [SnakeSection] -> [Solution]
        solve path cube _ _ [] = [path]
        solve path cube p d (s:ss) = concat [
                solve (dp p p' : path) (cube//[(p',True)]) p' d' ss
            |   d' <- turn s d,
                let p' = nextPos p d',
                inRange i3D p', not (cube!p')
            ]

The recursive search can be performed in parallel on several cores. This is pretty easy in Haskell. parL is a strategy that evaluates items in a list in parallel:

        solve' :: Solution -> Cube -> Position -> Direction -> [SnakeSection] -> [Solution]
        solve' path cube _ _ [] = [path]
        solve' path cube p d (s:ss) = concat $ (if s==T then id else parL) [
                solve' (dp p p' : path) (cube//[(p',True)]) p' d' ss
            |   d' <- turn s d,
                let p' = nextPos p d',
                inRange i3D p', not (cube!p')
            ]

Directions are 3D unit vectors describing the eight possible directions in the cube.

        dirs :: [Direction]
        dirs = [(-1,0,0), (1,0,0), (0,-1,0), (0,1,0), (0,0,-1), (0,0,1)]

turn computes the next possible directions from the current position and direction.

        turn :: SnakeSection -> Direction -> [Direction]
        turn F d = [d]
        turn T (_,0,0) = [d | d@(0,_,_) <- dirs]
        turn T (0,_,0) = [d | d@(_,0,_) <- dirs]
        turn T (0,0,_) = [d | d@(_,_,0) <- dirs]

Computing the next position is just a matter of adding vectors.

        nextPos :: Position -> Direction -> Position
        nextPos (x,y,z) (dx,dy,dz) = (x+dx, y+dy, z+dz)

A step in the solution is simply the move required to go from one position to the next one.

        dp :: Position -> Position -> Move
        dp (x,y,z) (x',y',z') | dx == 1   = Forward
                              | dx == -1  = Backward
                              | dy == 1   = Main.Right
                              | dy == -1  = Main.Left
                              | dz == 1   = Up
                              | dz == -1  = Down
            where (dx, dy, dz) = (x'-x, y'-y, z'-z)

parL is a strategy that evaluate items of a list in parallel. This fasten significally the search (note: it seems that with ghc 8.0.2, the non concurrent version is faster).

parL = withStrategy (parList rseq)

Solution

There are many solutions because of symetries. Let’s take only the first one. main takes the first solution, enumerates and prints all the steps.

main = printSol $ zip [1..] $ reverse $ head $ solve snake
    where printSol ((i,d):ds) = do
              putStrLn (show i ++ ": " ++ show d)
              printSol ds
          printSol [] = return ()

Execution

It’s better to compile the script with ghc. The interpreted version is 17 times slower than the compiled one.

$ snake
1: Forward
2: Forward
3: Right
4: Backward
5: Backward
6: Up
7: Left
8: Forward
9: Forward
10: Forward
11: Down
12: Right
13: Right
14: Backward
15: Up
16: Up
17: Backward
18: Down
19: Down
20: Backward
21: Right
22: Forward
23: Up
24: Forward
25: Down
26: Forward
27: Up
28: Left
29: Left
30: Backward
31: Backward
32: Up
33: Backward
34: Right
35: Down
36: Right
37: Up
38: Up
39: Left
40: Left
41: Left
42: Down
43: Forward
44: Up
45: Right
46: Right
47: Right
48: Down
49: Forward
50: Forward
51: Left
52: Up
53: Left
54: Down
55: Backward
56: Left
57: Forward
58: Up
59: Backward
60: Right
61: Right
62: Right
63: Forward

Source

The Haskell source code is here: snake.lhs


  1. If you don’t see a cubic root here, blame your browser and try Firefox instead ;-).↩︎