# fixedpoint.jp - Dijkstra's algorithm 再び

 Web fixedpoint.jp

## Dijkstra's algorithm 再び

2007/02/22に書いた Dijkstra's algorithm のコードにバグがあったため修正をしました。特にテスト用のコードとして、世界の28都市を結ぶ旅客ルートの距離(マイルで計算)をもとに最短コースを計算させてみました。

```(use gauche.sequence) (use srfi-1) (use util.combinations) (define (vertices-of graph) (fold (lambda (e temp) (let ((u (car e)) (v (cdr e))) (if (memq u temp) (if (memq v temp) temp (cons v temp)) (if (memq v temp) (cons u temp) (cons* u v temp))))) '() graph)) (define (dijkstra graph weight s) (let lp0 ((dst `((,s . 0))) (prv '()) (vst '()) (ust (vertices-of graph))) (let ((udst (filter (lambda (x) (memq (car x) ust)) dst))) (if (null? udst) (values dst prv) (let ((u-and-d (car (sort udst (lambda (x y) (< (cdr x) (cdr y))))))) (let ((u (car u-and-d)) (d (cdr u-and-d))) (let lp1 ((out (map cdr (filter (lambda (e) (eq? u (car e))) graph))) (dst dst) (prv prv)) (if (null? out) (lp0 dst prv (cons u vst) (delete u ust eq?)) (let* ((v (car out)) (d+w (+ d (weight u v)))) (let lp2 ((rest dst) (temp '())) (if (null? rest) (lp1 (cdr out) (cons (cons v d+w) dst) (cons (cons v u) prv)) (let ((v-and-d (car rest))) (if (eq? v (car v-and-d)) (if (< d+w (cdr v-and-d)) (lp1 (cdr out) (cons (cons v d+w) (append (cdr rest) temp)) (cons (cons v u) (remove (lambda (e) (eq? v (car e))) prv))) (lp1 (cdr out) dst prv)) (lp2 (cdr rest) (cons v-and-d temp))))))))))))))) (define (shortest-path graph weight x y) (receive (dst prv) (dijkstra graph weight x) (let lp ((u y) (s '())) (cond ((assq u prv) => (lambda (p) (lp (cdr p) (cons u s)))) (else s))))) ```

```(define cities '(berlin buenos-aires cairo calcutta cape-town caracas chicago hong-kong honolulu istanbul lisbon london los-angeles manila mexico-city montreal moscow new-york paris rio-de-janeiro rome san-francisco shanghai stockholm sydney tokyo warsaw washington-dc)) (define-macro (define-statute-miles cities table) `(define (statute-miles x y) (case x ,@(map-with-index (lambda (i c) `((,c) (case y ,@(map-with-index (lambda (j d) `((,d) ,(list-ref (list-ref table j) i))) cities) (else #f)))) cities) (else #f))) ) (define-statute-miles (berlin buenos-aires cairo calcutta cape-town caracas chicago hong-kong honolulu istanbul lisbon london los-angeles manila mexico-city montreal moscow new-york paris rio-de-janeiro rome san-francisco shanghai stockholm sydney tokyo warsaw washington-dc) ( (#f 7402 1795 4368 5981 5247 4405 5440 7309 1078 1436 579 5724 6132 6047 3729 1004 3965 545 6220 734 5661 5218 504 10006 5540 320 4169) (7402 #f 7345 10265 4269 3168 5598 11472 7561 7611 5956 6916 6170 11051 4592 5615 8376 5297 6870 1200 6929 6467 12201 7808 7330 11408 7662 5218) (1795 7345 #f 3539 4500 6338 6129 5061 8838 768 2363 2181 7520 5704 7688 5414 1803 5602 1995 6146 1320 7364 5183 2111 8952 5935 1630 5800) (4368 10265 3539 #f 6024 9605 7980 1648 7047 3638 5638 4947 8090 2203 9492 7607 3321 7918 4883 9377 4482 7814 2117 4195 5685 3194 4048 8084) (5981 4269 4500 6024 #f 6365 8494 7375 11534 5154 5325 6012 9992 7486 8517 7931 6300 7764 5807 3773 5249 10247 8061 6444 6843 9156 5958 7901) (5247 3168 6338 9605 6365 #f 2501 10167 6013 6048 4041 4660 3632 10620 2232 2449 6173 2132 4736 2810 5196 3904 9501 5420 9513 8799 5517 2059) (4405 5598 6129 7980 8494 2501 #f 7793 4250 5477 3990 3950 1745 8143 1691 744 4974 713 4134 5296 4808 1858 7061 4278 9272 6299 4667 597) (5440 11472 5061 1648 7375 10167 7793 #f 5549 4984 6853 5982 7195 693 8782 7729 4439 8054 5985 11021 5768 6897 764 5113 4584 1794 5144 8147) (7309 7561 8838 7047 11534 6013 4250 5549 #f 8109 7820 7228 2574 5299 3779 4910 7037 4964 7438 8285 8022 2393 4941 6862 4943 3853 7355 4519) (1078 7611 768 3638 5154 6048 5477 4984 8109 #f 2012 1552 6783 5664 7110 4789 1091 4975 1400 6389 843 6703 4962 1348 9294 5560 863 5215) (1436 5956 2363 5638 5325 4041 3990 6853 7820 2012 #f 985 5621 7546 5390 3246 2427 3364 904 4796 1161 5666 6654 1856 11302 6915 1715 3562) (579 6916 2181 4947 6012 4660 3950 5982 7228 1552 985 #f 5382 6672 5550 3282 1555 3458 213 5766 887 5357 5715 890 10564 5940 899 3663) (5724 6170 7520 8090 9992 3632 1745 7195 2574 6783 5621 5382 #f 7261 1589 2427 6003 2451 5588 6331 6732 347 6438 5454 7530 5433 5922 2300) (6132 11051 5704 2203 7486 10620 8143 693 5299 5664 7546 6672 7261 #f 8835 8186 5131 8498 6677 11259 6457 6967 1150 5797 3944 1866 5837 8562) (6047 4592 7688 9492 8517 2232 1691 8782 3779 7110 5390 5550 1589 8835 #f 2318 6663 2094 5716 4771 6366 1887 8022 5959 8052 7021 6365 1887) (3729 5615 5414 7607 7931 2449 744 7729 4910 4789 3246 3282 2427 8186 2318 #f 4386 320 3422 5097 4080 2539 7053 3667 9954 6383 4009 488) (1004 8376 1803 3321 6300 6173 4974 4439 7037 1091 2427 1555 6003 5131 6663 4386 #f 4665 1544 7175 1474 5871 4235 762 9012 4647 715 4858) (3965 5297 5602 7918 7764 2132 713 8054 4964 4975 3364 3458 2451 8498 2094 320 4665 #f 3624 4817 4281 2571 7371 3924 9933 6740 4344 205) (545 6870 1995 4883 5807 4736 4134 5985 7438 1400 904 213 5588 6677 5716 3422 1544 3624 #f 5699 697 5558 5754 958 10544 6034 849 3829) (6220 1200 6146 9377 3773 2810 5296 11021 8285 6389 4796 5766 6331 11259 4771 5097 7175 4817 5699 #f 5684 6621 11336 6651 8306 11533 6467 4796) (734 6929 1320 4482 5249 5196 4808 5768 8022 843 1161 887 6732 6457 6366 4080 1474 4281 697 5684 #f 6240 5677 1234 10136 6135 817 4434) (5661 6467 7364 7814 10247 3904 1858 6897 2393 6703 5666 5357 347 6967 1887 2539 5871 2571 5558 6621 6240 #f 6140 5361 7416 5135 5841 2442) (5218 12201 5183 2117 8061 9501 7061 764 4941 4962 6654 5715 6438 1150 8022 7053 4235 7371 5754 11336 5677 6140 #f 4825 4899 1097 4951 7448) (504 7808 2111 4195 6444 5420 4278 5113 6862 1348 1856 890 5454 5797 5959 3667 762 3924 958 6651 1234 5361 4825 #f 9696 5051 501 4123) (10006 7330 8952 5685 6843 9513 9272 4584 4943 9294 11302 10564 7530 3944 8052 9954 9012 9933 10544 8306 10136 7416 4899 9696 #f 4866 9696 9758) (5540 11408 5935 3194 9156 8799 6299 1794 3853 5560 6915 5940 5433 1866 7021 6383 4647 6740 6034 11533 6135 5135 1097 5051 4866 #f 5249 6772) (320 7662 1630 4048 5958 5517 4667 5144 7355 863 1715 899 5922 5837 6365 4009 715 4344 849 6467 817 5841 4951 501 9696 5249 #f 4457) (4169 5218 5800 8084 7901 2059 597 8147 4519 5215 3562 3663 2300 8562 1887 488 4858 205 3829 4796 4434 2442 7448 4123 9758 6772 4457 #f) )) (define air-graph (remove (lambda (pair) (eq? (car pair) (cdr pair))) (map (lambda (x) (cons (car x) (cadr x))) (cartesian-product (list cities cities))))) (shortest-path air-graph statute-miles 'tokyo 'new-york) (shortest-path (delete '(tokyo . london) air-graph equal?) statute-miles 'tokyo 'london) (shortest-path air-graph statute-miles 'sydney 'london) ```