👨💻 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
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.
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
:
F
: the next cube goes forwardT
: the next cube “turns”import Data.Array
import Control.Parallel
import Control.Parallel.Strategies
data SnakeSection = F | T deriving (Eq) -- Forward or Turn
snake :: [SnakeSection]
= [ F,F,T,T,F,T,T,T,
snake 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 ]
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]
= concat [ solve [] (emptyCube//[(p,True)]) p d snake
solve 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.
= round (fromIntegral (length snake + 1) ** (1/3))
size = ((1,1,1),(size,size,size))
i3D = range i3D r3D
The initial empty cube is filled with False
values (no
cube occupied yet).
emptyCube :: Cube
= array i3D [(p,False) | p <- r3D] emptyCube
Here is the real solver. There are two possibilities at each stage.
solve :: Solution -> Cube -> Position -> Direction -> [SnakeSection] -> [Solution]
= [path]
solve path cube _ _ [] :ss) = concat [
solve path cube p d (s: path) (cube//[(p',True)]) p' d' ss
solve (dp p p' | 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]
= [path]
solve' path cube _ _ [] :ss) = concat $ (if s==T then id else parL) [
solve' path cube p d (s: path) (cube//[(p',True)]) p' d' ss
solve' (dp p p' | 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]
= [(-1,0,0), (1,0,0), (0,-1,0), (0,1,0), (0,0,-1), (0,0,1)] dirs
turn
computes the next possible directions from the
current position and direction.
turn :: SnakeSection -> Direction -> [Direction]
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] turn
Computing the next position is just a matter of adding vectors.
nextPos :: Position -> Direction -> Position
= (x+dx, y+dy, z+dz) nextPos (x,y,z) (dx,dy,dz)
A step in the solution is simply the move required to go from one position to the next one.
dp :: Position -> Position -> Move
| dx == 1 = Forward
dp (x,y,z) (x',y',z') | 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).
= withStrategy (parList rseq) parL
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.
= printSol $ zip [1..] $ reverse $ head $ solve snake
main where printSol ((i,d):ds) = do
putStrLn (show i ++ ": " ++ show d)
printSol ds= return () printSol []
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
If you don’t see a cubic root here, blame your browser and try Firefox instead ;-).↩︎