LoginSignup
8
9

More than 5 years have passed since last update.

3種類のアニメーション in Clojure - ハノイの塔

Posted at

副作用の分離

入出力を行わず, グローバルな状態から影響を受けたり, 影響を及ぼしたりしないコードの割合を相対的に増やすことで,

  • 自動テスト可能な割合が増える
  • ロジック部分が汎用的になり, 入出力形式を交換しやすくなる

などの利点があります.

この副作用の分離を行う練習として, 以前, ハノイの塔を解いている途中過程を三種類の方法でアニメーション表示するプログラムを書きました.

書いてから随分経ちますが, 陳腐化しにくい内容ですので, どなたかの役に立つかもしれないと思い, 眠っていたコードを発掘して公開いたしました.

今回はこのソースコードの解説を書かせていただきたいと思います.

解説の粒度は, Clojure の基本文法について習得している, または, なんらかのリファレンスを参照しながら取り組める方で, 演習問題の実装を行う段階以上の方を想定しています.
焦点は, 副作用の分離に絞っています.

また, 本プログラムは, スタンドアロンのアプリケーションにはなっておらず, 動作させるには開発環境が必要です. といっても leingen とお好みのエディタで十分です.

本題は出力のみの分離ですが, 副作用分離の意義や方法の一端は伝えられるかと思います.
今後, 入力の分離についても別の題材でお伝えできればと思います.

ハノイの塔とは

「ハノイの塔」は, 三つの杭のうちの一つに下から大きい順に刺さった大きさの異なる円盤を, 自身より大きな円盤を上に乗せてはいけないという規則を守りつつ, 別の杭に移動させるというパズルです.
詳細は Wikipedia/ハノイの塔 などをご覧ください.

ハノイの塔を解く手順は古典的な再帰手順の例であり, 三本の杭 s, t, d があるとき,

n 番目以下全ての円盤を杭 s から 杭 d に動かすには

n-1 番目以下全ての円盤を杭 s から杭 t に動かし,
n 番目の円盤を杭 s から杭 d に動かし,
n-1 番目以下全ての円盤を杭 t から杭 d に動かします.
n が 0 の時は何もしません.

となります.
そして, この手順を出力するプログラムは格好の再帰プログラミングの題材として有名です.
が, 今回は再帰プログラミングが焦点ではありません.

手順のリスト

ここで肝心なことは, 外界になんらかの出力を行う (標準出力に印字するなど) コードを, 手順を計算するコードに埋め込まず, なんらかのデータ構造で 返り値として 手順を返す関数を作成することです.

それによって,

  • 手順の計算があっているかどうか, テストケースに対する自動テストが可能になり,
  • 返された手順を, どのように出力するか, もしくはさらに変換するかを, この関数を呼び出すコードの側で, 選べる・変えられる・複数用意できる

ことになります.

さて, 手順を返す関数です.

src/toh/core.clj
(defn operations [src tmp dst n]
  (if (pos? n)
      (concat (operations src dst tmp (dec n))
              [[src dst n]]
              (operations tmp src dst (dec n)))
      []))

operations は, 杭ラベル src の杭に積んである n 以下 1 までの円盤番号の円盤を, 杭ラベル dst の杭に動かす手順を「手」のシーケンスで返します.
「手」は [杭ラベルs 杭ラベルt 円盤番号] の形式で, 杭ラベルs の杭から 杭ラベルt の杭に 円盤番号 の円盤を移すことを意味します.
杭のラベルは, 3 つの杭を区別できる限りにおいて任意のデータ型, 円盤番号は, 円盤の大きさを表す 1 以上の整数, 円盤番号 0 は移すべき円盤が無いことを表します.

  • 再帰の終了条件, n が正でなければ空のベクタ [] を返すこと,
  • n - 1 以下の円盤を動かす手順を operations の再帰呼び出しで行っていること,
  • concat は複数のシーケンスを連結しますので, 真ん中の円盤 n を動かす箇所は, n を動かす手 [src dst n] を一つ含むシーケンス [[src dst n]] になっていること,

などに注意してください.

テストです.

test/toh/core_test.clj
(deftest operations-test
  (are [src tmp dst n _ r] (= (operations src tmp dst n) r)
    :A :B :C 3 -> '([:A :C 1] [:A :B 2] [:C :B 1] [:A :C 3]
                    [:B :A 1] [:B :C 2] [:A :C 1])
    0  1  2  3 -> '([0 2 1] [0 1 2] [2 1 1] [0 2 3]
                    [1 0 1] [1 2 2] [0 2 1])))
  • テストの実行
  • REPL から手動で別のテストケースの動作を確認
  • テストコードへのテストケースの追加

などしてみてください.

状態のリスト

