蚁群算法求旅行商问题

aimisiyou · 发表于 2019-1-21 22:06:53

本帖最后由 aimisiyou 于 2019-1-21 22:34 编辑

最小生成树有很多优良性质：
1、如果一个图的各个边的权值各不相同,那么它的最小生成树是唯一的；
2、若最小生成树是唯一的，那么新增一条边，同时减掉一条原来在最小支撑树中的边（结果仍保持所有点连通），那么所有边的权值和是增加的，那么我们可以选择增加的边和剪掉的边长度尽量接近（当然，增加的边的长度肯定大于剪掉的边，否则原来的就不是最小支撑树）。选择增加的边和减掉的边遵循增值越少，连通的主线路越长，最后留下缺口越短。根据这个直观感觉，可以在最小支撑树分支较少且短的“理想情况”下手工找到接近最优路径。

aimisiyou · 发表于 2019-1-22 00:21:59

本帖最后由 aimisiyou 于 2019-1-22 09:19 编辑

假设有n个点构成点表pts=(p0 p1 p2 p3 ……pn-1)
用表来表示其距离矩阵，dlst=(d01 d02 d03 ……d0n-1 d12 d13 …… d1n-1 d23 d24 ……  dn-2n-1)
若现在要取出dij的值，则dij在dlst中的顺序号k=(n-1)+(n-2)+……(n-i)+（j-i），（顺序号从1开始数）
如n=9时，d35在dlst中的顺序号k=(9-1)+(9-2)+(9-3)+(5-3)=23,即d35=(nth 22 dlst),
对应关系有k=(n-1+n-i)*i/2+(j-i)

_$ ;;;取点函数
(defun fp ()
(setq sn (ssget ":N" '((0 . "point"))))
(setq i 0 n (sslength sn) pts nil)
(while (< i n)
      (setq pts (cons (cons i (cdr (assoc 10 (entget (ssname sn i))))) pts))
      (setq i (+ i 1))
)
(reverse pts)
)
(defun vfun(pts)
  (setq n (length pts) dlst nil i 0)
  (while (< i n)
      (setq j (+ i 1))
      (while (< j n)
            (setq dlst (cons (distance (cdr (assoc i pts))  (cdr (assoc j pts)) )  dlst))
            (setq j (+ j 1))
               )
      (setq i (+ i 1))
)
(reverse dlst)
)
FP
VFUN
_$ (setq pts (fp))
((0 1208.04 90.7377 0.0) (1 1317.65 17.7444 0.0) (2 1061.9 155.309 0.0) (3 1196.8 -69.286 0.0) (4 953.08 73.9537 0.0) (5 933.741 -94.6474 0.0))
_$ (setq dlst (vfun pts))
(131.687 159.771 160.418 255.512 331.07 290.397 148.924 368.874 400.019 261.994 135.868 280.896 282.694 264.277 169.707)
_$

若要取出第ni点到其他点的距离列表（d0_ni d1_ni d2_ni ……dni_n-1）
(defun fnlst(num)
(setq ii 0 numlst nil)
      (while (< ii num)
            (setq numlst (cons ii numlst))
               (setq ii (+ ii 1))
      )
      (reverse numlst)
)

(defun dnfun(ni)
  (mapcar '(lambda (x)                   (nth
                           (if (< x ni)
                              (- (+ ni (* n x)) (/ (* x (+ x 3)) 2) 1)
                              (- (+ x (* n ni)) (/ (* ni (+ ni 3)) 2) 1)
                           )
                        dlst
                     )
                  )
         (vl-remove ni (fnlst n))
   )
)
_$ dlst
(131.687 159.771 160.418 255.512 331.07 290.397 148.924 368.874 400.019 261.994 135.868 280.896 282.694 264.277 169.707)
_$ (dnfun 3)
(160.418 148.924 261.994 282.694 264.277)
_$

若要求点集中最近距离的点对，可先在距离列表dlst中找最小值dij和它所在的位置k-1，然后根据k=(n-1+n-i)*i/2+(j-i)反算出i和j，即pi和pj的距离最短。

aimisiyou · 发表于 2019-1-22 01:57:13

