これを見て自分でも書いてみた。schemeっちゅーかGaucheです。
元ネタはこれらしい。
書いてみたはいいけど、ドラクエ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
> <
^
ソースはこちら。
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/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)))))))
回転方向のリスト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さん節を楽しみにしています。
追記
わさお先輩の