練習問題 1 (解答例)

1. モービルの問題(詳細)

a. left-branch, right-branch, branch-length, branch-structure を定義せよ

これは、mobile, branch がリスト構造をもちいてどのように表されているかに応じて、 そのまま記述すれば良い。ちなみに、このような関数は field を選択して値をとって来るため、 selector とも呼ばれる。

(define (left-branch mobile) (car mobile))
(define (right-branch mobile) (cadr mobile))

(define (branch-length branch) (car branch))
(define (branch-structure branch) (cadr branch))

b. モービルに対して、その総重量をかえす total-weight を a. の関数を もちいて定義せよ。

総重量を返すに当たって、structure がモービルであるか、ただのおもりであるかを判定する 関数を定義した。これは、おもりやモービルがそれぞれどのようなデータ構造で表現 されたかによる部分である。

(define (leaf-weight? structure)  (number? structure))

この関数ならびに、上述の selector を用いて、total-weight は以下のように 再帰的に定義できる。

(define (weight-value weight-obj) weight-obj)
(define (mobile-total-weight mobile) 
    (+ (total-weight (branch-structure (left-branch mobile)))
       (total-weight (branch-structure (right-branch mobile)))))

(define (total-weight structure)
  (if (leaf-weight? structure)
      (weight-value structure)
    (mobile-total-weight structure)))

c. モービルがバランスしているかどうかを返す、 mobile-balanced? を定義せよ。

モービルがバランスしているかどうか判定するには、 左右の子供がバランスしており、自分自身がバランスしていればよい。 以下は、プログラム例である。

(define (branch-moment branch)
  (* (total-weight (branch-structure branch))
     (branch-length branch)))

(define (mobile-balanced? structure)
  (if (leaf-weight? structure)
      #t
      (and (mobile-balanced? 
	    (branch-structure (left-branch structure)))
	   (mobile-balanced?
	    (branch-structure (right-branch structure)))
	   (= (branch-moment (left-branch structure))
	      (branch-moment (right-branch structure))))))

d. モービルのデータ構造を以下の様に変更した場合にプログラムの変更点を考えよ。

;;; Structure := Mobile | Weight
;;; Mobile := ('Mobile left-structure right-structure)
;;; Weight := ('Weight weight-value)

(define (make-mobile left right) (list 'Mobile left right))
(define (make-weight value)      (list 'Weight value))
  

今回変更されたのは、mobile と重みのデータ構造のみである。 つまり、以上のような実装法をしている場合、変更個所は

• a. で定義した selector ならびに、
• b. で定義した おもりかモービルかの判定関数と
• b. のweight-value (weight object の selector)

のみである。 とはいえ、constructor が変わったので、 sample-mobile0,1 のところも 変更が生じますが。

;;; mobile selector
(define (left-branch mobile) (cadr mobile))
(define (right-branch mobile) (caddr mobile))

;;; weight-obj selector
(define (weight-value  weight-obj) (cadr weight-obj))

;;; mobile/weight type predicate
(define (leaf-weight? structure) (eq? (car mobile) 'Weight))
     

つまり、データ構造へのアクセス手段を別途記述しておくことで、 データ構造変更への対応が容易に行える。 これは、C プログラミングの時も同様であり、 しばしば、header file に各種 constructor/selector が マクロの形でまとめて定義されている。

問題にもどる

2. N-Queen パズルの解の個数を返す program を作れ。

とりあえず、自分で作ってみましょう。 解答例はこの後に載せます。 この解答は枝刈を行った例です。

実は、この解答自身はあまり高速化を狙わず simple につくってます。 どこが simple かと言うと、safe の check の為に線形探索を行ってます。 他の方法として、行方向ならびに斜め方向の影を作っておく方法があり、 この場合 safety check を高速におこなうことができるでしょう。 影を bit mask として表現しておくと、さらに早いでしょう。 ただ、それではリストをつかったプログラミングの練習にはあまりならない:-)

ということで、以下の解答例に落ち着きました。 日本語のコメントつきです。

;;;
;;; N-Queen Problem
;;;


;;;
;;; ボードの定義と board-safe? の定義
;;;
;;; ボードの構成は、(row_k ... row_0)となっており、これは各々
;;; Queen が i 列 (row_i)-th 行 にいることを示している。
;;;

(define (board-init) (list))

(define (board-with-new-queen col row board)
  (cons row board))

(define (board-safe?-gen-iter row step board)  ; step はどちら方向に探すかの指定
  (if (null? board) ; もし、board を探しつくしてもunsafe なものがなかったなら、
      #t            ; #t を返す。
      (let ((new-row (+ row step))) ; new-row は、対応する row の値
	(if (= new-row (car board)) ; もし、board に unsafe な Queen があったら
	    #f                      ; #f をかえし、
	    (board-safe?-gen-iter new-row ; さもなくば、次の column を探す。
				  step
				  (cdr board))))))

(define (board-safe?-col-direction col row board)  ; column 方向に調べる
  (board-safe?-gen-iter row 0 board))
(define (board-safe?-major-direction col row board) ; 斜め方向その 1 を調べる
  (board-safe?-gen-iter row +1 board))
(define (board-safe?-minor-direction col row board) ; 斜め方向その 2 を調べる
  (board-safe?-gen-iter row -1 board))

(define (board-safe? col row board)
  (and (board-safe?-col-direction col row board)
       (board-safe?-major-direction col row board)
       (board-safe?-minor-direction col row board)))
;;;
;;; Result Data
;;;

;(define (result-init) '())
;(define (result-add board result) (cons board result))

(define (result-init) 0)                           ; 値はただのint
(define (result-add board result) (+ 1 result))    ; 解が見つかればincrement

;;;
;;; Nqueen Program Main
;;;

(define (nq-row-iter col row size board result)
  (if (= row size)
      result        ; row をすべてしらべつくしたらおしまい。
      (let ((this-node-result                
	     (if (board-safe? col row board) ; この row において安全なら
		 (nq-col-iter (+ 1 col)      ; 子(先のcolumn)をしらべる。
			      size
			      (board-with-new-queen col row board)
			      result)
		 result)))                   ; さもなくば枝刈して
	(nq-row-iter col        ; 次の row  をしらべる
		     (+ 1 row)
		     size
		     board
		     this-node-result))))

(define (nq-col-iter col size board result)
  (if (= col size)               
      (result-add board result) ; column を調べ尽くした時、即ち解をみつけた
      (nq-row-iter col 0 size board result)))
  
(define (nqueen size)
  (nq-col-iter 0 size (board-init) (result-init)))

問題にもどる