読者です 読者をやめる 読者になる 読者になる

きくらげ観察日記

好きなことを、適当に。

Gaucheでハノイの塔

Gaucheの練習。

n個のハノイの塔の解き方を表示するプログラムです。
各板の大きさは数値として表され、数値が大きい方が大きい板となっています。
また、見やすさのため表示する際はリストの逆順(右のほうが塔の上側)となっています。

(use gauche.array)

;; n個のハノイの塔の解き方を表示する。
(define (hanoi n)
  (define towers (array (shape 0 3) (iota n 1 1) '() '()))
  (define (tower-get i) (array-ref towers i))
  (define (tower-set! i val) (array-set! towers i val))
  ;; 現在のハノイの塔を見て、1つでも小さい板の上に大きい板が乗っていたものがあった場合死ぬ
  (define (assert-towers)
    (map assert-tower '(0 1 2)))
  ;; i番目のハノイの塔を見て、
  ;; 小さい板の上に大きい板が乗っていた場合死ぬ
  (define (assert-tower i)
    (define (loop xs)
      (cond
       ((null? xs) #f)
       ((null? (cdr xs)) #f)
       (else
        (let ((x (car xs))
              (y (cadr xs))
              (rest (cddr xs)))
          (if (> x y)
              (raise "you don't know rules?????????????????")
              (loop rest))))))
    (loop (tower-get i)))
  (define (print-tower)
    (display (reverse (tower-get 0)))
    (newline)
    (display (reverse (tower-get 1)))
    (newline)
    (display (reverse (tower-get 2)))
    (newline)
    (newline))
  ;; a番目の塔の先頭m個をb番目の塔に移動する
  (define (inner-hanoi m a b c)
    (if (= m 1)
        (begin
          (tower-set! b (cons (car (tower-get a)) (tower-get b)))
          (tower-set! a (cdr (tower-get a)))
          (assert-towers)
          (print-tower))
        (begin
          (inner-hanoi (- m 1) a c b)
          (tower-set! b (cons (car (tower-get a)) (tower-get b)))
          (tower-set! a (cdr (tower-get a)))
          (assert-towers)
          (print-tower)
          (inner-hanoi (- m 1) c b a))))
  (print-tower)
  (inner-hanoi n 0 1 2))

1つコマを動かすごとにassert-towersで不正な操作がなかったか確認しているので、エラーなく終了したということはすべての手順がハノイの塔のルールを満たしていることになります。

実行例

gosh> (hanoi 3)
(3 2 1)
()
()

(3 2)
(1)
()

(3)
(1)
(2)

(3)
()
(2 1)

()
(3)
(2 1)

(1)
(3)
(2)

(1)
(3 2)
()

()
(3 2 1)
()

#<undef>
gosh> (hanoi 5)
(5 4 3 2 1)
()
()

(5 4 3 2)
(1)
()

(5 4 3)
(1)
(2)

(5 4 3)
()
(2 1)

(5 4)
(3)
(2 1)

(5 4 1)
(3)
(2)

(5 4 1)
(3 2)
()

(5 4)
(3 2 1)
()

(5)
(3 2 1)
(4)

(5)
(3 2)
(4 1)

(5 2)
(3)
(4 1)

(5 2 1)
(3)
(4)

(5 2 1)
()
(4 3)

(5 2)
(1)
(4 3)

(5)
(1)
(4 3 2)

(5)
()
(4 3 2 1)

()
(5)
(4 3 2 1)

(1)
(5)
(4 3 2)

(1)
(5 2)
(4 3)

()
(5 2 1)
(4 3)

(3)
(5 2 1)
(4)

(3)
(5 2)
(4 1)

(3 2)
(5)
(4 1)

(3 2 1)
(5)
(4)

(3 2 1)
(5 4)
()

(3 2)
(5 4 1)
()

(3)
(5 4 1)
(2)

(3)
(5 4)
(2 1)

()
(5 4 3)
(2 1)

(1)
(5 4 3)
(2)

(1)
(5 4 3 2)
()

()
(5 4 3 2 1)
()

#<undef>