用scheme語言實現SPFA算法（單源最短路）

　　最近本身陷入了很長時間的學習和思考之中，忽然發現很久沒有更新博文了，因而便想更新一篇。

　　這篇文章是我以前程序設計語言課做業中一段代碼，用scheme語言實現單源最段路算法。當時的我，花了一成天時間，學習了scheme並實現了SPFA算法，那天實現以後感受頗有成就感～在這裏貼出來，以饗讀者。

---

 　　忽然發現博客園不支持scheme語言，因而只能放棄高亮了。不得不說，scheme代碼有沒有高亮差異好大……

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  題目：單源最短路，輸入數據給定
;;
;;  做者：盧奇
;;  學號：5130309680
;;  郵箱：icedream@sjtu.edu.cn
;;
;;  算法：SPFA（簡化版）
;;
;;  代碼結構：共三大部分——
;;    開始是一些語法糖，
;;    而後是SPFA算法的實現，
;;    最後是主體部分，調用了SPFA算法並輸出結果。
;;
;;  備註：代碼備註共有兩種——
;;    1. 代碼的三大部分，各自開頭有一段備註
;;    2. 代碼的兩個主體部分，內部穿插了一些備註
;;      其中，兩個主體部分是指：代碼主體部分 以及 SPFA算法的主體部分（即SPFA函數）
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(begin

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;
  ;;  這裏是爲後面代碼定義的一些語法糖。
  ;;
  ;;  爲了可讀性，我作了一個「下標變換」：
  ;;    題目圖中6個點，存儲爲0~5，但供操做的API對外設計成1~6的假象，簡化思路
  ;;
  ;;  有一維數組、二維數組、隊列和邏輯運算幾方面，具體以下所示：
  ;;    1. 根據下標該值，構造新數組：change, change2
  ;;    2. 根據下標賦值（＋下標變換）：set, set2
  ;;    3. 根據下標取值（＋下標變換）：get, get2
  ;;    4. 入隊、出隊：push, pop
  ;;    5. 邏輯運算（二元與、二元或）：and, or
  ;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define (change a i x)
    (if (eqv? i 0)
	(cons x (cdr a))
	(cons (car a) (change (cdr a) (- i 1) x))))
  (define (change2 a i j x)
    (if (eqv? i 0)
	(cons (change (car a) j x) (cdr a))
	(cons (car a) (change2 (cdr a) (- i 1) j x))))
  (define-syntax set
    (syntax-rules ()
      ([set a i x] (set! a (change a (- i 1) x)))))
  (define-syntax set2
    (syntax-rules ()
      ([set2 a i j x]
       (begin
	 (set! a (change2 a (- i 1) (- j 1) x))
	 (set! a (change2 a (- j 1) (- i 1) x))))))
  (define-syntax get
    (syntax-rules ()
      ([get a i] (list-ref a (- i 1)))))
  (define-syntax get2
    (syntax-rules ()
      ([get2 a i j] (list-ref (list-ref a (- i 1)) (- j 1)))))
  
  (define-syntax push
    (syntax-rules ()
      ([push Q x] (set! Q (append Q (list x))))))
  (define-syntax pop
    (syntax-rules ()
      ([pop Q]
       (let ([x (car Q)])
	 (set! Q (cdr Q))
	 x))))

  (define-syntax and
    (syntax-rules ()
      ([and Ea Eb]
       (if (eqv? Ea #t)
	   (if (eqv? Eb #t) #t #f)
	   #f))))
  (define-syntax or
    (syntax-rules ()
      ([or Ea Eb]
       (if (eqv? Ea #t)
	   #t
	   (if (eqv? Eb #t) #t #f)))))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;
  ;;  此爲SPFA算法部分（簡化版）
  ;;
  ;;  其中SPFA函數是主體，其調用了update-all函數，後者又調用了update函數。
  ;;
  ;;  注：之因此稱之爲簡化版，是由於原本SPFA的入隊應該去重的，但被我給省了。
  ;;     不過本題中並不要求速度、也不影響正確性，寫不寫也就無所謂了。
  ;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (define (update map d Q u allv)
    (cond
     [(not (eqv? allv null))
      (let ([v (car allv)] [lastv (cdr allv)])
;	(newline)
;	(display "an update --") (newline)
;	(display "d: ") (display d) (newline)
;	(display "Q: ") (display Q) (newline)
;	(display "u: ") (display u) (newline)
;	(display "v: ") (display v) (newline)
;	(display "allv: ") (display allv) (newline)
	(cond
	 [(and (not (eqv? (get2 map u v) #f)) (or (eqv? (get d v) #f) (< (+ (get d u) (get2 map u v)) (get d v))))
	  (begin
	    (set d v (+ (get d u) (get2 map u v)))
	    (push Q v))])
	(update map d Q u lastv))]
     [else (list d Q)]))
  
  (define (update-all map d Q)
    (if (eqv? Q null)
	d
	(let ([u (pop Q)])
	  (define tmp  (update map d Q u (list 1 2 3 4 5 6)))
	  (set! d (car tmp))
	  (set! Q (cadr tmp))
	  (update-all map d Q))))

  (define (SPFA map s)
					; 初始化SPFA中的數組
    (define d (make-list 6 #f))
    (set d s 0)
    (define Q null)
    (push Q s)
					; 輸出初始化的數組，僅供調試
    (display "d: ") (display d) (newline)
    (display "Q: ") (display Q) (newline)
					; 計算由s出發的單源最短路，並返回計算出的結果
    (update-all map d Q))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;
  ;;  題目主函數在此
  ;;
  ;;  本題全部的IO都在這裏給出了，一目瞭然。
  ;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

					; 建圖 稱爲map
  (define map (make-list 6 (make-list 6 #f)))
  (set2 map 1 2 7)
  (set2 map 1 3 9)
  (set2 map 1 6 14)
  (set2 map 2 4 15)
  (set2 map 2 3 10)
  (set2 map 3 4 11)
  (set2 map 3 6 2)
  (set2 map 4 5 6)
  (set2 map 5 6 9)
					; 經過簡化的SPFA算法計算最短路
  (define d (SPFA map 1))
					; 輸出答案
  (display "last-d: ") (display d) (newline)
  (display "result: ") (display (get d 5)) (newline))