最短路径的几个算法

newer

下载地址：晓东文库

newer

下载地址：晓东文库

newer

下载地址：晓东文库

newer

下载地址：晓东文库

flowerson

这些算法 有没有lisp版的呢？

aimisiyou

_$
_$ x12
9.04065e-012
_$ x13
0.103087
_$ x14
1.08639e-015
_$ x15
1.0357
_$ x16
0.931618
_$ x17
0.894973
_$ x18
0.000993146
_$ x19
9.71299e-015
_$ x21
0.0209586
_$ x23
7.66169

发现将每条边的初始信息素设置为其中一条路径的长度，收敛效果好很多，最终每条边的信息素差别就凸显出来，即信息素高的边蚂蚁越来越多，信息素低的边蚂蚁数越来越少，得到的图形效果也比较好。

aimisiyou

;;;选取的点数越多运行越慢，点数在30以内的运行较快，图形效果可能差强人意
(defun c:tt()
;;;随机函数
(defun rnd()
  (*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun fnlst(num)
    (setq ii 0 numlst nil)
        (while (< ii num)
               (setq numlst (cons ii numlst))
                   (setq ii (+ ii 1))
        )
        (reverse numlst)
)
(defun fp ()
    (setq sn (ssget ":N" '((0 . "point"))))
    (setq i 0 n (sslength sn) plst nil)
    (while (< i n)
        (setq plst (cons (cons i (cdr (assoc 10 (entget (ssname sn i))))) plst))
        (setq i (+ i 1))
    )
    (reverse plst)
)
(setq plst (fp) num (length plst) )
;;;设置距离矩阵变量
(setq i 0)
(while (< i num)
       (setq j 0)  
       (while (< j num)
              (set (read (strcat "D" (if (< i 10) (strcat "0" (itoa i)) (itoa i))
                                                 (if (< j 10) (strcat "0" (itoa j)) (itoa j))
                                                  )
                                    )  
                   (distance (cdr (assoc i plst))  (cdr (assoc j plst)) )
               )
              (setq j (+ j 1))
        )
       (setq i (+ i 1))
)
;;;设置初始每条边上的信息素为1
(setq i 0)
(while (< i num)
       (setq j 0)  
       (while (< j num)
              (set  (read (strcat "X"
                                              (if (< i 10) (strcat "0" (itoa i)) (itoa i))
                                              (if (< j 10) (strcat "0" (itoa j)) (itoa j))
                                                )
                                        )
                                1.0
                          )
              (setq j (+ j 1))
        )
       (setq i (+ i 1))
)
;;;一只蚂蚁路径转移
(defun ant()
   (setq n (fix (* num (rnd))) n0 n nt n numlst (fnlst num) zylst (vl-remove n numlst) llst (list n) dist 0)
   (while  zylst
          (setq fblst (mapcar '(lambda (en)
                                       (/ (eval (read (strcat "X" (if (< n 10) (strcat "0" (itoa n)) (itoa n))                                (if (< en 10) (strcat "0" (itoa en)) (itoa en))
                                                                                           )
                                                                                                  )
                                                                                   )  
                                          (expt (eval (read (strcat "D"
                                                                                                          (if (< n 10) (strcat "0" (itoa n)) (itoa n))
                                                                                                          (if (< en 10) (strcat "0" (itoa en)) (itoa en))   
                                                                                                                         )
                                                                                                                )
                                                                                                 )
                                                                                                 2.0
                                                                                   )
                                        )
                                 )
                         zylst
                        )
            )
           (setq k 0 d_sum 0 d_lst nil)
           (setq sum_fblst (apply '+ fblst))
           (setq fitlst (mapcar '(lambda (x) (/ (* x 1.0) sum_fblst)) fblst))
           (while (< k (length zylst))
                     (setq l_sum (+ d_sum (nth k fitlst)))
                     (setq d_lst (cons (list d_sum l_sum) d_lst))
                     (setq d_sum  l_sum)
                     (setq k (+ k 1))
             )
            (setq d_lst (reverse d_lst))
            (setq num_rnd (rnd))   
            (setq n (nth (vl-position t
                                  (mapcar '(lambda (x)
                                                 (if (and (<= (car x) num_rnd) (< num_rnd (cadr x)) ) t nil)
                                            )
                                            d_lst
                                   )
                           )
                           zylst
                      )
             )
            (setq dist (+ dist (eval (read (strcat "D" (if (< nt 10) (strcat "0" (itoa nt)) (itoa nt))
                                                                   (if (< n 10)  (strcat "0" (itoa n)) (itoa n))
                                                                                        )
                                                                          )
                                                            )
                                                ) nt n)
            (setq llst (cons n llst))
            (setq zylst (vl-remove n zylst))
      )
   (setq dist (+ dist (eval (read (strcat "D" (if (< nt 10) (strcat "0" (itoa nt)) (itoa nt))
                                              (if (< n0 10) (strcat "0" (itoa n0)) (itoa n0))   
                                                                   )
                                                         )
                                                )
                                )
        )
   (cons dist (reverse  llst))
)
(setq x0 (car (ant)))
;;;设置初始每条边上的信息素为x0
(setq i 0)
(while (< i num)
       (setq j 0)  
       (while (< j num)
              (set  (read (strcat "X"
                                              (if (< i 10) (strcat "0" (itoa i)) (itoa i))
                                              (if (< j 10) (strcat "0" (itoa j)) (itoa j))
                                                )
                                        )
                                x0
                          )
              (setq j (+ j 1))
        )
       (setq i (+ i 1))
)
;;;更新每条边上的信息素
(defun re()
(setq i 0)
(while (< i num)
       (setq j 0)  
       (while (< j num)
              (set (read (strcat "X" (if (< i 10) (strcat "0" (itoa i)) (itoa i))
                                                 (if (< j 10) (strcat "0" (itoa j)) (itoa j))
                                                  )
                                        )  
                               (* 0.1 (eval (read (strcat "X" (if (< i 10) (strcat "0" (itoa i)) (itoa i))
                                                                  (if (< j 10) (strcat "0" (itoa j)) (itoa j))
                                                                           )
                                                                 )
                                                        )
                                        )
                           )
              (setq j (+ j 1))
        )
       (setq i (+ i 1))
)
(foreach en antslst
    (mapcar '(lambda (x y)
                         (set (read (strcat "X" (if (< x 10) (strcat "0" (itoa x)) (itoa x))
                                                                        (if (< y 10) (strcat "0" (itoa y)) (itoa y))
                                                                         )
                                                           )
                              (+ (/ x0 (car en)) (eval (read (strcat "X"
                                                                                                (if (< x 10) (strcat "0" (itoa x)) (itoa x))
                                                                                                                                        (if (< y 10) (strcat "0" (itoa y)) (itoa y))
                                                                                                                          )
                                                                                                                 )
                                                                                                   )
                                                          )
                                                  )
              )
             (cdr en)
             (append (cdr (cdr en)) (list (cadr en)))
      )
  )
)
(setq ij 0 p_best (ant))
(while (< ij 20)
        ;;;设置蚂蚁数量M
        (setq Mant 30 antslst nil)
        (repeat Mant (setq antslst (cons (ant) antslst)))
        (setq p_bestnew (car (vl-sort  antslst  '(lambda (e1 e2)  (< (car e1) (car e2))))))
                (if (< (car p_bestnew) (car p_best))
                    (setq p_best p_bestnew)
                )
        (re)
        (setq ij (+ ij 1))
)
(setq pts (mapcar '(lambda (x) (cdr (assoc x plst))) (cdr p_best)))
(apply 'command (cons "pline" (reverse (cons "c" (reverse pts)))))
)