さて, 円盤を移動する過程をなんらかの方法で描画したいとしますと, 手順を順に適用している途中の状態が必要になります.

この場合も

  • 状態を計算するコードに描画コードを埋め込まない.
  • 描画系に状態を覚えさせ, 差分だけ描画系に伝えるような書き方をしない.

といったことに留意します.

状態の遷移をシーケンスで返す関数です.

src/toh/core.clj
(defn peg-states [n]
  (reductions (fn [state [src dst i]]
                (assoc state src (rest (state src))
                             dst (cons i (state dst))))
              [(range 1 (inc n)) '() '()]
              (operations 0 1 2 n)))

peg-states は, 杭ラベル 0, 1, 2 の杭に対し, 杭ラベル 0 の杭に積んである n 個の円盤を, 杭ラベル 2 の円盤に移す過程を「状態」のシーケンスで返します.

  • 「状態」は, 杭ラベル 0, 1, 2 の「杭の状態」がその順にならんだシーケンスです.
  • 「杭の状態」は, その杭に積んである円盤の円盤番号を上から(小さい方から)並べたシーケンスです.

引数に

  • 累算器の値となんらかの要素から次の累算器の値を返す関数
  • 累算器の初期値
  • シーケンス

を与えると, シーケンスの要素に対して, 順に関数を適用して累算器の状態を更新し, 最終的な累算器の値を返してくれる関数 reduce はご存知かと思いますが, reductions は途中過程の累算器の値をすべてシーケンスで返します.

(fn [state [src dst i]] ...) の部分が, 累算器の値 = 「状態」state と, なんらかの要素 =「手」[src dst i] から, 次の累算器の値 = 「状態」を返す関数です.

REPL で

user=> ((fn [state [src dst i]] (assoc state src (rest (state src)) dst (cons i (state dst)))) '[(1 2) () ()] [0 1 1])
[(2) (1) ()]

のようにすると, 0番の杭に円盤 1,2 が積んである「状態」から, 杭 0 から杭 1 に円盤 1 を移す「手」を適用すると, 0番の杭に円盤 1 が, 1番の杭に円盤 2 が積まれた新しい「状態」を返すことがわかります.

[(range 1 (inc n)) '() '()] が最初の状態, (operations 0 1 2 n) が適用すべき「手」のシーケンスです.

テストです.

test/toh/core_test.clj
(deftest peg-states-test
  (are [n _ r] (= (peg-states n) r)
    2 -> '([(1 2) (   ) (   )]
           [(  2) (  1) (   )]
           [(   ) (  1) (  2)]
           [(   ) (   ) (1 2)])
    3 -> '([(1 2 3) (     ) (     )]
           [(  2 3) (     ) (    1)]
           [(    3) (    2) (    1)]
           [(    3) (  1 2) (     )]
           [(     ) (  1 2) (    3)]
           [(    1) (    2) (    3)]
           [(    1) (     ) (  2 3)]
           [(     ) (     ) (1 2 3)])))

前節同様, テストケースの追加など行ってみてください.

移動途中のすべての円盤の位置のリスト

さて, 描画しましょうか.

いいえ, 前節のまま描画すると, 杭から杭に円盤がワープしてしまいます.
今私は, ある一回の「手」における円盤を杭から抜いて, といった移動途中の位置もアニメーションで描画したいのです.

そこで, さらにもう一歩, 移動途中の円盤の位置計算をするコードを, 描画コードに埋め込まず, 独立した関数として実装したいと思います.

n 枚の円盤からなるハノイの塔を考えます. 横から見ます. 以下, 単位長さの倍数で考えます.

  • 円盤番号 i の円盤は厚み方向に 1, 直径方向に 2*n + 1 の大きさを保有,
  • 杭の長さ n + 1,
  • 杭の間隔は 2*(n + 1),
  • 板は 6*n + 7,

のように確保し, 座標系に

              111111111
y\x 0123456789012345678
0
1      |     |     |
2     -|-    |     |
3    --|-- --|-- --|--
4   =================== n+2
       |     |     |
       |     |     +- 2*(n+1)*2 + (n + 1)
       |     +------- 2*(n+1)*1 + (n + 1)
       +------------- 2*(n+1)*0 + (n + 1)

のように配置するものとします.

円盤を移動する場合は, y = 0 まで単位長さずつ上に動かし, 目的杭の上まで単位長さずつ横に動かし, 目的杭にすでに乗っている一番上の円盤の単位長さだけ上まで, 単位長さずつ下に移動します.

手順を適用する過程の, すべての円盤の移動途中の位置の推移を返す関数です.

