设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › 算法与数据结构 › 蚁群算法求旅行商问题
1234下一页
返回列表 发新帖
楼主: aimisiyou

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

[复制链接]
LoveArx

已领礼包: 13个

财富等级: 恭喜发财
发表于 2019-1-20 00:20:08 | 显示全部楼层
aimisiyou 发表于 2019-1-20 00:17
lisp效率本身就不高啊，我只是想将算法用lisp来实现，并对算法进行优化，关于效率可以选择其他语言来提高 ...

算法是不是最重要的呢？低效的算法即使使用再快的语言，也不会比LISP使用高效的算法来的快吧。
希望楼主能让算法更高效些。

点评

aimisiyou
lisp里没有矩阵，变量更新效率太低了，如果有矩阵，运算效率会大大提高。算法当然是最重要的了，相比暴力求解，还是很可以接受的，而且程序运行结果相比全局最短路径，大概超出5%左右，综合考虑不运行时间的结果接近  详情 回复 发表于 2019-1-20 00:29
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1861个

财富等级: 堆金积玉
 楼主| 发表于 2019-1-20 00:29:13 | 显示全部楼层
本帖最后由 aimisiyou 于 2019-1-20 00:30 编辑
LoveArx 发表于 2019-1-20 00:20
算法是不是最重要的呢？低效的算法即使使用再快的语言，也不会比LISP使用高效的算法来的快吧。
希望楼主 ...

lisp里没有矩阵，变量更新效率太低了，如果有矩阵，运算效率会大大提高。算法当然是最重要的了，相比暴力求解，还是很可以接受的，而且程序运行结果相比全局最短路径，大概超出5%左右，综合考虑运行时间和结果接近度，还是勉强可以接受的。

点评

LoveArx
LISP里面有矩阵啊，可以自己写矩阵的代码啊 （XD::Mat:AlignCoordSys）从一个坐标系到另一个坐标系的变换矩阵15 个回复 - 226 次查看**** 本内容被作者隐藏 **** 具体应用： 关于文字框坐标变换的理解见： http://b  详情 回复 发表于 2019-1-20 00:38
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

LoveArx

已领礼包: 13个

财富等级: 恭喜发财
发表于 2019-1-20 00:38:52 | 显示全部楼层
aimisiyou 发表于 2019-1-20 00:29
lisp里没有矩阵，变量更新效率太低了，如果有矩阵，运算效率会大大提高。算法当然是最重要的了，相比暴力 ...

LISP里面有矩阵啊，可以自己写矩阵的代码啊
（XD::Mat:AlignCoordSys）从一个坐标系到另一个坐标系的变换矩阵
15 个回复 - 226 次查看
**** 本内容被作者隐藏 **** 具体应用： 关于文字框坐标变换的理解见： http://bbs.xdcad.net/forum.php?m ... 00&fromuid=5280
2018-4-1 18:56 - marting - 开源函数库



点评

aimisiyou
我说的矩阵是矩阵变量啊，里面的单元需要更新数值的。  详情 回复 发表于 2019-1-20 00:46
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1861个

财富等级: 堆金积玉
 楼主| 发表于 2019-1-20 00:46:31 | 显示全部楼层
LoveArx 发表于 2019-1-20 00:38
LISP里面有矩阵啊，可以自己写矩阵的代码啊
（XD::Mat:AlignCoordSys）从一个坐标系到另一个坐标系的变 ...

我说的矩阵是矩阵变量啊，里面的单元需要更新数值的。

点评

LoveArx
【效率测试】返回表奇数位元素组成子表的几个代码的效率比较18 个回复 - 211 次查看1、2和3的算法相同，只是一个构建表，一个用vl-remove 删除偶数位的NIL，但效率差别很大。 2、最快的是1，递归算法，表元素30000一  详情 回复 发表于 2019-1-20 01:09
LoveArx
我觉得你可以用LISP表表达矩阵，更新就去更新表，然后研究下表的算法，LISP不同代码处理表效率也是天壤之别的，LISP论坛有些测试的帖子，不同的处理方法也是有数量级的差别的 找个好的表的处理方法，能提高你的代  详情 回复 发表于 2019-1-20 01:02
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

LoveArx

已领礼包: 13个

财富等级: 恭喜发财
发表于 2019-1-20 01:02:18 | 显示全部楼层
aimisiyou 发表于 2019-1-20 00:46
我说的矩阵是矩阵变量啊，里面的单元需要更新数值的。

我觉得你可以用LISP表表达矩阵，更新就去更新表，然后研究下表的算法，LISP不同代码处理表效率也是天壤之别的，LISP论坛有些测试的帖子，不同的处理方法也是有数量级的差别的

找个好的表的处理方法，能提高你的代码的效率
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

LoveArx

已领礼包: 13个

财富等级: 恭喜发财
发表于 2019-1-20 01:09:07 | 显示全部楼层
aimisiyou 发表于 2019-1-20 00:46
我说的矩阵是矩阵变量啊，里面的单元需要更新数值的。

【效率测试】返回表奇数位元素组成子表的几个代码的效率比较
18 个回复 - 211 次查看
1、2和3的算法相同，只是一个构建表，一个用vl-remove 删除偶数位的NIL，但效率差别很大。 2、最快的是1，递归算法，表元素30000一下，秒其他两个，但缺点就是受到堆栈的限制，在元素确定不是很多（万以上）时 ...
2017-12-11 15:57 - newer - A/VLISP

【终极测试】repeat,while,mapcar,foreach到底哪个快？
10 个回复 - 267 次查看
今天我们来测试下 repeat,while,mapcar,foreach四个函数的执行效率 对 长度32768的表进行测试 1、 从表中提出每个元素加以利用，上面的代码效率为： 上面结果看到，while,repeat比mapcar,foreach慢 ...
2017-6-8 10:42 - newer - A/VLISP

关于LISP表处理的测试练习，看看谁的代码高效的前提下更简洁
67 个回复 - 4807 次查看
条件：点表 Pts = '(p1 p2 p3 p4 p5...pn) 得： '((p1 p2)(p2 p3)(p3 p4)....(pn-1 pn)) 大家试试写下代码。
2013-5-26 13:29 - Lispboy - A/VLISP

获取图层列表的三种方法和效率比较
128 个回复 - 1510 次查看
方法三： **** 本内容被作者隐藏 **** 效率比较： (GETLAYERS3).....1123 / 1.40 (GETLAYERS1).....1264 / 1.25 (GETLAYERS2).....1576 / 1.00
2017-4-4 11:33 - marting - A/VLISP

论坛标准nth和where及cdddr实现的三种nth效率问题
6 个回复 - 105 次查看
前几天大家讨论了求子表效率的问题，得到了结论，就是在循环里面获取连续的子表的时候尽量不要用nth函数，而是通过cdr和where结合取得各个位置的元素，这样效率最好，得到的结论好像是nth效率不高， 下面通过测试 ...
2017-6-11 16:08 - newer - A/VLISP

WHILE循环和REPEAT循环效率的比较
4 个回复 - 109 次查看
都听说是while 循环 比 repeat 循环效率高，今天测试下，让数据说话 上面代码， ss->ents1、ss->ents2分别是用repeat 循环和while循环遍历选择集获取实体表。 测试18万个实体选择集，循环10次，求出平均时间 ...
2017-3-31 09:50 - marting - A/VLISP

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1861个

财富等级: 堆金积玉
 楼主| 发表于 2019-1-20 01:11:10 | 显示全部楼层
http://stevedower.id.au/blog/research/oliver-30/
网上找到30个城市的测试数据。（全局最短路径423.741）

