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

#BoycottQatar2022   ┇   Why everyone should boycott the World Cup in Qatar

🆕 since August 2022: LuaX is a Lua eXtended interpretor/cross compiler providing a bunch of useful modules (statically linked, no dependency). Nice integration with upp (new functions and modules available to extend upp macros) and also with a soon released but yet confidential project about actor oriented programming!
💣 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 ;-)

Snake Puzzle Solver in Haskell

Christophe Delord

24 May 2018


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/.


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,
          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)


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]


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

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') | δx == 1   = Forward
                              | δx == -1  = Backward
                              | δy == 1   = Main.Right
                              | δy == -1  = Main.Left
                              | δz == 1   = Up
                              | δz == -1  = Down
            where (δx, δy, δz) = (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)


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 ()


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


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 ;-).↩︎