(define -ayalog '())

括弧に魅せられて道を外した名前のないプログラマ

ドラクエ7のバロックタワーのパズル問題にSchemeで挑んだ結果…

はい。昨晩Twitterでこんなのが流れてきました。

僕も最近毎晩のようにドラクエ7やってます。
今、ちょうど最強の呪文を覚えたりしたとこです。

ちなみに、このバロックタワーはすでにクリア済みでした。
しかも、適当に踏みまくったら、解けました(ォィ

というわけでSchemeでこの問題にチャレンジしてみた。

入出力について

想定した入出力はこんな感じ。

;;input-data
'(3 2 1 2)

;;output-data
'((1 2 3 0 2 0 3 9)
  (2 2 1 2 3 3 2 1)
  ...
  (x x x x x x x x))

入力値は0~3の数値からなるリスト、出力は@さんのブログでは、ひとつだけ答えを出力していましたが、解けるだろう組合せは幾つもあるはずなので、リストをネストさせて2次元配列のように表現したいなーと思いました*1

インプットとアウトプットの値*2に関しては、@さんのブログと合わせてあります。

配列の値は、こんな感じに。
像の番号: 上=0, 右=1, 下=2, 左=3
像の向き: 上=0, 右=1, 下=2, 左=3
ボタン: 像0と1の間=0, 像1と2の間=1, 像2と3の間=2, 像3と0の間=3

書いてみた

(define (baroque input)
  (define (ok? ls)
    (let ((model-1 (list-ref ls 0))
	  (model-2 (list-ref ls 1))
	  (model-3 (list-ref ls 2))
	  (model-4 (list-ref ls 3)))
      (and (= model-1 2)
	   (= model-2 3)
	   (= model-3 0)
	   (= model-4 1))))
 
  (define (next x)
    (let ((next-x (+ x 1)))
      (if (= next-x 4)
	  0
	  next-x)))
 
  (define (push n ls)
    (let loop ((m (next n))
	       (count 0)
	       (ls ls)
	       (out '()))
      (cond
       ((null? ls) (reverse out))
       ((= count m)
	(loop m
	      (+ count 1)
	      (cdr ls)
	      (cons (car ls) out)))
       (else
	(loop m
	      (+ count 1)
	      (cdr ls)
	      (cons (next (car ls)) out))))))
 
  (let loop ((count 0)
	     (max 8)
	     (input input)
	     (output '()))
    (cond
     ((> count max) '())
     ((ok? input)
      (reverse output))
     (else
      (list (loop (+ count 1)
		  max
		  (push 0 input)
		  (cons 0 output))
	    (loop (+ count 1)
		  max
		  (push 1 input)
		  (cons 1 output))
	    (loop (+ count 1)
		  max
		  (push 2 input)
		  (cons 2 output))
	    (loop (+ count 1)
		  max
		  (push 3 input)
		  (cons 3 output)))))))

…で、これを実行したら分かるんですけど、結果がめちゃくちゃひどいです。
2次元配列を表現しようと思ったら、案の定リストがネストしまくったうえに、空のリストまで含まれる始末。。。
いや、途中で

(else
      (list (loop (+ count 1)

とか書かざるを得ない状況になって、どうしようもなかったとかなんとか…。
正直に言えば、力不足でしたね…。出力のフォーマットがあわないことを除けば、解答パターンは出ているようなので、ひとまずここまででいいかなーとか。。。
後で頭をリフレッシュして再挑戦するとおもいます。

途中で悩んだとこ

呟いたら解決しました。

push手続きはmapで解決できるかなーと思ったんですが、「リストのn番目以外に操作を行なう」がどうしても分からなくて、少しだらだらと書いてしまってたんですが、Gaucheのライブラリで解決できました。

(use gauche.sequence)

(define (push n ls)
  (let ((m (next n)))
    (map-with-index
     (^(i e)
       (if (= i m)
	   e
	   (next e)))
     ls)))

*1:できてない…

*2:0~3の意味