采用遗传算法求解最短路径问题（已知起终点并经其他所有点）

dcl1214

aimisiyou 发表于 2020-2-6 14:35
两者有区别，迪杰斯特拉计算的两点间最短路径不需要经过其他所有点。那个可以用弗洛伊德十字法实现，复杂 ...

整体最短路径，其实就是单个的两点最短，是不是？如果两点不是最短，那么整体也不是最短，你这个可以求出好几个整体最短，然后排序取第一个

dcl1214

aimisiyou 发表于 2020-2-6 14:35
两者有区别，迪杰斯特拉计算的两点间最短路径不需要经过其他所有点。那个可以用弗洛伊德十字法实现，复杂 ...

迪杰斯特拉穷举一万条路径，只需要一秒钟

dcl1214

不知道您的最短路径是否允许干涉存在，如果不允许干涉存在就不要往下看了，以下是我随便写的几句代码

1. (setq ss (ssget (list (cons 0 "point"))))
   
2. (setq ents (ssToentlst ss))
   
3. (setq jbs (mapcar (function (lambda (a) (cdr (assoc 5 (entget a)))))
   
4.                   ents
   
5.           )
   
6. )
   
7. (setq jbs-2 ($列表两两组合$ jbs))
   
8. (setq
   
9.   jbs-2-L
   
10.    (apply 'append
    
11.           (mapcar
    
12.             (function
    
13.               (lambda (a / l)
    
14.                 (setq
    
15.                   l (distance
    
16.                       (cdr (assoc 10 (entget (handent (car a)))))
    
17.                       (cdr (assoc 10 (entget (handent (cadr a)))))
    
18.                     )
    
19.                 )
    
20.                 (list (reverse (cons l (reverse a)))
    
21.                       (reverse (cons l a))
    
22.                 )
    
23.               )
    
24.             )
    
25.             jbs-2
    
26.           )
    
27.    )
    
28. )
    
29. (SETQ LJS NIL)
    
30. (setq sart (cdr (assoc 5 (entget (car (entsel))))))
    
31. (WHILE
    
32.   (SETQ        DATA (VL-REMOVE-IF-NOT
    
33.                (FUNCTION (LAMBDA (A) (= (CAR A) sart)))
    
34.                jbs-2-L
    
35.              )
    
36.   )
    
37.    (SETQ DATA (VL-REMOVE-IF
    
38.                 (FUNCTION (LAMBDA (A) (MEMBER (CADR A) LJS)))
    
39.                 DATA
    
40.               )
    
41.    )
    
42.    (SETQ
    
43.      N (CAR
    
44.          (VL-SORT DATA
    
45.                   (FUNCTION (LAMBDA (E1 E2) (< (NTH 2 E1) (NTH 2 E2))))
    
46.          )
    
47.        )
    
48.    )
    
49.    (SETQ jbs-2-L (VL-REMOVE-IF
    
50.                    (FUNCTION (LAMBDA (A) (= (CAR A) SART)))
    
51.                    jbs-2-L
    
52.                  )
    
53.    )
    
54.    (SETQ LJS (CONS sart LJS))
    
55.    (SET 'SART (CADR N))
    
56. )
    
57. (SETQ LJS (REVERSE LJS))
    
58. (MAPCAR        (FUNCTION
    
59.           (LAMBDA (A B)
    
60.             (vla-addLine
    
61.               (vla-Get-ModelSpace
    
62.                 (vla-get-ActiveDocument
    
63.                   (vlax-get-acad-object)
    
64.                 )
    
65.               )
    
66.               (vlax-3D-Point (cdr (assoc 10 (entget (handent A)))))
    
67.               (vlax-3D-Point (cdr (assoc 10 (entget (handent B)))))
    
68.             )
    
69.           )
    
70.         )
    
71.         LJS
    
72.         (CDR LJS)
    
73. )
    
74. 
    

(setq ss (ssget (list (cons 0 "point"))))<br /> (setq ents (ssToentlst ss))<br /> (setq jbs (mapcar (function (lambda (a) (cdr (assoc 5 (entget a)))))<br />                   ents<br />           )<br /> )<br /> (setq jbs-2 ($列表两两组合$ jbs))<br /> (setq<br />   jbs-2-L<br />    (apply 'append<br />           (mapcar<br />             (function<br />               (lambda (a / l)<br />                 (setq<br />                   l (distance<br />                       (cdr (assoc 10 (entget (handent (car a)))))<br />                       (cdr (assoc 10 (entget (handent (cadr a)))))<br />                     )<br />                 )<br />                 (list (reverse (cons l (reverse a)))<br />                       (reverse (cons l a))<br />                 )<br />               )<br />             )<br />             jbs-2<br />           )<br />    )<br /> )<br /> (SETQ LJS NIL)<br /> (setq sart (cdr (assoc 5 (entget (car (entsel))))))<br /> (WHILE<br />   (SETQ        DATA (VL-REMOVE-IF-NOT<br />                (FUNCTION (LAMBDA (A) (= (CAR A) sart)))<br />                jbs-2-L<br />              )<br />   )<br />    (SETQ DATA (VL-REMOVE-IF<br />                 (FUNCTION (LAMBDA (A) (MEMBER (CADR A) LJS)))<br />                 DATA<br />               )<br />    )<br />    (SETQ<br />      N (CAR<br />          (VL-SORT DATA<br />                   (FUNCTION (LAMBDA (E1 E2) (< (NTH 2 E1) (NTH 2 E2))))<br />          )<br />        )<br />    )<br />    (SETQ jbs-2-L (VL-REMOVE-IF<br />                    (FUNCTION (LAMBDA (A) (= (CAR A) SART)))<br />                    jbs-2-L<br />                  )<br />    )<br />    (SETQ LJS (CONS sart LJS))<br />    (SET 'SART (CADR N))<br /> )<br /> (SETQ LJS (REVERSE LJS))<br /> (MAPCAR        (FUNCTION<br />           (LAMBDA (A B)<br />             (vla-addLine<br />               (vla-Get-ModelSpace<br />                 (vla-get-ActiveDocument<br />                   (vlax-get-acad-object)<br />                 )<br />               )<br />               (vlax-3D-Point (cdr (assoc 10 (entget (handent A)))))<br />               (vlax-3D-Point (cdr (assoc 10 (entget (handent B)))))<br />             )<br />           )<br />         )<br />         LJS<br />         (CDR LJS)<br /> )<br /> <br />

如果将起始点设定为中间那个点，结果有点像外凸壳

aimisiyou

dcl1214 发表于 2020-2-6 15:04
整体最短路径，其实就是单个的两点最短，是不是？如果两点不是最短，那么整体也不是最短，你这个可以求出 ...

你还没理解限制条件的意思，如果没有限制条件，那肯定是直线最短啊。迪法是经过一些中转点（道路连通的，不需要中转点当然更好），找到最短的一条路。我这里是加强了限制条件，必须是经过所有其他点的一条路，其距离最短。