Re: ドラクエVIIのバロックタワーのパズルを解く

• ドラクエ7のバロックタワーのパズル問題にSchemeで挑んだ結果… - (define -ayalog ’())

これを見て自分でも書いてみた。schemeっちゅーかGaucheです。

元ネタはこれらしい。

• ドラクエVIIのバロックタワーのパズルを解く - 虎塚

書いてみたはいいけど、ドラクエ7やったことないのでよくわからん。ので、コマンドにして表示用のオプションも付けてみた。

 % ./baroque 3 2 2 3  | head
(0 0 0 1 1 2 2 3)
(0 0 0 1 1 2 3 2)
(0 0 0 1 1 3 2 2)
(0 0 0 1 2 1 2 3)
(0 0 0 1 2 1 3 2)
(0 0 0 1 2 2 1 3)
(0 0 0 1 2 2 3 1)
(0 0 0 1 2 3 1 2)
(0 0 0 1 2 3 2 1)
(0 0 0 1 3 1 2 2)

 % ./baroque 3 2 2 3 | wc                      
   1680   13440   30240

 % ./baroque -d 10 2 3 2 3 | wc
    878    7000   15756

 % ./baroque -g 3 2 2 3                        
 <
< V
 V

 % ./baroque -g -r "(0 0 0 1 1 2 2 3)"  3 2 2 3
solve start.
 <
< V
 V
button 0 pushed.
 ^
^ V
 <

button 0 pushed.
 >
> V
 ^

button 0 pushed.
 V
V V
 >

button 1 pushed.
 <
< <
 >

button 1 pushed.
 ^
^ ^
 >

button 2 pushed.
 >
^ >
 V

button 2 pushed.
 V
^ V
 <

button 3 pushed.
 V
> <
 ^

ソースはこちら。

• コマンドにしてみた。

	#!/usr/bin/gosh
	;; baroque
	(use gauche.parseopt)
	(use srfi-1) ; circular-list
	;;
	;; solver
	;;
	(define-constant +north+ 0)
	(define-constant +east+ 1)
	(define-constant +south+ 2)
	(define-constant +west+ 3)
	(define directions (circular-list +north+ +east+ +south+ +west+))
	(define solved-direction (list +south+ +west+ +north+ +east+))
	(define (solved? statues)
	(equal? statues solved-direction))
	(define (turn statue)
	(~ directions (+ statue 1)))
	(define (make-button statue-indices)
	(^(statues)
	(map (^(statue i)
	(if (any (pa$ = i) statue-indices)
	(turn statue)
	statue))
	statues
	(iota (length statues)))))
	(define button0 (make-button (list 0 2 3)))
	(define button1 (make-button (list 0 1 3)))
	(define button2 (make-button (list 0 1 2)))
	(define button3 (make-button (list 1 2 3)))
	(define (search statues depth-limit)
	(let rec ((statues statues)(acc '())(route '()))
	(cond
	((solved? statues)(cons (reverse route) acc))
	((= depth-limit (length route)) acc)
	(else (let1 next (^(button i)
	(rec (button statues) acc (cons i route)))
	(append (next button0 0)
	(next button1 1)
	(next button2 2)
	(next button3 3)
	acc))))))
	(define baroque search)
	;;
	;; printer
	;;
	(define (print-baroque statues)
	(define north "^")
	(define east ">")
	(define south "V")
	(define west "<")
	(define space " ")
	(define figures (list north east south west))
	(define (get-figure statue)
	(~ figures (~ statues statue)))
	(print space (get-figure 0))
	(display (get-figure 3))
	(display space)
	(display (get-figure 1))
	(print)
	(print space (get-figure 2))
	)
	(define (print-baroque/route statues route)
	(let1 buttons (list button0 button1 button2 button3)
	(print "buttons:")
	(print "3V0")
	(print "> <")
	(print "2^1")
	(print)
	(print "solve start.")
	(print-baroque statues)
	(print)
	(fold (^(r acc)
	(let1 acc ((~ buttons r) acc)
	(print "button " r " pushed.")
	(print-baroque acc)
	(print)
	acc))
	statues
	route)))
	;;
	;; command
	;;
	(define-constant +statue-count+ 4)
	(define (usage cmd)
	(print "usage: " cmd " [- | -g | -g -r (n ...)] statue0 statue1 statue2 statue3")
	(print "\
	statue[n] = direction 0(top), 1(right), 2(bottom) or 3(left).
	example: % " cmd " 3 2 2 3")
	(print "\
	options:
	-h | --help print this usage and exit.
	-g | --graph print statues graphical.
	-r | --route print solved process.
	example: " cmd " -g -r \"(0 0 0 1 1 2 2 3)\" 3 2 2 3
	-d | --depth-limit limit of search depth. default 8.
	")
	(exit))
	(define (main args)
	(let-args (cdr args)
	((help "h|help" => (cut usage (car args)))
	(graph "g|graph")
	(route "r|route=e")
	(depth-limit "d|depth-limit=i" 8)
	(else (opt . _)
	(print "Unknown option : " opt)
	(usage (car args)))
	. rest)
	(let1 statues (map string->number rest)
	(cond
	((or (null? rest)
	(not (= (length rest) +statue-count+)))(usage (car args)))
	(graph (if route
	(print-baroque/route statues route)
	(print-baroque statues)))
	(else (for-each print
	(baroque statues depth-limit)))))))

view raw baroque.scm hosted with ❤ by GitHub

回転方向のリストdirectionsは循環リストにしているので、turn手続きでは常に現在の要素（方向）の次の要素を参照すれば良い。

% rlwrap gosh
gosh> (use srfi-1)
#
gosh> (define directions (circular-list 0 1 2 3))
directions
gosh> (~ directions 0)
0
gosh> (~ directions 3)
3
gosh> (~ directions 4)
0
gosh> (~ directions 7)
3
gosh> (~ directions 100)
0
gosh> (~ directions 101)
1

make-button手続きは回転させる彫像のインデックスを渡してあげれば、それらの彫像を回転させる手続きを返してくれる。
探索手続きsearchでは常にrouteに経路を保存しつつ再帰しているので、routeの要素数を数えれば探索の深さがわかるため、routeの要素数が制限depth-limitに達したら止まる。

そう言えば今日はオライリーのLand of Lispの発売日らしいですね！amazonで予約しとりますがいつ届くのかなー。shiroさん翻訳らしいので、shiroさん節を楽しみにしています。

追記

わさお先輩の

• baroque.scm