ハノイの塔

Scheme 30分プログラム

30分プログラム、その366。ハノイの塔を解いてみる。
そういえば、ハノイの塔は解いたことがなかったので、いまさらチャレンジしてみる。
Wikipediaを見たら、引数の順序を入れかえて一つの関数で済ませていたので、混乱してしまった。そこで、引数の順序を固定して、動かすパターン(AからBへ、など)ごとに関数を定義してみた。量がすごいことになったので、やっぱりWikipediaに書いてあるほうがスマートだ。
ところで、ハノイって実在の地名だったんだ・・・。

使い方

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

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-
;;
;; hanoi.scm -
;;
;; Copyright(C) 2008 by mzp
;; Author: MIZUNO Hiroki / mzpppp at gmail dot com
;; http://howdyworld.org
;;
;; Timestamp: 2008/09/16 21:59:39
;;
;; This program is free software; you can redistribute it and/or
;; modify it under MIT Lincence.
;;
(use srfi-1)
(define (make-tower n)
  (iota n 1))

(define (one? xs)
  (eq? (cdr xs) '()))

(define (pull a)
  (cdr a))
(define (push a b)
  (cons (car a) b))

(define (list-x . x)
  (print x)
  x)

;; a => {b,c}
(define (a=>b n a b c)
  (if (= n 1)
      (list-x (pull a)
	      (push a b)
	      c)
      (let* [(t1 (a=>c (- n 1) a b c))
	     (t2 (apply a=>b 1 t1))
	     (t3 (apply c=>b (- n 1) t2))]
	t3)))

(define (a=>c n a b c)
  (if (= n 1)
      (list-x 
       (pull a)
       b
       (push a c))
      (let* [(t1 (a=>b (- n 1) a b c))
	     (t2 (apply a=>c 1 t1))
	     (t3 (apply b=>c (- n 1) t2))]
	t3)))

;; b => {c,a}

(define (b=>c n a b c)
  (if (= n 1)
      (list-x a
	      (pull b)
	      (push b c))
      (let* [(t1 (b=>a (- n 1) a b c))
	     (t2 (apply b=>c 1 t1))
	     (t3 (apply a=>c (- n 1) t2))]
	t3)))

(define (b=>a n a b c)
  (if (= n 1)
      (list-x (push b a)
	      (pull b)
	      c)
      (let* [(t1 (b=>c (- n 1) a b c))
	     (t2 (apply b=>a 1 t1))
	     (t3 (apply c=>a (- n 1) t2))]
	t3)))

;; c => {a,b}
(define (c=>a n a b c)
  (if (= n 1)
      (list-x (push c a)
	    b
	    (pull c))
      (let* [(t1 (c=>b (- n 1) a b c))
	     (t2 (apply c=>a 1 t1))
	     (t3 (apply b=>a (- n 1) t2))]
	t3)))

(define (c=>b n a b c)
  (if (= n 1)
      (list-x a
	    (push c b)
	    (pull c))
      (let* [(t1 (c=>a (- n 1) a b c))
	     (t2 (apply c=>b 1 t1))
	     (t3 (apply a=>b (- n 1) t2))]
	t3)))

(define (hanoi n)
  (define a (make-tower n))
  (define b (make-tower 0))
  (define c (make-tower 0))
  (a=>c n a b c))

参考