グラフで深さ優先探索

写経。手続き型を無理に書いてます。
とりあえず最低限の動きはするんだけど、最適な解を出せてない。
データの調整どころの話じゃないから、なんかバグがありそう。

(use util.list)

(define discovered (make-hash-table))
(define finished (make-hash-table))
(define previous (make-hash-table))
(define color (make-hash-table))
(define (print-stat)
  (begin
    (print "========================================")
    (print "discovnered: " (hash-table->alist discovered))
    (print "finished: " (hash-table->alist finished))
    (print "previous: " (hash-table->alist previous))
    (print "color: " (hash-table->alist color))))
(define counter 0)
(define increment-counter
  (begin
    (set! counter (+ 1 counter))
    counter))

(define (depth-first-search G s)
  (define (put h k v)
    (hash-table-put! h (car k) v))
  (define (get h k)
    (hash-table-get h (car k) '()))
  (define (init-tables V)
    (for-each
     (lambda (v)
       (put discovered v -1)
       (put finished v -1)
       (put previous v -1)
       (put color v 'white))
     V))
  (define (visit-unreached V)
    (for-each
     (lambda (v)
       (if (eq? 'white (get color v))
           (visit v)))
     V))
  (define (neighbor u)
    (map
     (lambda (v)
       (find
        (lambda (x) (= (car x) v))
        G))
     (cdr u)))

  (define (iterate-neighbor u)
    (for-each
     (lambda (v)
       (if (and (pair? v) (eq? 'white (get color v)))
           (begin
             (put previous v (car u))
             (visit v))))
     (neighbor u)))
  (define (visit u)
    (put color u 'gray)
    (put discovered u increment-counter)
    (iterate-neighbor u)
    (put color u 'black)
    (put finished u increment-counter)
    )
  (lambda ()
    (let ((V G))
      (init-tables V)
      (print-stat)
      (visit s)
      (print-stat)
      (visit-unreached V)
      (print-stat)))
  )

(define maze
  (list
    (cons 0 '(1 6 8))
    (cons 1 '(0 2 3))
    (cons 2 '(1 11 10))
    (cons 3 '(1 12 4))
    (cons 4 '(3 13 5))
    (cons 5 '(4 6 9))
    (cons 6 '(5 7 0))
    (cons 7 '(9 6 8))
    (cons 8 '(7 0 14))
    (cons 9 '(100 5 7))
    (cons 10 '(2))
    (cons 11 '(2))
    (cons 12 '(3))
    (cons 13 '(4))
    (cons 14 '(8))
    )
  )

(define maze2
  (list
   (cons 0 '(1 4))
   (cons 1 '(0 2))
   (cons 2 '(1 3 6))
   (cons 3 '(2 4 6))
   (cons 4 '(0 5 3))
   (cons 5 '(4))
   (cons 6 '(2))
   (cons 7 '(8))
   (cons 8 '(7))
   )
  )

(define (route goal)
  (define (inner v)
    (let ((prev (hash-table-get previous v '())))
      (cond ((or (null? prev) (= -1 prev))
             (print "...traverse finish"))
            (else
             (print "..." prev)
             (inner prev)))))
  (inner goal))