2015年4月22日水曜日

Christopher StracheyのGPM

4クィーンパズル


バックトラックしながら全解探索する情報科学標準問題である. 普通の言語なら配列を使うわけだが, GPMでやってみようと思うと, 配列がないのでまず困る.

今回は部分解を引数の列で持ち回ることにした. つまりnクィーンを解くとしてマクロq0は第0列のs=0,1,..,n-1にクィーンを置き, sを引数としてq1を呼ぶ. q1は第1列のt=0,1,..,n-1のクィーンがsと当たっていなければ, s,tを引数としてq2を呼ぶ. ... のように作る.



クィーン同士が当るかどうかみるのにマクロ$?,a,b,d;を用意する. a,bがd離れているかみるもので, Schemeで書けば

(define (? a b d) (= (abs (- a b)) d))

となる.
$def,1+,<$1,2,3,4,5,6,7,8,9,10,
 $def,1,<~>~1;;>;
$def,1-,<$-1,0,1,2,3,4,5,6,7,8,
 $def,-1,<~>~1;;>;
$def,-,<$~2,
 $def,~2,<$-,$1-,>~1<;,$1-,>~2<;;>;,$def,0,~1;;>;
$def,lt,<$~1,
 $def,~1,<$lt,$1-,>~1<;,>~2<;>;$def,-1,t;$def,~2,f;;>;
$def,|,<$~1,$def,~1,t;,$def,f,~2;;>;
$def,?,
 <$$lt,~1,~2;,
  $def,t,<$$-,>~2<,>~1<;,
   $def,$-,>~2<,>~1<;,f;,
   $def,>~3<,t;;>;,
  $def,f,<$$-,>~1<,>~2<;,
   $def,$-,>~1<,>~2<;,f;,
   $def,>~3<,t;;>;;>;
q4はすべての列に置けたので出力するから
$def,q4,<~1,~2,~3,~4;>;
第3列に置いてみるq3は
$def,q3,<$z,0,
 $def,z,<$~1,
 $def,~1,<$
  $|,$?,>>~1<<,>~1<,0;,
  $|,$?,>>~1<<,>~1<,3;,
  $|,$?,>>~2<<,>~1<,0;,
  $|,$?,>>~2<<,>~1<,2;,
  $|,$?,>>~3<<,>~1<,0;,
  $?,>>~3<<,>~1<,1;;;;;;,
  $def,f,<$q4,>>>~1<<<,>>>~2<<<,>>>~3<<<,>>~1<<,>>>~4<<<;
   $z,$1+,>>~1<<;;>;,
  $def,t,<$z,$1+,>>~1<<;;>;;>;,
 $def,>~4<,;;>;;>;
q2, q1, q0も同様で
$def,q2,<$y,0,
 $def,y,<$~1,
 $def,~1,<$
  $|,$?,>>~1<<,>~1<,0;,
  $|,$?,>>~1<<,>~1<,2;,
  $|,$?,>>~2<<,>~1<,0;,
  $?,>>~2<<,>~1<,1;;;;,
  $def,f,<$q3,>>>~1<<<,>>>~2<<<,>>~1<<,>>>~3<<<;
   $y,$1+,>>~1<<;;>;,
  $def,t,<$y,$1+,>>~1<<;;>;;>;,
 $def,>~3<,;;>;;>;
$def,q1,<$x,0,
 $def,x,<$~1,
 $def,~1,<$
  $|,$?,>>~1<<,>~1<,0;,
  $?,>>~1<<,>~1<,1;;,
  $def,f,<$q2,>>>~1<<<,>>~1<<,>>>~2<<<;
   $x,$1+,>>~1<<;;>;,
  $def,t,<$x,$1+,>>~1<<;;>;;>;,
 $def,>~2<,;;>;;>;
$def,q0,<$w,0,
 $def,w,<$~1,
 $def,~1,<$q1,>~1<,>>~1<<;
  $w,$1+,>~1<;;>;,
 $def,>~1<,;;>;;>;
と準備出来たから実行してみる.
$q0,4; => 1,3,0,2;2,0,3,1;
4クィーンには双対のこの解しかない.

同様に引数渡しをするのでも, やはりSchemeのようにさっさっさとはいかない. Scheme版はこうだ.
(define (q0 n) (do ((s 0 (+ s 1))) ((= s n)) (q1 s n)))
(define (q1 s n) (do ((t 0 (+ t 1))) ((= t n))
 (cond ((? s t 0)) ((? s t 1))
       (else (q2 s t n)))))
(define (q2 s t n) (do ((u 0 (+ u 1))) ((= u n))
 (cond ((? s u 0)) ((? s u 2)) ((? t u 0)) ((? t u 1))
       (else (q3 s t u n)))))
(define (q3 s t u n) (do ((v 0 (+ v 1))) ((= v n))
 (cond ((? s v 0)) ((? s v 3)) ((? t v 0)) ((? t v 2))
       ((? u v 0)) ((? u v 1))
       ((= n 4) (display (list s t u v)))
       (else (q4 s t u v n)))))
(q0 4) ;=> (1 3 0 2)(2 0 3 1)

0 件のコメント: