蚁群算法求旅行商问题

aimisiyou

蚁群算法求旅行商问题。

aisong220

厉害

aimisiyou

由于lisp中没有矩阵，用嵌套表也不利于修改替换，考虑设置变量来更新。
(setq i 1)
(while (< i 10)
       (setq j 1)  
       (while (< j 10)
                       (set  (read (strcat "X" (itoa i) (itoa j)))  (+ i j))
                       (setq j (+ j 1))
        )
       (setq i (+ i 1))
)
(setq i 1)
(while (< i 10)
       (setq j 1)  
       (while (< j 10)
                       (set  (read (strcat "X" (itoa i) (itoa j)))  (+ (eval (read (strcat "X" (itoa i) (itoa j)))) 10))
                       (setq j (+ j 1))
        )
       (setq i (+ i 1))
)

aimisiyou

;;;取点函数
(defun fp ()
    (setq sn (ssget ":N" '((0 . "point"))))
    (setq i 0 n (sslength sn) plst nil)
    (while (< i n)
        (setq plst (cons (cons (+ i 1) (cdr (assoc 10 (entget (ssname sn i))))) plst))
        (setq i (+ i 1))
    )
    (reverse plst)
)
;;;设置距离矩阵变量
(setq plst (fp) num (length plst))
(setq i 1)
(while (<= i num)
       (setq j 1)  
       (while (<= j num)
                  (if (= i j)
                  (set  (read (strcat "D" (itoa i) (itoa j)))  0)
                  (set  (read (strcat "D" (itoa i) (itoa j)))  
                                        (distance (cdr (assoc i plst))  (cdr (assoc j plst)) )
                                   )
                           )
                           (setq j (+ j 1))
        )
       (setq i (+ i 1))
)
;;;设置初始每条边上的信息素为1
(setq i 1)
(while (<= i num)
       (setq j 1)  
       (while (<= j num)
                  (if (= i j)
                      (set  (read (strcat "X" (itoa i) (itoa j)))  0)
                      (set  (read (strcat "X" (itoa i) (itoa j)))  1)
                   )
                   (setq j (+ j 1))
        )
       (setq i (+ i 1))
)

aimisiyou

;;;取点函数
(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)
                  (if (= i j)
                  (set  (read (strcat "D" (itoa i) (itoa j)))  0)
                  (set  (read (strcat "D" (itoa i) (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)
                  (if (= i j)
                      (set  (read (strcat "X" (itoa i) (itoa j)))  0)
                      (set  (read (strcat "X" (itoa i) (itoa j)))  1)
                   )
                   (setq j (+ j 1))
        )
       (setq i (+ i 1))
)
;;;随机函数
(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)
)
       
;;;一只蚂蚁路径转移
        (setq n (fix (* num (rnd))) numlst (fnlst num) zylst (vl-remove n numlst) llst (list n) )
        (while  zylst
                           (setq fblst (mapcar '(lambda (en)
                                                    (/ (eval (read (strcat "X" (itoa n) (itoa en))))  
                                                               (expt (eval (read (strcat "D" (itoa n) (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 llst (cons n llst))
                (setq zylst (vl-remove n zylst))
                        )
                 (setq llst (reverse  llst))
                (setq pts (mapcar '(lambda (x) (cdr (assoc x plst))) llst))
               (apply 'command (cons "pline" (reverse (cons "c" (reverse pts)))))    ;;;(随机给定一起点，一只蚂蚁的行进路线)

aimisiyou

(defun c:tt()
(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)
                  (if (= i j)
                  (set  (read (strcat "D" (itoa i) (itoa j)))  0)
                  (set  (read (strcat "D" (itoa i) (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)
                  (if (= i j)
                      (set  (read (strcat "X" (itoa i) (itoa j)))  0)
                      (set  (read (strcat "X" (itoa i) (itoa j)))  1)
                   )
                   (setq j (+ j 1))
        )
       (setq i (+ i 1))
)
;;;随机函数
(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 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" (itoa n) (itoa en))))  
                                                               (expt (eval (read (strcat "D" (itoa n) (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" (itoa nt) (itoa n)))) ) nt n)
                                (setq llst (cons n llst))
                (setq zylst (vl-remove n zylst))
                        )
            (setq dist (+ dist (eval (read (strcat "D" (itoa nt) (itoa n0)))) ) )
            (cons dist (reverse  llst))
)
;;;更新每条边上的信息素
(defun re()
(setq i 0)
(while (< i num)
       (setq j 0)  
       (while (< j num)
              (set (read (strcat "X" (itoa i) (itoa j)))  (* 0.9 (eval (read (strcat "X" (itoa i) (itoa j))))))
              (setq j (+ j 1))
        )
       (setq i (+ i 1))
)
(foreach en antslst
    (mapcar '(lambda (x y)
                         (set (read (strcat "X" (itoa x) (itoa y))) (+ (/ 1.0 (car en)) (eval (read (strcat "X" (itoa x) (itoa y))))))
                        )
                 (cdr en)
                         (append (cdr (cdr en)) (list (cadr en)))
         )
)
)
(setq i 0 p_best (ant))
(while (< i 20)
        ;;;设置蚂蚁数量M
        (setq Mant 20 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 i (+ i 1))
)
(setq pts (mapcar '(lambda (x) (cdr (assoc x plst))) (cdr p_best)))
(apply 'command (cons "pline" (reverse (cons "c" (reverse pts)))))
)

aimisiyou

再次运行得到另外图形。运行受信息素挥发率、蚂蚁个数、循环运行次数等因素影响会出现不同结果。
运行结果发现
_$ x12
0.102979
_$ x13
0.103915
_$ x14
0.100613
_$ x23
0.10232
_$ x35
0.102003
即每条边的信息素很平均。那里出现了问题？

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

需要注意的地方：
_$ (set (read (strcat "X" (itoa 1) (itoa 21))) 5)
5
_$ x121
5
_$  (set (read (strcat "X" (itoa 12) (itoa 1))) 50)
50
_$ x121
50
_$ (set (read (strcat "X" "01" (itoa 21))) 5)
5
_$ x0121
5
_$  (set (read (strcat "X" (itoa 12) "01")) 50)
50
_$ x1201
50

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))
                                                                         )
                                                           )
                              (+ (/ (* 0.9 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 100)
        ;;;设置蚂蚁数量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)))))
)

aimisiyou

37个点，设置信息素挥发率0.9，循环80次，蚂蚁数30，运行约三分钟，得出较好图形结果。将循环次数调至100，运行结果图形更好。

aimisiyou

蚂蚁算法的鲁棒性很强，原理根据不同路径上的信息素变化，蚂蚁越来越趋向于走信息素高的边，这也容易导致陷入局部最优解。如果前期加快收敛，后期放缓收敛，更利于搜到全局最优路径。例如如果当次循环中最长路径高出最短路径10%，更新所有边的信息素就按经过改该条边上所有蚂蚁路径的倒数和（如某条边上有蚂蚁1和蚂蚁2经过，该边上的信息素更新=0.1*该边原来信息素+0.9*（1/L1+1/L2）。如果当次循环中最长路径比最短路径不超过10%，更新所有边的信息素就按经过该条边上所有蚂蚁路径的倒数和的平均值（如某条边上有蚂蚁1、蚂蚁2和蚂蚁3经过，该表边上的信息素更新=0.1*该边原来的信息素+0.9*（（1/L1+1/L2+1/L3）/3），这样就实现前期加速收敛，后期放缓收敛，尽量减少陷入局部最值。

aimisiyou

对于起始点，蚂蚁算法是将蚂蚁随机投放到N个点当中去，然后从随机起始点开始寻求路径。如果将起始点限定在点集的凸包顶点集中，对运算结果是否更好？感觉前期快速收敛确定与凸包顶点相连的边的路径，然后对于内部中间密集区域，需要放缓收敛速度（避免陷入局部最优解），从而便于寻找全局最优解。

LoveArx

aimisiyou 发表于 2019-1-17 20:44
;;;选取的点数越多运行越慢，点数在30以内的运行约三分钟，图形效果可能差强人意
(defun c:tt()
;;;随机 ...

30个点就要3分钟，是不是效率偏低，不太适合工程应用呢？

aimisiyou

LoveArx 发表于 2019-1-20 00:07
30个点就要3分钟，是不是效率偏低，不太适合工程应用呢？

lisp效率本身就不高啊，我只是想将算法用lisp来实现，并对算法进行优化，关于效率可以选择其他语言来提高。