Ханойские Башни

Дав­нень­ко я ни­че­го про Haskell не пи­сал... Ис­прав­ля­юсь.

За­да­чу про Ха­ной­ские Баш­ни (Tow­ers of Hanoi) при­ду­мал фран­цуз­ский ма­те­ма­тик Эду­ард Люка в 1883 году. Су­ще­ству­ет ле­ген­да об ин­дий­ском хра­ме в ко­то­ром есть боль­шая ком­на­та с тре­мя ал­маз­ны­ми стол­би­ка­ми на ко­то­рые на­ни­за­но 64 зо­ло­тых дис­ка. И бог Бра­ма по­ве­лел пе­ре­ло­жить дис­ки с од­но­го стол­би­ка на дру­гой, и ко­гда эта за­да­ча бу­дет ре­ше­на наш мир раз­ру­шит­ся...

Усло­вия го­ло­во­лом­ки: есть три стол­би­ка, на 1-й на­ни­за­на пи­ра­ми­да из n дис­ков (вни­зу са­мый боль­шой диск, над ним чуть мень­ше и так да­лее), необ­хо­ди­мо пе­ре­ме­стить эту пи­ра­ми­ду на 3-й стол­бик, пе­ре­ме­щая по од­но­му дис­ку, при этом со­блю­дая усло­вие что нель­зя класть боль­ший диск на мень­ший.

Это клас­си­че­ская за­да­ча на тему "ре­кур­сия" и я ду­маю все кто хоть как-то свя­зан с про­грам­ми­ро­ва­ни­ем её ре­ша­ли. Ре­ша­ет­ся она очень про­сто:

hanoi 1 a b _ = [(a,b)]
hanoi n a b c = (hanoi (n-1) a c b) ++ (a,b) : (hanoi (n-1) c b a)

> hanoi 3 1 3 2 -- для 3-х дисков
[(1,3),(1,2),(3,2),(1,3),(2,1),(2,3),(1,3)]

Вот тут я на­ткнул­ся на ва­ри­ант за­да­чи, ко­гда необ­хо­ди­мо най­ти не сами пе­ре­ме­ще­ния, а со­сто­я­ния стол­би­ков в про­цес­се пе­ре­ме­ще­ния (кста­ти, по­смот­ри­те это ре­ше­ние, оно очень ин­те­рес­ное). Я не смог удер­жать­ся и на­пи­сал свой ва­ри­ант:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

module Main
    where

import Text.Printf

-- Строит список перемещений вида [(1,3), (1,2) ..]
hanoi 1 a b _ = [(a,b)]
hanoi n a b c = (hanoi (n-1) a c b) ++ (a,b) : (hanoi (n-1) c b a)

-- Возвращает новое сотояние столбиков
move st (from,to) = let
    h = head $ st !! (from-1);
    m a i | i == from     = tail a
          | i == to       = h:a
          | otherwise     = a
    in [m a i | (a,i) <- zip st [1,2,3]]

-- Формирует список состояний столбиков и перемещений дисков
make_states n (mh:mt) =
    let { lst' = ([[1..n],[],[]],mh) :
        (zip [move st m | (st,m) <- lst'] (mt ++ [(0,0)])) }
    in lst'

-- Решает задачу для n дисков
hanoi_moves n = make_states n $ hanoi n 1 3 2

main = let
    vr n = length (show [1..n]);
    ppm m l = foldl (++) "" (map (printf ("%" ++ show l ++ "s ") . show) m);
    ppv (a,b) = printf "%4s -> %s" (show a) (show b)
    in do
    a <- getLine
    let n = (read a)::Int
    mapM_ putStrLn $ [ppm a (vr n) ++ ppv b | (a,b) <- hanoi_moves n]

Кое что ин­те­рес­ное. В функ­ции make_states я сли­ваю (zip) спи­сок со­сто­я­ний стол­би­ков со спис­ком пе­ре­ме­ще­ний, при этом спи­сок пе­ре­ме­ще­ний тут-же на ходу и фор­ми­ру­ет­ся, ура ле­ни­вым вы­чис­ле­ни­ям :) (ана­ло­гич­ным ме­то­дом, кста­ти, мож­но кра­си­во сфор­ми­ро­вать спи­сок чи­сел Фи­бо­нач­чи: fib = 1:1:[a+b | (a,b) <- zip fib $ tail fib]). Ну и в main-е я до­ба­вил кра­си­вый вы­вод ре­зуль­та­тов:

*Main> main
3
[1,2,3]      []      []    1 -> 3
  [2,3]      []     [1]    1 -> 2
    [3]     [2]     [1]    3 -> 2
    [3]   [1,2]      []    1 -> 3
     []   [1,2]     [3]    2 -> 1
    [1]     [2]     [3]    2 -> 3
    [1]      []   [2,3]    1 -> 3
     []      [] [1,2,3]    0 -> 0