(setq pts
'((54  67)
(54  62)
(37  84)
(41  94)
(2  99)
(7  64)
(25  62)
(22  60)
(18  54)
(4  50)
(13  40)
(18  40)
(24  42)
(25  38)
(44  35)
(41  26)
(45  21)
(58  35)
(62  32)
(82  7)
(91  38)
(83  46)
(71  44)
(64  60)
(68  58)
(83  69)
(87  76)
(74  78)
(71  71)
(58  69)
)
)
(mapcar '(lambda  (x) (command "point" x "")) pts)

程序运行70秒，得到结果431.2675，高出全局最短路径1.776%。
15.png

点评

LoveArx
下面的代码，用了凸包， Distance : 427.1351667285744 Elapsed time : 0.531 seconds... 长度427.13， 时间才0.531秒，代码还不长。说明了算法的重要性，什么语言真不是太重要的，算法是基础，数据结  详情 回复 发表于 2019-1-20 01:54
LoveArx
【挑战】获取子表46 个回复 - 287 次查看例子： (SubList '(0 1 2 3 4 5) 2 3) >> (2 3 4) (SubList '(0 1 2 3 4 5) 2 nil) >> (2 3 4 5) (SubList '(0 1 2 3 4 5) 6 3) >> nil 提供一个：2017-6-8 22:19 - newer -  详情 回复 发表于 2019-1-20 01:12
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

LoveArx

已领礼包: 13个

财富等级: 恭喜发财
发表于 2019-1-20 01:12:51 | 显示全部楼层
aimisiyou 发表于 2019-1-20 01:11
http://stevedower.id.au/blog/research/oliver-30/
网上找到30个城市的测试数据。（全局最短路径423.741 ...

【挑战】获取子表
46 个回复 - 287 次查看
例子： (SubList '(0 1 2 3 4 5) 2 3) >> (2 3 4) (SubList '(0 1 2 3 4 5) 2 nil) >> (2 3 4 5) (SubList '(0 1 2 3 4 5) 6 3) >> nil 提供一个：
2017-6-8 22:19 - newer - A/VLISP

【挑战】表按照给定的数重新分组
25 个回复 - 179 次查看
表按照给定的数重新分组 例如： (group1 '(1 2 3 4 5 6 7) 2) => '((1 2)(3 4)(5 6)(7 nil)) (group1 '(1 2 3 4 5 6 7) 3) => '((1 2 3)(4 5 6)(7 nil nil)) 分享一个，递归的 测试效率
2017-6-6 18:46 - newer - A/VLISP

点评

aimisiyou
讲真，lisp里用设置变量代替矩阵变量是最快的，若用表去表示，用到cons,append,vl-remove,只会大大增加运算量。说点题外话，lisp里最多能设置多少个变量？如果有100个城市，那么边的数目就有100*99/2=4950个，变量数  详情 回复 发表于 2019-1-20 01:25
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1861个

财富等级: 堆金积玉
 楼主| 发表于 2019-1-20 01:25:38 | 显示全部楼层
LoveArx 发表于 2019-1-20 01:12
【挑战】获取子表46 个回复 - 287 次查看例子： (SubList '(0 1 2 3 4 5) 2 3) >> (2 3 4) (SubList '(0  ...

讲真，lisp里用设置变量代替矩阵变量是最快的，若用表去表示，用到cons,append,vl-remove,只会大大增加运算量。说点题外话，lisp里最多能设置多少个变量？如果有100个城市，那么边的数目就有100*99/2=4950个，变量数目多了不知对程序运行是否有影响？

点评

LoveArx
算法是第一，其次是数据结构，考虑时间也要考虑空间 即使你用C，C++，也不可能用4950个变量去表示那些边，也一定要选合适的数据结构，比如 vector,map等等 这些容器有自己的算法去运算，LISP之所以人工智能用的最  详情 回复 发表于 2019-1-20 01:39
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

LoveArx

已领礼包: 13个

财富等级: 恭喜发财
发表于 2019-1-20 01:39:54 | 显示全部楼层
aimisiyou 发表于 2019-1-20 01:25
讲真，lisp里用设置变量代替矩阵变量是最快的，若用表去表示，用到cons,append,vl-remove,只会大大增加运 ...

算法是第一，其次是数据结构，考虑时间也要考虑空间
即使你用C，C++，也不可能用4950个变量去表示那些边，也一定要选合适的数据结构，比如 vector,map等等
这些容器有自己的算法去运算，LISP之所以人工智能用的最多，主要就是LIST， CONS,REVERSE，MAPCAR 这些很快的。你大可不必在这地方费心思提高那么点效率，你还要方便的组织数据呢。要想更快，直接汇编好了，但是使用上不一定方便。
去找最合适的数据结构，配上最好的算法，才是保证。

点评

aimisiyou
是啊，要找到最合适的数据结构，配上最好的算法，运算才是最佳的。  详情 回复 发表于 2019-1-20 01:58
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

LoveArx

已领礼包: 13个

财富等级: 恭喜发财
发表于 2019-1-20 01:54:25 | 显示全部楼层
aimisiyou 发表于 2019-1-20 01:11
http://stevedower.id.au/blog/research/oliver-30/
网上找到30个城市的测试数据。（全局最短路径423.741 ...

你给的那30个城市，

下面的代码，用了凸包，

Distance : 427.1351667285744
Elapsed time : 0.531 seconds...


长度427.13， 时间才0.531秒，代码还不长。说明了算法的重要性，什么语言真不是太重要的，算法是基础，数据结构是桥梁。

搜狗截图20190120015023.png



  1. (defun c:TSP-2D-MR ( / LM:ConvexHull-ptsonHull LM:Clockwise-p ss ti i pl pln dmin k plp pld pll d r pp )

  3.   ;; Convex Hull  -  Lee Mac
  4.   ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.

  6.   (defun LM:ConvexHull-ptsonHull ( lst / ch p0 lstl )
  7.       (cond
  8.           (   (< (length lst) 4) lst)
  9.           (   (setq p0 (car lst))
  10.               (foreach p1 (cdr lst)
  11.                   (if (or (< (cadr p1) (cadr p0))
  12.                           (and (equal (cadr p1) (cadr p0) 1e-8) (< (car p1) (car p0)))
  13.                       )
  14.                       (setq p0 p1)
  15.                   )
  16.               )
  17.               (setq lst (vl-remove p0 lst))
  18.               (setq lst (append (list p0) lst))
  19.               (setq lst
  20.                   (vl-sort lst
  21.                       (function
  22.                           (lambda ( a b / c d )
  23.                               (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
  24.                                   (< (distance p0 a) (distance p0 b))
  25.                                   (< (if (equal c (* 2.0 pi) 1e-8) 0.0 c) (if (equal d (* 2.0 pi) 1e-8) 0.0 d))
  26.                               )
  27.                           )
  28.                       )
  29.                   )
  30.               )
  31.               (setq lstl (vl-remove-if-not (function (lambda ( x ) (equal (angle p0 (last lst)) (angle p0 x) 1e-8))) lst))
  32.               (setq lst (vl-remove-if (function (lambda ( x ) (equal (angle p0 (last lst)) (angle p0 x) 1e-8))) lst))
  33.               (setq lstl (vl-sort lstl (function (lambda ( a b ) (> (distance p0 a) (distance p0 b))))))
  34.               (setq lst (append lst lstl))
  35.               (setq ch (list (cadr lst) (car lst)))
  36.               (foreach pt (cddr lst)
  37.                   (setq ch (cons pt ch))
  38.                   (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
  39.                       (setq ch (cons pt (cddr ch)))
  40.                   )
  41.               )
  42.               (reverse ch)
  43.           )
  44.       )
  45.   )

  47.   ;; Clockwise-p  -  Lee Mac
  48.   ;; Returns T if p1,p2,p3 are clockwise oriented or collinear

  50.   (defun LM:Clockwise-p ( p1 p2 p3 )
  51.       (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
  52.               (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
  53.           )
  54.           0.0
  55.       )
  56.   )

  58.   (setq ss (ssget '((0 . "POINT"))))
  59.   (repeat (setq i (sslength ss))
  60.     (setq pl (cons (mapcar '+ '(0 0) (cdr (assoc 10 (entget (ssname ss (setq i (1- i))))))) pl))
  61.   )
  62.   (setq ti (car (_vl-times)))
  63.   (setq pln (LM:ConvexHull-ptsonHull pl))
  64.   (foreach p pln
  65.     (setq pl (vl-remove p pl))
  66.   )
  67.   (while pl
  68.     (setq dmin 1e+99)
  69.     (foreach p pl
  70.       (setq k -1)
  71.       (repeat (length pln)
  72.         (setq k (1+ k))
  73.         (setq plp (reverse (cdr (member (nth k pln) (reverse pln)))))
  74.         (setq pls (member (nth k pln) pln))
  75.         (setq pll (append plp (list p) pls))
  76.         (setq d (apply '+ (mapcar '(lambda ( a b ) (distance a b)) pll (append (cdr pll) (list (car pll))))))
  77.         (if (< d dmin)
  78.           (setq dmin d r pll pp p)
  79.         )
  80.       )
  81.     )
  82.     (setq pln r)
  83.     (setq pl (vl-remove pp pl))
  84.   )
  85.   (entmake
  86.     (append
  87.       (list
  88.         '(0 . "LWPOLYLINE")
  89.         '(100 . "AcDbEntity")
  90.         '(100 . "AcDbPolyline")
  91.         (cons 90 (length pln))
  92.         (cons 70 (1+ (* (getvar 'plinegen) 128)))
  93.         '(38 . 0.0)
  94.       )
  95.       (mapcar '(lambda ( x ) (cons 10 x)) pln)
  96.       (list
  97.         '(210 0.0 0.0 1.0)
  98.         '(62 . 1)
  99.       )
  100.     )
  101.   )
  102.   (prompt "\nDistance : ") (princ (rtos dmin 2 50))
  103.   (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds...")
  104.   (princ)
  105. )




点评

aimisiyou
厉害。根据点与点之间的关系去找算法，确实很高效，但需要个人有很深的洞察力和很强的逻辑判断力。相对来说，随机算法就不需要个人很深的功底了，过程让机器去模拟，静待结果就好。随机算法的通用性似乎更高些，个人  详情 回复 发表于 2019-1-20 02:14
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1861个

财富等级: 堆金积玉
 楼主| 发表于 2019-1-20 01:58:01 | 显示全部楼层
LoveArx 发表于 2019-1-20 01:39
算法是第一，其次是数据结构，考虑时间也要考虑空间
即使你用C，C++，也不可能用4950个变量去表示那些边 ...

是啊，要找到最合适的数据结构，配上最好的算法，运算才是最佳的。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1861个

财富等级: 堆金积玉
 楼主| 发表于 2019-1-20 02:02:43 | 显示全部楼层
本帖最后由 aimisiyou 于 2019-1-20 12:41 编辑

网上搜到tsp.eil51问题的数据（最短路径426，每边取整数）
(setq pts '((37 52)
(49 49)
(52 64)
(20 26)
(40 30)
(21 47)
(17 63)
(31 62)
(52 33)
(51 21)
(42 41)
(31 32)
(5 25)
(12 42)
(36 16)
(52 41)
(27 23)
(17 33)
(13 13)
(57 58)
(62 42)
(42 57)
(16 57)
(8 52)
(7 38)
(27 68)
(30 48)
(43 67)
(58 48)
(58 27)
(37 69)
(38 46)
(46 10)
(61 33)
(62 63)
(63 69)
(32 22)
(45 35)
(59 15)
(5 6)
(10 17)
(21 10)
(5 64)
(30 15)
(39 10)
(32 39)
(25 32)
(25 55)
(48 28)
(56 37)
(30 40
)))
(mapcar '(lambda  (x) (command "point" x "")) pts)

程序运行2分50秒，结果490.66，偏差有点大，先标记下。
51.png

点评

LoveArx
Distance : 454.2954781556905 Elapsed time : 2.297 seconds... 2.2秒， 距离454，图形很好看 [attachimg]84081[/attachimg] 同上面那个代码不同，有些改善。  详情 回复 发表于 2019-1-20 02:28
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1861个

财富等级: 堆金积玉
 楼主| 发表于 2019-1-20 02:14:31 | 显示全部楼层
本帖最后由 aimisiyou 于 2019-1-20 10:39 编辑
LoveArx 发表于 2019-1-20 01:54
你给的那30个城市，

下面的代码，用了凸包，

厉害。根据点与点之间的关系去找确定型算法，确实很高效，但需要个人有很深的洞察力和很强的逻辑判断力。相对来说，随机算法就不需要个人有很深的功底了，过程让机器去模拟，静待结果就好。随机算法的通用性似乎更高些，个人拙见。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

LoveArx

已领礼包: 13个

财富等级: 恭喜发财
发表于 2019-1-20 02:28:34 | 显示全部楼层
aimisiyou 发表于 2019-1-20 02:02
网上搜到tsp.eil51问题的数据（最短路径426，每边取整数）
(setq pts '((37 52)
(49 49)

Distance : 454.2954781556905
Elapsed time : 2.297 seconds...

2.2秒， 距离454，图形很好看


搜狗截图20190120022617.png

同上面那个代码不同，有些改善。

  1. (defun c:TSP-2D-MR ( / LM:ConvexHull-ptsonHull LM:Clockwise-p ss ti i pl pln dmin k plp pld pll d r pp lil lii1 lii2 lil1 lil2 ip ppl ppll )

  3.   ;; Convex Hull  -  Lee Mac
  4.   ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.

  6.   (defun LM:ConvexHull-ptsonHull ( lst / ch p0 lstl )
  7.       (cond
  8.           (   (< (length lst) 4) lst)
  9.           (   (setq p0 (car lst))
  10.               (foreach p1 (cdr lst)
  11.                   (if (or (< (cadr p1) (cadr p0))
  12.                           (and (equal (cadr p1) (cadr p0) 1e-8) (< (car p1) (car p0)))
  13.                       )
  14.                       (setq p0 p1)
  15.                   )
  16.               )
  17.               (setq lst (vl-remove p0 lst))
  18.               (setq lst (append (list p0) lst))
  19.               (setq lst
  20.                   (vl-sort lst
  21.                       (function
  22.                           (lambda ( a b / c d )
  23.                               (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
  24.                                   (< (distance p0 a) (distance p0 b))
  25.                                   (< (if (equal c (* 2.0 pi) 1e-8) 0.0 c) (if (equal d (* 2.0 pi) 1e-8) 0.0 d))
  26.                               )
  27.                           )
  28.                       )
  29.                   )
  30.               )
  31.               (setq lstl (vl-remove-if-not (function (lambda ( x ) (equal (angle p0 (last lst)) (angle p0 x) 1e-8))) lst))
  32.               (setq lst (vl-remove-if (function (lambda ( x ) (equal (angle p0 (last lst)) (angle p0 x) 1e-8))) lst))
  33.               (setq lstl (vl-sort lstl (function (lambda ( a b ) (> (distance p0 a) (distance p0 b))))))
  34.               (setq lst (append lst lstl))
  35.               (setq ch (list (cadr lst) (car lst)))
  36.               (foreach pt (cddr lst)
  37.                   (setq ch (cons pt ch))
  38.                   (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
  39.                       (setq ch (cons pt (cddr ch)))
  40.                   )
  41.               )
  42.               (reverse ch)
  43.           )
  44.       )
  45.   )

  47.   ;; Clockwise-p  -  Lee Mac
  48.   ;; Returns T if p1,p2,p3 are clockwise oriented or collinear

  50.   (defun LM:Clockwise-p ( p1 p2 p3 )
  51.       (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
  52.               (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
  53.           )
  54.           0.0
  55.       )
  56.   )

  58.   (setq ss (ssget '((0 . "POINT"))))
  59.   (repeat (setq i (sslength ss))
  60.     (setq pl (cons (mapcar (function +) '(0 0) (cdr (assoc 10 (entget (ssname ss (setq i (1- i))))))) pl))
  61.   )
  62.   (setq ti (car (_vl-times)))
  63.   (setq pln (LM:ConvexHull-ptsonHull pl))
  64.   (foreach p pln
  65.     (setq pl (vl-remove p pl))
  66.   )
  67.   (while pl
  68.     (setq ppl (LM:ConvexHull-ptsonHull pl))
  69.     (if (< (length ppl) 4)
  70.       (setq ppl (vl-sort ppl (function (lambda ( a b ) (< (distance (car pln) a) (distance (car pln) b))))))
  71.     )
  72.     (foreach p ppl
  73.       (setq pl (vl-remove p pl))
  74.     )
  75.     (setq ppll (append ppll (reverse ppl)))
  76.     (setq ppl nil)
  77.   )
  78.   (setq pl ppll)
  79.   (while pl
  80.     (foreach p pl
  81.       (setq k -1)
  82.       (repeat (length pln)
  83.         (setq k (1+ k))
  84.         (setq plp (reverse (member (nth k pln) (reverse pln))))
  85.         (setq pls (cdr (member (nth k pln) pln)))
  86.         (setq pll (append plp (list p) pls))
  87.         (setq d (apply (function +) (mapcar (function (lambda ( a b ) (distance a b))) pll (append (cdr pll) (list (car pll))))))
  88.         (setq r (cons (list d pll) r))
  89.       )
  90.     )
  91.     (setq r (vl-sort r (function (lambda ( a b ) (< (car a) (car b))))))
  92.     (setq r (vl-remove-if-not (function (lambda ( x ) (equal (caar r) (car x) 1e-8))) r))
  93.     (setq dmin 1e+99)
  94.     (foreach xx (mapcar (function cadr) r)
  95.       (if (vl-remove (vl-some (function (lambda ( x ) (if (vl-position x pl) x))) xx) pl)
  96.         (foreach p (vl-remove (vl-some (function (lambda ( x ) (if (vl-position x pl) x))) xx) pl)
  97.           (setq k -1)
  98.           (repeat (length xx)
  99.             (setq k (1+ k))
  100.             (setq plp (reverse (member (nth k xx) (reverse xx))))
  101.             (setq pls (cdr (member (nth k xx) xx)))
  102.             (setq pll (append plp (list p) pls))
  103.             (setq d (apply (function +) (mapcar (function (lambda ( a b ) (distance a b))) pll (append (cdr pll) (list (car pll))))))
  104.             (if (< d dmin)
  105.               (setq dmin d r pll pp (vl-remove nil (mapcar (function (lambda ( x ) (if (vl-position x pl) x))) pll)))
  106.             )
  107.           )
  108.         )
  109.         (setq r nil pln xx)
  110.       )
  111.     )
  112.     (if r
  113.       (progn
  114.         (setq pln r)
  115.         (foreach x pp
  116.           (setq pl (vl-remove x pl))
  117.         )
  118.         (setq r nil pp nil)
  119.       )
  120.       (setq pl nil)
  121.     )
  122.   )
  123.   (setq lil (mapcar (function (lambda ( a b ) (list a b))) pln (append (cdr pln) (list (car pln)))))
  124.   (while (vl-some (function (lambda ( li1 ) (vl-some (function (lambda ( li2 ) (if (and (setq ip (inters (car li1) (cadr li1) (car li2) (cadr li2))) (not (equal ip (car li1) 1e-8)) (not (equal ip (cadr li1) 1e-8)) (not (equal ip (car li2) 1e-8)) (not (equal ip (cadr li2) 1e-8))) (setq lii1 li1 lii2 li2)))) (vl-remove li1 lil)))) lil)
  125.     (setq lil1 (if (member lii2 (cdr (member lii2 (reverse (cdr (member lii1 (append lil lil))))))) (reverse (cdr (member lii2 (cdr (member lii2 (reverse (cdr (member lii1 (append lil lil))))))))) (reverse (cdr (member lii2 (reverse (cdr (member lii1 (append lil lil)))))))))
  126.     (setq lil2 (if (member lii1 (cdr (member lii1 (reverse (cdr (member lii2 (append lil lil))))))) (cdr (member lii1 (cdr (member lii1 (reverse (cdr (member lii2 (append lil lil)))))))) (cdr (member lii1 (reverse (cdr (member lii2 (append lil lil))))))))
  127.     (setq lil (append lil1 (list (list (cadr (last lil1)) (cadr (car lil2)))) (mapcar (function reverse) lil2) (list (list (car (last lil2)) (car (car lil1))))))
  128.   )
  129.   (setq pln (mapcar (function car) lil))
  130.   (setq d (apply (function +) (mapcar (function (lambda ( a b ) (distance a b))) pln (append (cdr pln) (list (car pln))))))
  131.   (entmake
  132.     (append
  133.       (list
  134.         '(0 . "LWPOLYLINE")
  135.         '(100 . "AcDbEntity")
  136.         '(100 . "AcDbPolyline")
  137.         (cons 90 (length pln))
  138.         (cons 70 (1+ (* (getvar 'plinegen) 128)))
  139.         '(38 . 0.0)
  140.       )
  141.       (mapcar (function (lambda ( x ) (cons 10 x))) pln)
  142.       (list
  143.         '(210 0.0 0.0 1.0)
  144.         '(62 . 1)
  145.       )
  146.     )
  147.   )
  148.   (prompt "\nDistance : ") (princ (rtos d 2 50))
  149.   (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds...")
  150.   (princ)
  151. )


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

下一页 »
1234下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-4-25 00:36 , Processed in 0.587072 second(s), 57 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表