考虑用列表来表示一棵最小生成树，当然是用所有的边的集合来表示,如tree='((0 3) (3 5) (3 4) (2 5)（1 2） )，然后将表内蜕壳得到（0 3 3 5 3 4 2 5 1 2），数同号点的个数就可以得到该点的度数，显然3号点的度数为3,5号和2号点的度数为2，0号、1号、4号点的度数为1（也就是末端叶子），按度数从大到小排序，就可以得到那些度数大的节点。

aimisiyou · 发表于 2019-1-30 16:58:33

;;;表内蜕壳
(defun hf(lst)
  (setq vlst nil)
  (mapcar '(lambda (x) (foreach e x (setq vlst (cons e vlst)) )) lst)
  (reverse vlst)
)
;;;(hf '((1 2 3) (4 5 6)(7 8 9)))
;;;取点函数
(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)
)
(defun mindist (alst blst)
  (setq dlst nil)
  (foreach a alst
   (foreach b blst
         (setq dlst (cons (list (distance (cdr a) (cdr b))(car a) (car b) )  dlst))
      )
  )
  (setq qlst (car (vl-sort dlst '(lambda(a b) (< (car a) (car b)) ) )))
  qlst
)
(defun dolst(ptslst)
(setq vlst (list (car ptslst)) rlst (cdr ptslst) ddlst nil)
(while (not (null rlst))
      (setq qlst (mindist vlst rlst))
   (setq ddlst (cons (cdr qlst) ddlst))
      (setq vlst (cons (assoc (last qlst)  rlst) vlst))
      (setq rlst (vl-remove (assoc (last qlst)  rlst) rlst))
)
ddlst
)
(defun fnlst(num)
(setq ii 0 numlst nil)
      (while (< ii num)
            (setq numlst (cons ii numlst))
               (setq ii (+ ii 1))
      )
      (reverse numlst)
)
(setq pts (fp))
(setq ddlst (hf (dolst pts)) nnum (length ddlst))
(setq ptm (mapcar '(lambda (x ) (cons x (- nnum (length (vl-remove x ddlst))))) (fnlst (length pts))))
(setq pt0s (vl-remove nil (mapcar '(lambda (x) (if (> (cdr x) 2) (car x))) ptm)))

aimisiyou · 发表于 2019-1-30 17:41:22

本帖最后由 aimisiyou 于 2019-1-30 17:45 编辑

(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)
)
(defun hf(lst)
  (setq vlst nil)
  (mapcar '(lambda (x) (foreach e x (setq vlst (cons e vlst)) )) lst)
  (reverse vlst)
)
(defun mindist (alst blst)
  (setq dlst nil)
  (foreach a alst
   (foreach b blst
         (setq dlst (cons (list (distance (cdr a) (cdr b))(car a) (car b) )  dlst))
      )
  )
  (setq qlst (car (vl-sort dlst '(lambda(a b) (< (car a) (car b)) ) )))
  qlst
)
(defun dolst(ptslst)
(setq vlst (list (car ptslst)) rlst (cdr ptslst) ddlst nil)
(while (not (null rlst))
      (setq qlst (mindist vlst rlst))
               (setq ddlst (cons (cdr qlst) ddlst))
      (setq vlst (cons (assoc (last qlst)  rlst) vlst))
      (setq rlst (vl-remove (assoc (last qlst)  rlst) rlst))
)
ddlst
)

(setq plst (fp) num (length plst))
(setq ddlst (hf (dolst plst)) nnum (length ddlst))
(setq ptm (mapcar '(lambda (x ) (cons x (- nnum (length (vl-remove x ddlst))))) (fnlst (length plst))))
(setq pt0s (vl-remove nil (mapcar '(lambda (x) (if (> (cdr x) 2) (car x))) ptm)))

;;;设置距离矩阵变量
(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 (nth (fix (* (length pt0s) (rnd))) pt0s) 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 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 ij (+ ij 1))
)
(setq pts (mapcar '(lambda (x) (cdr (assoc x plst))) (cdr p_best)))
(apply 'command (cons "pline" (reverse (cons "c" (reverse pts)))))
)

aisong220 · 发表于 2019-1-30 17:52:16

aimisiyou · 发表于 2019-1-30 18:42:20

本帖最后由 aimisiyou 于 2019-1-30 18:44 编辑

aimisiyou 发表于 2019-1-30 17:41
(defun c:tt()
;;;随机函数
(defun rnd()

还是30个点，运行了几次，路径长度在430~450之间，整体平均值距全局最优路径距离423.741更接近，可见将起始点选在点集最小生成树上度数较多的点上，对结果的理想度是增益的。

aimisiyou · 发表于 2019-4-8 18:35:10

;;;N_d 越大越接近最优解，设置N_d=2000时运行结果
(defun rnd ()
  (*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun rnd_n (n)
  (fix (* n (rnd)))
)
(defun pick (lst i j)
(setq count (length lst) nc 0 picklst nil)
(while (<= nc j)
   (if (<= i nc)
         (setq picklst (cons (nth nc lst) picklst))
   )
   (setq nc (+ nc 1))
)
(reverse picklst)
)
;;;重新洗牌
(defun xipai (n)
  (setq i 1 j 0 klst nil)
  (while (<= i n)
   (setq klst (cons i klst))
   (setq i (+ 1 i))
)
(while (<= j 20)
      (setq i_pot (rnd_n n))
      (setq j_pot (rnd_n n))
      (setq nmin (min i_pot j_pot))
      (setq nmax (max i_pot j_pot))
      (setq klst (append (pick klst  (+ 1 nmax) (- n 1)) (pick klst (+ 1 nmin) nmax) (pick klst 0 nmin)))
      (setq j (+ j 1))
)
(mapcar '1- klst)
)
(defun fitfun (ptlst)
  (apply '+ (mapcar 'distance ptlst (append (cdr ptlst) (list (car ptlst)))))
)
;;;取点函数
(defun fp ()
(setq sn (ssget ":N" '((0 . "point"))))
(setq i 0 n (sslength sn) pts nil)
(while (< i n)
      (setq pts (cons (cons i (cdr (assoc 10 (entget (ssname sn i))))) pts))
      (setq i (+ i 1))
)
(reverse pts)
)
(setq pts (fp))
(setq poplst nil)
(repeat 100
  (setq plst (xipai (length pts)))
  (setq poplst (cons plst poplst))
)
(defun n-pt (nlst)
(mapcar '(lambda (x) (cdr (nth x pts))) nlst)
)
(setq p_best  (car (vl-sort (mapcar '(lambda (x y) (cons (fitfun (n-pt x)) y))
                                    poplst
                                    poplst
                                                      )
                           '(lambda (e1 e2)  (< (car e1) (car e2)) )
                  )
            )
)
(setq p_chane 0.02  N_d 2000 ii 0)
(while (< ii N_d)
(setq vlst nil)
(foreach en poplst
   (setq nt (length en))
   (setq  ens en pc1 (nth (rnd_n nt) ens) flag t clst (list pc1))
   (while flag
         (setq r_rnd (rnd))
         (if (< r_rnd p_chane)
                        (setq pc2 (nth (rnd_n (- nt 1)) (vl-remove pc1 ens)))
            (progn
                  (setq en_rnd (nth (rnd_n nt) poplst))
                                    (if (= pc1 (last en_rnd))
                                          (setq pc2 (car en_rnd))
                                          (setq pc2 (cadr (member pc1 en_rnd)) )
                                    )
                              )
                        )
                     (if (or (= pc2 (cadr (member pc1 ens))) (= pc1 (cadr (member pc2 ens))) )
                           (setq flag nil)
               (progn
                  (if (member pc2 (member pc1 ens))
                     (setq ens (append (reverse (member pc1 (reverse ens))) (member pc2 (reverse (cdr (member pc1 ens)))) (cdr (member pc2 ens)) ))
                        (setq ens (append (reverse (member pc2 (reverse ens))) (member pc1 (reverse (cdr (member pc2 ens)))) (cdr (member pc1 ens)) ))
                  )
                  (setq pc1 pc2)
                                       (setq clst (cons pc1 clst))
                                       (if (= (length clst) (- nt 1))
                                          (setq flag nil)
                                       )
                              )
                     )
         )
   (if (< (fitfun (n-pt ens)) (fitfun (n-pt en)))
               (setq vlst (cons ens vlst))
            (setq vlst (cons en  vlst))
         )
      )
(setq ii (+ 1 ii))
(setq poplst vlst)
(setq p_bestnew  (car (vl-sort (mapcar '(lambda (x y) (cons (fitfun (n-pt x)) y)) poplst poplst)
                                          '(lambda (e1 e2)  (< (car e1) (car e2)) )
                                 )
                              )
               )
  (if (< (car p_bestnew) (car p_best) )
   (setq  p_best p_bestnew)
)
)
(apply 'command (cons "pline" (reverse (cons "c" (reverse (n-pt (cdr p_best)))))))

aimisiyou · 发表于 2019-5-1 23:58:31

本帖最后由 aimisiyou 于 2019-5-2 00:03 编辑

设置N_d=3000，得到pr76的较好解108155.6347。

aimisiyou · 发表于 2019-5-2 00:38:25

100个点，设置N_d=5000，运行6分45秒，得出结果图。
为提高效率，可将初始种群优化，如从最邻近集中选取，减少遗传算法运算量。

aimisiyou · 发表于 2019-5-3 19:02:46

本帖最后由 aimisiyou 于 2019-5-17 10:46 编辑

;;;最小1-树
;;;取点函数
(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)
)
(defun mindist (alst blst)
  (setq dlst nil)
  (foreach a alst
   (foreach b blst
         (setq dlst (cons (list (distance (cdr a) (cdr b))(car a) (car b) )  dlst))
      )
  )
  (setq qlst (car (vl-sort dlst '(lambda(a b) (< (car a) (car b))))))
)
(defun dolst(pts)
(setq vlst (list (car pts)) rlst (cdr pts) ddlst nil)
(while (not (null rlst))
      (setq qlst (mindist vlst rlst))
      (setq ddlst (cons (cdr qlst) ddlst))
      (setq vlst (cons (assoc (last qlst)  rlst) vlst))
      (setq rlst (vl-remove (assoc (last qlst)  rlst) rlst))
)
ddlst
)
(defun one_tree (pt pts)
  (setq pdlst (vl-sort  (mapcar '(lambda (en) (cons (distance (cdr pt) (cdr en)) (list (car pt) (car en)))) pts)  '(lambda (x y) (<= (car x) (car y)))))
  (setq ddlst (dolst pts))
  (setq vlst (cons (cdr (car pdlst)) (cons (cdr (cadr pdlst)) ddlst)))
)
(defun disfun (dlst pts)
(setq va (apply '+ (mapcar '(lambda (x)
                              (distance
                                 (cdr (assoc (car x) pts))
                                    (cdr (assoc (cadr x) pts))
                                 )
                                 )
                                                         dlst
                                       )
                     )
  )
)
(defun min_tree (n_pts)
  (setq ones_tree (mapcar '(lambda (y) (one_tree y (vl-remove y n_pts))) n_pts))
  (setq ppt (car (vl-sort  (mapcar '(lambda (x) (cons (disfun x n_pts) x)) ones_tree) '(lambda (x y) (< (car x) (car y))))))
)
(setq pts (fp))
(mapcar '(lambda (x) (command "line"
                           (cdr (assoc (car x) pts))
                                                      (cdr (assoc (cadr x) pts))
                                                      ""
                                       )
            )
(cdr (min_tree pts))
)

aimisiyou · 发表于 2019-5-3 19:56:16

本帖最后由 aimisiyou 于 2019-5-3 20:05 编辑

下面是如何求点对集内的闭合环路？（用两顶点序号表示一条边）
如点对集ppts='((40 54) (40 48) (16 4) (20 10) (11 28) (5 16) (2 27) (13 2) (30 13) (3 1) (29 12) (22 23) (7 22) (7 8) (37 7) (34 37) (51 34) (31 3) (19 11) (52 29) (15 32) (20 19) (14 30) (57 14) (9 20) (15 31) (43 15) (38 5) (9 21) (36 9) (18 36) (51 18) (47 35) (56 57) (46 51) (45 46) (49 45) (39 49) (53 52) (47 53) (48 47) (48 54) (56 48) (56 58) (41 56) (41 42) (55 41) (39 55) (43 39) (44 43) (50 44) (38 50) (38 26) (17 38) (33 17) (6 33) (6 24) (25 6) (0 25))
运行后的结果是'((40 54)(40 48)(48 54))

账号		自动登录	找回密码
密码			立即注册

[研讨] 蚁群算法求旅行商问题

点评