グラフで深さ優先探索
写経。手続き型を無理に書いてます。
とりあえず最低限の動きはするんだけど、最適な解を出せてない。
データの調整どころの話じゃないから、なんかバグがありそう。
(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))