#lang typed/racket ;; dijkstra's shortest-path algorithm ;; we'll represent a directed, weighted graph as a ;; hash mapping node names to ;; lists of weighted edges, where a weighted edge contains ;; a (target) name and a weight. ;; here's an example graph. There's a path of two edges ;; to node d, but the shortest-weight one goes through f (define-type Edge-List (Listof (List Symbol Nonnegative-Real))) (define-type Graph (Immutable-HashTable Symbol Edge-List)) (define example-graph (make-immutable-hash '((a . ((b 2) (c 1))) (b . ((d 10) (e 3))) (c . ((e 5))) (d . ((f 4))) (e . ((f 2))) (f . ((d 1)))))) ;; a dist-hash is a hash table mapping each node to its best known ;; shortest-path, or 'inf if no path is yet known. initially, ;; all nodes will be at distance inf. (define-type Dist (U 'inf Nonnegative-Real)) (define-type Dist-Hash (Immutable-HashTable Symbol Dist)) ;; in the "reached" nodes, 'inf is not allowed: (define-type Num-Dist-Hash (Immutable-HashTable Symbol Nonnegative-Real)) ;; the algorithm will maintain two of these, one for finished ;; nodes and one for unfinished nodes. The second of these could ;; certainly be implemented as a priority queue, if desired. (define (make-init-hash [g : Graph]) : Dist-Hash (for/hash : Dist-Hash ([name : Symbol (in-list (hash-keys g))]) (values name 'inf))) ;; given an up-to-date dist-hash, ;; return the node with the shortest known path (define (best [dist-hash : Dist-Hash]) : (Pairof Symbol Nonnegative-Real) (define all-dists (hash->list dist-hash)) (define non-inf-dists (remove-infs all-dists)) (when (empty? non-inf-dists) (raise-argument-error 'best "dist-hash with some non-inf distances" 0 dist-hash)) ;; return the one with the smallest distance: (argmin (inst cdr Any Real) non-inf-dists)) ;; is this pair a number pair? (: num-pair? (-> (Pairof Symbol Dist) Boolean : (Pairof Symbol Nonnegative-Real))); (define (num-pair? d) (number? (cdr d))) ;; given a list of pairs, remove those whose cdr is 'inf (define (remove-infs [pairs : (Listof (Pairof Symbol Dist))]) : (Listof (Pairof Symbol Nonnegative-Real)) (filter num-pair? pairs)) ;; given a finished dist-hash and a to-be-reached dist-hash ;; and a newly-added name and the full graph, update the ;; to-be-reached dist-hash by updating nodes reachable from ;; the newly-added node (define (update-dists [reached : Num-Dist-Hash] [unreached : Dist-Hash] [new : Symbol] [g : Graph]) : Dist-Hash (define new-dist (hash-ref reached new)) (define new-edges (hash-ref g new)) (for/fold ([unreached : Dist-Hash unreached]) ([edge (in-list new-edges)] #:when (not (hash-has-key? reached (first edge)))) (define tgt-name (first edge)) (define edge-weight (second edge)) (define old-dist (hash-ref unreached tgt-name)) (cond [(or (equal? old-dist 'inf) (< (+ new-dist edge-weight) old-dist)) (hash-set unreached tgt-name (+ new-dist edge-weight))] [else unreached]))) ;; given a 'reached' hash-dist and an 'unreached' hash-dist and the ;; graph g, perform ;; a single iteration of dijkstra's algorithm, returning the new ;; 'reached' and 'unreached' hashes (define (dijkstra-step [reached : Num-Dist-Hash] [unreached : Dist-Hash] [g : Graph]) : (List Num-Dist-Hash Dist-Hash) (match-define (cons new-node best-dist) (best unreached)) (define new-reached (hash-set reached new-node best-dist)) (define new-unreached (hash-remove unreached new-node)) (define new2-unreached (update-dists new-reached new-unreached new-node g)) (list new-reached new2-unreached)) ;; given a reached and unreached dist-hash, iterate until all nodes are ;; reached (define (dijkstra-loop [reached : Num-Dist-Hash] [unreached : Dist-Hash] [g : Graph]) : Dist-Hash (cond [(= 0 (hash-count unreached)) reached] [else (match-define (list new-reached new-unreached) (dijkstra-step reached unreached g)) (dijkstra-loop new-reached new-unreached g)])) ;; given a graph and a starting node, perform dijkstra's algorithm ;; and return the resulting 'reached' dist-hash (define (dijkstra [g : Graph] [starting-node : Symbol]) (dijkstra-loop (hash) (hash-set (make-init-hash g) starting-node 0) g)) (require typed/rackunit) (check-equal? (update-dists (hash 'a 0 'c 1) (hash 'b 2 'd 'inf 'e 'inf 'f 'inf) 'c example-graph) (hash 'b 2 'd 'inf 'e 6 'f 'inf)) (check-equal? (dijkstra-step (hash 'a 0 'c 1) (hash 'b 2 'd 'inf 'e 6 'f 'inf) example-graph) (list (hash 'a 0 'c 1 'b 2) (hash 'd 12 'e 5 'f 'inf))) (check-equal? (best (hash 'a 42 'b 'inf 'c 9)) (cons 'c 9)) (check-equal? (dijkstra example-graph 'a) (hash 'a 0 'b 2 'c 1 'd 8 'e 5 'f 7))