方針
第二階と同様, 出力は後回しにして, 出力すべきデータを作り出す部分を考えます.
今回は各手順を行った際の各杭の状態を順に出力したいので, 変化していく状態を, 状態のリストとして返すことができればよいですね.
状態の表現
各状態を, {各杭に積まれた円盤の番号を小さい順に並べたリスト} を三つの杭 A, B, C についてこの順に並べたリスト, とします.
例えば円盤の数 3 のハノイの塔の初期状態は
[[1,2,3],[],[]]
杭 A から杭 C に1 の円盤を移した状態は
[[2,3],[],[1]]
とします.
手順をあらわす関数
準備として, 手順を {移動前の杭, 移動後の杭, 円盤の番号} などの値の組で表現するのではなく, 手順を表す関数を考えてみます.
A の杭の一番上の円盤を B の杭に動かす関数は
(\[ah:at,b,c] -> [at,ah:b,c])
と書けます.
ghci で確かめてみます.
Prelude> (\[ah:at,b,c] -> [at,ah:b,c]) [[1,2] [] [3]]
[[2], [1], [3]]
関数の型は [[t]] -> [[t]] です.
Prelude> :t (\[ah:at,b,c] -> [at,ah:b,c])
(\[ah:at,b,c] -> [at,ah:b,c]) :: [[t]] -> [[t]]
どの杭からどの杭に移すかを指定すると上記のような関数を返す関数を考えてみましょう.
関数の型は Int -> Int -> ([[t]] -> [[t]]) です.
移動は 6 通りある訳ですが, これをそのまま並べて書けば,
move :: Int -> Int -> ([[t]] -> [[t]])
move 0 1 = (\[ah:at,b,c] -> [at,ah:b,c])
move 0 2 = (\[ah:at,b,c] -> [at,b,ah:c])
move 1 2 = (\[a,bh:bt,c] -> [a,bt,bh:c])
move 1 0 = (\[a,bh:bt,c] -> [bh:a,bt,c])
move 2 0 = (\[a,b,ch:ct] -> [ch:a,b,ct])
move 2 1 = (\[a,b,ch:ct] -> [a,ch:b,ct])
と書けます.
コードを toh07.hs に保存してあるものとして, ghci で確かめてみます.
Prelude> :l toh07.hs
*Main> (move 0 1) [[1,2],[],[3]]
[[2],[1],[3]]
*Main> (move 2 1) [[1,2],[],[3]]
[[1,2],[3],[]]
*Main> (move 2 0) [[1,2],[],[3]]
[[3,1,2],[],[]]
もう少し抽象化できそうな気はしますが…
手順をあらわす関数のリスト
次に, 手順を表す関数のリストを返す関数を考えてみます.
円盤の数 n と, どの杭から(インデクス s) どの杭に (インデクス d) に移すかを与え, 先ほどの手順のリストを返します.
t は残りの杭のインデクスです.
hanoi :: Int -> Int -> Int -> Int -> [([[t]] -> [[t]])]
hanoi _ _ _ 0 = []
hanoi s t d n = hanoi s d t (n - 1) ++
[(move s d)] ++
hanoi t s d (n - 1)
s, t および d が各杭を表す文字でなく, 状態を表すデータ中の杭のインデクスであること,
出力するリストの要素が関数であること, の他は
第二階 の hanoi 関数と同じです.
hanoi 0 1 2 n で 目的の関数列が得られます.
head (hanoi 0 1 2 n) は最初の手順を表す関数です.
n == 3 として, 最初の手順を初期状態 [[1,2,3],[],[]] に適用してみます.
Prelude> :l toh07.hs
*Main> (head (hanoi 0 1 2 3)) [[1,2,3],[],[]]
[[2,3],[],[1]]
手順のリストを状態に順に適用
関数のリストと初期値を引数に取り, 初期値, 最初の関数を適用した結果, 前の結果に次の関数を適用した結果, … といった値の列を得るような関数について考えます.
つまり [f0, f1, f2, ...] と x を与えると
[x, (f0 x), (f1 (f0 x)), (f2 (f1 (f0 x))), ... ]
を返すような関数です.
これは
iterf [] x = [x]
iterf (f:fs) x = x:iterf fs (f x)
のようにかけますので, 円盤の数 n のハノイの塔を解く過程の全ての状態を出力するには
iterf (hanoi 0 1 2 n) [[1..n],[],[]]
とすれば良いですね.
Prelude> :l toh07.hs
*Main> iterf (hanoi 0 1 2 3) [[1..3],[],[]]
[[[2,3],[],[1]],[[3],[2],[1]],[[3],[1,2],[]],[[],[1,2],[3]],[[1],[2],[3]],[[1],[],[2,3]],[[],[],[1,2,3]]]
これで問題を解く部分は完成です.
整形
円盤の数 n と
[[2,3],[1],[]]
という状態を与えると
| | |
--|-- | |
---|--- -|- |
===========================
のような n + 1 行の文字列を返す関数を作ります.
format :: Int -> [[Int]] -> String
format n s = format' $ pad0 s
where
ws m = take m $ repeat ' '
bar m = take m $ repeat '-'
pad0 = map (\x -> reverse (take n ((reverse x) ++ repeat 0)))
rod x = (ws (n - x + 1)) ++ (bar x) ++ "|" ++
(bar x) ++ (ws (n - x + 1))
line a b c = (rod a) ++ (rod b) ++ (rod c) ++ "\n"
format' [[],[],[]] = (take (6*n + 9) $ repeat '=') ++ "\n"
format' [x:xs, y:ys, z:zs] = (line x y z) ++ format' [xs, ys, zs]
ws m は長さ m の空白文字, bar m は m 個のハイフンからなる文字列です.
pad0 は, 各状態を文字列で表現しやすいよう, 各杭を表すリストの先頭に長さが n になるまで に 0 を追加します.
n が 3 ならば, pad0 [[2,3],[1],[]] は [[0,2,3],[0,0,1],[0,0,0]] となります.
rod x は杭を表す縦棒の両側に, 円盤の大きさ x 個のハイフンと, 余白の空白からなる文字列を返します.
n が 3 の時, rod 1 は ” -|- “, rod 2 は ” —|— ” のようになります.
line a b c は, ある行に相当する各杭の円盤の大きさから, 一行分の文字列を作ります.
format’ は, 各杭の状態を表すデータが格段の円盤の大きさ (無い場合は 0) を表すよう pad0 で変形された状態を受け取り, line で作った一行分の文字列と {各杭の次の段以後の円盤のを引数として呼び出した自分自身} と連結します.
最後の行は take (6*n + 9) $ repeat ‘=’ で適当な数の ‘=’ にします.
確認
Prelude> :l toh02_02.hs
*Main> putStrLn (format 3 [[1,2,3],[],[]])
-|- | |
--|-- | |
---|--- | |
===========================
*Main> putStrLn (format 3 [[2,3],[1],[]])
| | |
--|-- | |
---|--- -|- |
===========================
main
main = do args <- getArgs
let n | (not . null) args = read (head args)::Int
| otherwise = 3
let w | length args > 1 = read (args!!1)::Int
| otherwise = 500
printAllSteps n w $ iterf (hanoi 0 1 2 n) [[1..n],[],[]]
where
printAllSteps _ _ [] = do putStrLn ""
printAllSteps n w (x:xs) = do
usleep (w*1000)
putStr "\x1b[2J\x1b[2;1H"
putStr (format n x)
printAllSteps n w xs
printAllSteps は, w ミリ秒停止して, 端末のクリアとカーソル位置の移動, 状態の表示を行い, 残りの状態に対して同じ手順を繰り返します.
リストの最後を認識するよう 40行目があります.
引数で, 円盤の数 n と, 各状態の表示の間の待ち時間 w (ミリ秒) を与えます.
デフォルトを円盤の数 3, 待ち時間 500 ミリ秒とします.
実行してみます.
ソースコード全体は以下のようになります.
toh07.hs
import System
import System.Posix.Unistd
move :: Int -> Int -> ([[t]] -> [[t]])
move 0 1 = (\[ah:at,b,c] -> [at,ah:b,c])
move 0 2 = (\[ah:at,b,c] -> [at,b,ah:c])
move 1 2 = (\[a,bh:bt,c] -> [a,bt,bh:c])
move 1 0 = (\[a,bh:bt,c] -> [bh:a,bt,c])
move 2 0 = (\[a,b,ch:ct] -> [ch:a,b,ct])
move 2 1 = (\[a,b,ch:ct] -> [a,ch:b,ct])
hanoi :: Int -> Int -> Int -> Int -> [([[t]] -> [[t]])]
hanoi _ _ _ 0 = []
hanoi s t d n = hanoi s d t (n - 1) ++
[(move s d)] ++
hanoi t s d (n - 1)
iterf [] x = [x]
iterf (f:fs) x = x:iterf fs (f x)
format :: Int -> [[Int]] -> String
format n s = format' $ pad0 s
where
ws m = take m $ repeat ' '
bar m = take m $ repeat '-'
pad0 = map (\x -> reverse (take n ((reverse x) ++ repeat 0)))
rod x = (ws (n - x + 1)) ++ (bar x) ++ "|" ++
(bar x) ++ (ws (n - x + 1))
line a b c = (rod a) ++ (rod b) ++ (rod c) ++ "\n"
format' [[],[],[]] = (take (6*n + 9) $ repeat '=') ++ "\n"
format' [x:xs, y:ys, z:zs] = (line x y z) ++ format' [xs, ys, zs]
main = do args <- getArgs
let n | (not . null) args = read (head args)::Int
| otherwise = 3
let w | length args > 1 = read (args!!1)::Int
| otherwise = 500
printAllSteps n w $ iterf (hanoi 0 1 2 n) [[1..n],[],[]]
where
printAllSteps _ _ [] = do putStrLn ""
printAllSteps n w (x:xs) = do
usleep (w*1000)
putStr "\x1b[2J\x1b[2;1H"
putStr (format n x)
printAllSteps n w xs
追記: 2011.10.04
内容を大幅に修正しました.
追記: 2011.10.05
全然抽象的じゃないけど
move :: Int -> Int -> [[t]] -> [[t]]
move s d x = take 3 $ drop (3 - s) $ cycle $ rev
$ (\[ah:at,b,c] -> [at,ah:b,c]) $ rev $ take 3 $ drop s $ cycle x
where
rev [a,b,c] | 0 < (mod (2 + d - s) 3) = [a,c,b] | otherwise = [a,b,c]
でも一応動く.
Graham Hutton
オーム社
発売日：2009-11-11
Bryan O'Sullivan,John Goerzen,Don Stewart
オライリージャパン
発売日：2009-10-26
