;@
;;;======================================================================
;;;
;;;   Make a scan-based algorithm. This includes Bellman's Algorithm.
;;;
;;;   Arguments:
;;;             make-data-structure
;;;             value-function
;;;             better?
;;;
;;;======================================================================

(define (make-scan-based-algorithm
          make-data-structure value-function better?)
  (lambda (graph root)
    (use-methods
      ((graph ( set-label! set-predecessor! second-node link-length
                           for-each-node for-each-link-of-node
                           number-of-nodes)))
      (let* ((encapsulation (make-data-structure (number-of-nodes) better?))
             (push!? (encapsulation 'push!?))
             (label (encapsulation 'v-ref))
             (iterate-pop! (make-encapsulation-iterator encapsulation)))
        (for-each-node (lambda (x) (set-predecessor! x '())))
        (push!? root 0)
        (iterate-pop!
          (lambda (node)
            (for-each-link-of-node
              (lambda (link)
                (let ((new-node (second-node link)))
                  (if (push!?
                        new-node
                        (value-function (label node) (link-length link))))
                  (set-predecessor! new-node link))))
              node)))
        (for-each-node (lambda (node) (set-label! node (label node))))))))


;@
;;;======================================================================
;;;
;;;   Make a scan-based algorithm with node marking.
;;;   This includes Dijkstra's and Prim's algorithms.
;;;
;;;   Arguments:
;;;             make-data-structure
;;;             value-function
;;;             better?
;;;
;;;======================================================================

(define (make-scan-based-algorithm-with-mark
          make-data-structure value-function better?)
  (lambda (graph root)
    (use-methods
      ((graph ( set-label! set-predecessor! second-node link-length
                           for-each-node for-each-link-of-node
                           number-of-nodes)))
      (let* ((encapsulation (make-data-structure (number-of-nodes) better?))
             (push!? (encapsulation 'push!?))
             (label (encapsulation 'v-ref))
             (iterate-pop! (make-encapsulation-iterator encapsulation))
             (mark (make-vector (number-of-nodes) 'unscanned)))
        (for-each-node (lambda (x) (set-predecessor! x '())))
        (push!? root 0)
        (iterate-pop!
          (lambda (node)
            (vector-set! mark node 'scanned)
            (for-each-link-of-node
              (lambda (link)
                (let ((new-node (second-node link)))
                  (if (and (eqv? (vector-ref mark new-node) 'unscanned)
                           (push!?
                             new-node
                             (value-function (label node) (link-length link))))
                      (set-predecessor! new-node link))))
              node)))
        (for-each-node (lambda (node) (set-label! node (label node))))))))


;@
;;;=========================================
;;;
;;;   Specific Algorithms
;;;
;;;=========================================

(define bellman
  (make-scan-based-algorithm
    make-vector-deque-with-values                    ;make-data-structure
    +                                                ;value-function
    < ))                                             ;predicate

(define dijkstra
  (make-scan-based-algorithm
    make-heap-with-membership-and-values             ;make-data-structure
    +                                                ;value-function
    < ))                                             ;predicate

(define dijkstra-m
  (make-scan-based-algorithm-with-mark
    make-heap-with-membership-and-values             ;make-data-structure
    +                                                ;value-function
    < ))                                             ;predicate

(define prim
  (make-scan-based-algorithm-with-mark
    make-heap-with-membership-and-values             ;make-data-structure
    (lambda (x y) y)                                 ;value-function
    < ))                                             ;predicate