迷路

queueのはずがqueue-pop!、queue-push!を使っていて失敗。
いつの間にかdfsになっていた。
確かに問題があらかじめ解っていたら30分くらいで書けるのかもしれない。
「使い慣れた言語があること」を評価基準にしているのかもしれない。

おもしろいと思ったこと

• 異同順序をhash-tableから取ってくるときに、unfoldが使える。
• listに変更を加える際には、"(ref (car (list-tail )) )"
• 範囲外に出てしまう座標を見つけるのにand-let*はかなり便利

code

(use util.queue)
(use util.match)
(use srfi-1)

(define (read-maze file)
  (call-with-input-file file
    (lambda (in) (map string->list (port->string-list in)))))

(define (find-start&goal maze)
  (define (search elt)
    (let/cc return
      (fold (lambda (line y)
	      (cond ((list-index (pa$ char-ci=? elt) line)
		     => (lambda (x) (return (list y x))))
		    (else (+ y 1))))
	    0 maze)))
  (values (search #\S) (search #\G)))

(define (next-move-point maze p)
  (match-let1 (y x) p
    (let1 seq
	(list (list y (+ x 1))
	      (list (- y 1) x)
	      (list (+ y 1) x)
	      (list y (- x 1)))
      (filter (lambda (pt) 
		(match-let1 (y x) pt
		  (and-let* ((line (list-ref maze y #f))
			     (c (list-ref line x #f)))
		    (not (char-ci=? #\* c)))))
	      seq))))

(define (bfs maze start goal)
  (let ((hist (make-hash-table 'equal?))
	(queue (make-queue)))
    (define (next p)
      (for-each (lambda (nextp)
		  (unless (hash-table-exists? hist nextp)
		    (enqueue! queue nextp)
		    (hash-table-put! hist nextp p)))
		(next-move-point maze p))
	(dequeue! queue))
    (define (end-action p)
      (unfold (cut equal? <> start)
	      identity
	      (cut hash-table-get hist <>)
	      (hash-table-get hist p)))
    (let loop ((p (next start)))
      (if (equal? p goal) (end-action p) (loop (next p))))))

(define (maze-set! maze p c)
  (match-let1 (y x) p
    (set! (car (list-tail (ref maze y) x)) c)))

(define (maze-show maze)
  (for-each (compose print (cut apply string <>))
		maze))

(define (main args)
  (let* ((file (cadr args))
	 (maze (read-maze file)))
    (receive (start goal) (find-start&goal maze)
      (rlet1 history (bfs maze start goal)
	(for-each (cut maze-set! maze <> #\$) history)
	(maze-show maze))))
  0)