蚁群算法求旅行商问题

mahuan1279

;;;选取的点数越多运行越慢，点数在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)))))
)

mahuan1279

蚂蚁算法的鲁棒性很强，原理根据不同路径上的信息素变化，蚂蚁越来越趋向于走信息素高的边，这也容易导致陷入局部最优解。如果前期加快收敛，后期放缓收敛，更利于搜到全局最优路径。例如如果当次循环中最长路径高出最短路径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），这样就实现前期加速收敛，后期放缓收敛，尽量减少陷入局部最值。