(defn disk-states [n]
  (let [get-x (comp first second)
        get-y (comp second second)
        disks (fn [state x] (filter #(= (get-x %) x) state))
        top-disk #(first (sort-by get-y %))]
    (apply concat
      (reductions
        (fn [transients [src dst i]]
          (let [state (last transients)
                [src-x src-y] (state i)
                dst-x (* (inc (* 2 dst)) (inc n))
                dst-y (->> (disks state dst-x)
                        (cons [n [dst-x (+ 2 n)]]) ; sentinel
                        top-disk get-y dec)]
            (mapv #(assoc state i %)
                  (concat (for [y (range (dec src-y) -1 -1)] [src-x y])
                          (for [x (if (< src-x dst-x)
                                      (range (inc src-x) dst-x)
                                      (range (dec src-x) dst-x -1))]
                            [x 0])
                          (for [y (range (inc dst-y))] [dst-x y])))))
        [(into {} (map #(vector % [(inc n) (inc %)]) (range 1 (inc n))))]
        (operations 0 1 2 n)))))

disk-states は, n 枚のハノイの塔を解く過程の「すべての円盤の位置」のシーケンスで返します.

  • 「すべての円盤の位置」は, 「円盤番号」をキーとし, その円盤の「円盤の位置」を値とするハッシュマップです.
  • 「円盤の位置」は, 上記座標系における円盤の中心の「座標」です.
  • 「座標」は, [x y] の形式のベクタです.

(fn [transients [src dst i]] ...) が, 1手あたりの「『すべての円盤の位置』の推移」になります. 前の手における「『すべの円盤の位置』の推移」が transients であるときに, 杭 src から, 杭 dst に, 円盤 i を動かす場合の「『すべての円盤の位置』の推移」を返します. このとき (last transients) で, 前の手における「『すべての円盤の位置』の推移」の最後の「すべての円盤の位置」から今回の手における推移を計算します.

[(into {} ...)] が, 最初の「『すべての円盤の位置』の推移」で, これは, 最初の「すべての円盤の位置」(into {} ...) だけからなるシーケンスです.

(reductions ...) が返すのは, 【1手あたりの「『すべての円盤の位置』の推移」】のシーケンスですので, (apply concat ...) で, 全ての手を順に適用したときの全ての『すべての円盤の位置』のシーケンスにしています.

テストです.

test/toh/core_test.clj
(deftest disk-states-test
  (are [n _ r] (= (disk-states n) r)
    ;     disk1 x y disk2 x y
    2 -> '({1 [ 3 2] 2 [ 3 3]}    ;               111111111
           {1 [ 3 1] 2 [ 3 3]}    ; y\x 0123456789012345678
           {1 [ 3 0] 2 [ 3 3]}    ; 0                    
           {1 [ 4 0] 2 [ 3 3]}    ; 1      |     |     |   
           {1 [ 5 0] 2 [ 3 3]}    ; 2     -|-    |     |   
           {1 [ 6 0] 2 [ 3 3]}    ; 3    --|--   |     |   
           {1 [ 7 0] 2 [ 3 3]}    ; 4   ===================
           {1 [ 8 0] 2 [ 3 3]}    ; ...
           {1 [ 9 0] 2 [ 3 3]}    ; 0     - -            
           {1 [ 9 1] 2 [ 3 3]}    ; 1      |     |     |   
           {1 [ 9 2] 2 [ 3 3]}    ; 2      |     |     |   
           {1 [ 9 3] 2 [ 3 3]}    ; 3    --|--   |     |   
           {1 [ 9 3] 2 [ 3 2]}    ; 4   ===================
           {1 [ 9 3] 2 [ 3 1]}    ; ...
           {1 [ 9 3] 2 [ 3 0]}    ; 0           - -      
           {1 [ 9 3] 2 [ 4 0]}    ; 1      |     |     |   
           {1 [ 9 3] 2 [ 5 0]}    ; 2      |     |     |   
           {1 [ 9 3] 2 [ 6 0]}    ; 3    --|--   |     |   
           {1 [ 9 3] 2 [ 7 0]}    ; 4   ===================
           {1 [ 9 3] 2 [ 8 0]}    ; ...
           {1 [ 9 3] 2 [ 9 0]}    ; 0                    
           {1 [ 9 3] 2 [10 0]}    ; 1      |     |     |   
           {1 [ 9 3] 2 [11 0]}    ; 2      |     |     |   
           {1 [ 9 3] 2 [12 0]}    ; 3    --|--  -|-    |   
           {1 [ 9 3] 2 [13 0]}    ; 4   ===================
           {1 [ 9 3] 2 [14 0]}    ; ...
           {1 [ 9 3] 2 [15 0]}    ; 0    -- --           
           {1 [ 9 3] 2 [15 1]}    ; 1      |     |     |   
           {1 [ 9 3] 2 [15 2]}    ; 2      |     |     |   
           {1 [ 9 3] 2 [15 3]}    ; 3      |    -|-    |   
           {1 [ 9 2] 2 [15 3]}    ; 4   ===================
           {1 [ 9 1] 2 [15 3]}    ; ...
           {1 [ 9 0] 2 [15 3]}    ; 0                -- --
           {1 [10 0] 2 [15 3]}    ; 1      |     |     |   
           {1 [11 0] 2 [15 3]}    ; 2      |     |     |   
           {1 [12 0] 2 [15 3]}    ; 3      |    -|-    |   
           {1 [13 0] 2 [15 3]}    ; 4   ===================
           {1 [14 0] 2 [15 3]}    ; ...
           {1 [15 0] 2 [15 3]}    ; 0                     
           {1 [15 1] 2 [15 3]}    ; 1      |     |     |   
           {1 [15 2] 2 [15 3]}))) ; 2      |     |     |   
                                  ; 3      |    -|-  --|-- 
                                  ; 4   ===================
                                  ; ...

端末アニメーション

前節までで, テストコードのコメントに記したような =, -, | と空白を使った文字列表現で, 端末にアニメーションする準備が整いました.

src/toh/terminal.clj

が端末にアニメーション描画するコードです.

ただし, さらにしつこく, 端末に表示する=, -, | と空白を使った文字列を生成する関数represent-fn を副作用なしで作成してテストし, 本当に描画を実行する関数 display は 6 行からなることに留意してください.

represent-fn のテストコードは, with-test で, 同ソースファイルの, 関数定義の直後に置いています.

長方形の位置, 大きさ, 色も副作用なしで

端末描画だと寂しいので, もう少しグラフィカルにしたいです.

端末描画の時と同じ方向からみて, 単位長さの倍数表現において同じように, 円盤, 杭, 板を配置して描画するものとし, ただし, 単位長さが 1文字ではなく, 数ピクセルからなるような, ピクセルマップ表示を考えたく思います.

描画イメージは デモ動画 の後半をみてください.

ここで, 各要素を長方形で描画するものとし, しつこく, しつこく

  • ピクセルマップの座標系における長方形の座標
  • 色相環に均等に配置した n 個の円盤の色

など計算するコードを, 描画系コードに埋め込まずに記載します.

src/toh/twod.clj
(defn rectangles-fn [n unit]
  (let [base [[0
               (* (+ 2 n) unit)
               (* (+ (* 6 n) 7) unit)
               unit
               [0.0 1.0 0.3]]]
        pegs (for [pi '(0 1 2)]
               [(* (inc (* 2 pi)) (inc n) unit)
                unit
                unit
                (* (inc n) unit)
                [0.0 1.0 0.3]])
        colors (mapv #(vector (float (/ % n)) 0.8 1.0) (range n))]
    (fn [state]
      (concat base pegs
        ; disks
        (for [[i [ux uy]] state]
          [(* (- ux i) unit)
           (* uy unit)
           (* (inc (* 2 i)) unit)
           unit
           (colors (dec i))])))))

rectangles-fn は, 円盤の数 n と単位長さ unit を与えると「すべての円盤の位置 state を与えると, すべての描画すべき長方形のシーケンスを返す関数」を返す関数です.

  • 「すべての円盤の位置」は, 前々節と同じ形式です.
  • 「すべての描画すべき長方形のシーケンス」には, 板, 杭, すべての円盤が含まれます.
  • 「描画すべき長方形」は [X座標 Y座標 幅 高さ 色] の形式
  • 「色」は [色相 彩度 明度] の形式

base が板を表す長方形, pegs が三つの杭, (for ...)state で単位長さベースの位置を与えられたすべての円盤を表す長方形です.

板と杭の色はハードコード, 円盤の色は彩度と明度を固定し, 色相は色相環を n 等分して, 1~n の円盤に割り当てます.

こちらはテストを書いていませんが, テストケースを設定すればテスト可能です. トライしてみてください.

Window 描画と Web ブラウザ描画

前節までで, なるべく描画系に依存しないコードで, グラフィカルアニメーションの準備が整いましたので, 異なる描画系に描画できることを実証すべく,

を書きました.

使い方は README に書いていますので, 動作させてみてください.

描画コードの解説は割愛します. というのも, ここへ至るまでの描画系に依存しないコードが主な着眼点でした. 描画コード自体はかなりアドホックですので, 参考になさらない方が良いかもしれません. もちろん興味のある方は解読していただき, より整理された書き方にトライしてみてください.

最後に

先に述べたように 3種類の描画コードを実際に行うコードはアドホックですが, 量が少ないです.

重要なことは, データを変換するコードは実際に入出力を行うコードに埋もれさせず,
仕様が明確でテストが可能な関数として外に出すことです.

本投稿が, その具体例, 演習課題としてどなたかの助けになればと思います.

ありがとうございました.

8
9
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
8
9