（求助）最长路径怎么求？。

wowan1314 · 发表于 2013-3-27 20:36:50

本帖最后由 wowan1314 于 2013-4-4 12:30 编辑

如图，图中线为LINE线，圆心与线交点及线与线的交点处已经打断于点（当然如果您觉的不用打断那更好）。
鼠标点取A处直线求出沿图中相连接的线的路径中，即A-B A-C A-D A-E A-F A-G那段路径最长？图中A-G最长

或者我已通过点取A处直线然后由程序得到与之相连直线的点表。

格式为：((P1 P2)(p2 p3)(p2 p4)(p4 p5)(p3 p6)(p6 p7).......) 如何求出（P1 P2 P3 P6 P7...）(P1 P2 P4 P5...)..这样的结果？

请各位不吝赐教。放弃了。头疼想不明白

nzl1116 · 发表于 2024-5-13 19:42:49

(defun AYL-GetAllPath (SttPnt EndPnt PtsLst / AllPathLst CurPnt CurPathLst TestLst TmpLst DPtLst NxtPnt CurPathLst-s)
(setq AllPathLst nil)
(setq CurPathLst (List SttPnt))
(setq TestLst (list (list SttPnt CurPathLst PtsLst)))
(while TestLst
(setq TmpLst (car TestLst))
(setq TestLst (cdr TestLst))
(setq CurPnt (car TmpLst))
(setq CurPathLst (cadr TmpLst))
(setq PtsLst (caddr TmpLst))
(setq TmpLst (vl-remove-if-not (function (lambda (Pts) (member CurPnt Pts))) PtsLst))
(while TmpLst
(setq DPtLst (car TmpLst))
(setq TmpLst (cdr TmpLst))
(if (equal (car DPtLst) CurPnt)
(setq NxtPnt (cadr DPtLst))
(setq NxtPnt (car DPtLst))
)
(setq CurPathLst-s (cons NxtPnt CurPathLst))
(setq TestLst (cons (list NxtPnt CurPathLst-s (vl-remove DPtLst PtsLst)) TestLst))
(if (equal NxtPnt EndPnt)
(setq AllPathLst (cons (reverse CurPathLst-s) AllPathLst))
)
)
)
(princ "\n")
(princ (length AllPathLst))
(princ "\n")
AllPathLst
)

(defun AYL-GetAllPath (SttPnt EndPnt PtsLst / AllPathLst CurPnt CurPathLst TestLst TmpLst DPtLst NxtPnt CurPathLst-s) 
  (setq AllPathLst nil) 
  (setq CurPathLst (List SttPnt)) 
  (setq TestLst (list (list SttPnt CurPathLst PtsLst))) 
  (while TestLst 
    (setq TmpLst (car TestLst)) 
    (setq TestLst (cdr TestLst)) 
    (setq CurPnt (car TmpLst)) 
    (setq CurPathLst (cadr TmpLst)) 
    (setq PtsLst (caddr TmpLst)) 
    
    (setq TmpLst (vl-remove-if-not (function (lambda (Pts) (member CurPnt Pts))) PtsLst)) 
    (while TmpLst 
      (setq DPtLst (car TmpLst)) 
      (setq TmpLst (cdr TmpLst)) 
      (if (equal (car DPtLst) CurPnt) 
        (setq NxtPnt (cadr DPtLst)) 
        (setq NxtPnt (car DPtLst)) 
      ) 
      (setq CurPathLst-s (cons NxtPnt CurPathLst)) 
      (setq TestLst (cons (list NxtPnt CurPathLst-s (vl-remove DPtLst PtsLst)) TestLst)) 
      (if (equal NxtPnt EndPnt) 
        (setq AllPathLst (cons (reverse CurPathLst-s) AllPathLst)) 
      ) 
    ) 
  ) 
  (princ "\n") 
  (princ (length AllPathLst)) 
  (princ "\n") 
  AllPathLst 
)

jdlfjk · 发表于 2013-3-28 13:20:50

将点对的列表按点的长度排序不就行了？
(distance '(0 0) '(1 1))
vl-sort
用这样的函数

zml84 · 发表于 2013-3-28 13:31:59

参考思路：http://zml84.blog.sohu.com/84038736.html

wowan1314 · 发表于 2013-3-28 13:51:11

本帖最后由 wowan1314 于 2013-3-28 13:58 编辑

我也做了个函数计算。不过如果中间有分支的情况就只能算一条。
比如只求了A-B  A-C A-G 三条。 A-D A-E A-F就漏掉了
;|
(SETQ LST '(((1 1 0) (2 2 0)) ((2 2 0) (4 4 0)) ((4 4 0) (5 5 0)) ((2 2 0) (6 6 0))((7 7 0) (2 2 0)) ((7 7 0) (8 8 0))))
(YY_321 '(((1 1 0) (2 2 0))) LST)
|;
(defun YY_321 (LST1 Lst / LstNew LST2 I PT1 PT2 _LstItem)

(SETQ I 0 LST3 LST1)
(WHILE
  (SETQ LST2 (NTH I (reverse LST1)))
  (SETQ PT1 (CAR LST2))
  (SETQ PT2 (CADR LST2))
  (vl-member-if
'(lambda(_LstItem)
   (if  (AND
         (vl-member-if '(lambda(x) (equal (distance X PT2) 0.0 0.1)) _LstItem)
         (NOT(vl-member-if '(lambda(x) (equal (distance X PT1) 0.0 0.1)) _LstItem))
      )
      (PROGN
         (IF (equal (distance (CAR _LstItem) PT2) 0.0 0.1)
            (setq LST1 (CONS (SETQ _LstItem2 _LstItem) LST1));
            (setq LST1 (CONS (SETQ _LstItem2 (reverse _LstItem)) LST1))
         );
         (IF (= I 0)(SETQ _LstItem1 _LstItem))
      )
   )
)
Lst)
  (SETQ I (1+ I))
  );;END WHILE

;;;点表算几次的情况怎么处理？
;|
(SETQ PT1 (CAR _LstItem2) PT2 (CADR _LstItem2))
  (foreach _LstIt1 Lst
(if  (AND
         (vl-member-if '(lambda(x) (equal (distance X PT2) 0.0 0.1)) _LstIt1)
         (NOT(vl-member-if '(lambda(x) (equal (distance X PT1) 0.0 0.1)) _LstIt1))
      )
            (setq LST1 (CONS _LstIt1 LSTX))
)
  )
(IF (> (LENGTH LSTX) 2)
  (SETQ LST (vl-remove _LstItem1 LST))
)
|;
  ;;此处把算过的点表删除;;但是有些点表要算几次怎么办？如何更新LST？
  (SETQ LST (vl-remove _LstItem1 LST))

  (setq leng 0.0)
  (IF (> (LENGTH LST1) 1)
  (PROGN
  (PRINC LST1)
  (foreach point LST1 (setq leng (+ leng (distance (cAr point) (cAdr point)))))
  (princ leng)
  (princ ">>>>")
  (YY_321 LST3 LST)))
)

nzl1116 · 发表于 2013-3-28 21:49:23

(defun FindNextSubList (Pn Lst)
(if Lst
(if (= (car (car Lst)) Pn)
(cons (car Lst) (FindNextSubList (cadr (car Lst)) (cdr Lst)))
(FindNextSubList Pn (cdr Lst))
)
)
)
(defun AddTorNil (NLst MLst)
(if NLst
(if (member (cadr (car NLst)) (mapcar 'car MLst))
(if (member (cadr (car NLst)) (cdr (member (cadr (car NLst)) (mapcar 'car MLst))))
(cons (append (car NLst) '(T)) (AddTorNil (cdr NLst) MLst))
(cons (append (car NLst) '(nil)) (AddTorNil (cdr NLst) MLst))
)
(cons (append (car NLst) '(nil)) (AddTorNil (cdr NLst) MLst))
)
)
)
(defun RemoveIsNilLast (NLst MLst)
(if (and NLst MLst)
(if (not (caddr (car NLst)))
(RemoveIsNilLast (cdr NLst) (vl-remove (list (car (car NLst)) (cadr (car NLst))) MLst))
MLst
)
MLst
)
)
(defun func (Lst0 / Lst1 Lst2 Lst3 Lst4 ReLst)
(setq Lst3 Lst0
Lst2 '((T T T))
ReLst nil
)
(while (member 'T (mapcar 'caddr Lst2))
(setq Lst1 (cons (car Lst3) (FindNextSubList (cadr (car Lst3)) (cdr Lst3)))
Lst4 (cons (car (car Lst1)) (mapcar 'cadr Lst1))
ReLst (cons Lst4 ReLst)
Lst2 (reverse (AddTorNil Lst1 Lst3))
Lst3 (RemoveIsNilLast Lst2 Lst3)
)
)
(reverse ReLst)
)

(defun FindNextSubList (Pn Lst) 
  (if Lst 
    (if (= (car (car Lst)) Pn) 
      (cons (car Lst) (FindNextSubList (cadr (car Lst)) (cdr Lst))) 
      (FindNextSubList Pn (cdr Lst)) 
    ) 
  ) 
) 
(defun AddTorNil (NLst MLst) 
  (if NLst 
    (if (member (cadr (car NLst)) (mapcar 'car MLst)) 
      (if (member (cadr (car NLst)) (cdr (member (cadr (car NLst)) (mapcar 'car MLst)))) 
        (cons (append (car NLst) '(T)) (AddTorNil (cdr NLst) MLst)) 
        (cons (append (car NLst) '(nil)) (AddTorNil (cdr NLst) MLst)) 
      ) 
      (cons (append (car NLst) '(nil)) (AddTorNil (cdr NLst) MLst)) 
    ) 
  ) 
) 
(defun RemoveIsNilLast (NLst MLst) 
  (if (and NLst MLst) 
    (if (not (caddr (car NLst))) 
      (RemoveIsNilLast (cdr NLst) (vl-remove (list (car (car NLst)) (cadr (car NLst))) MLst)) 
      MLst 
    ) 
    MLst 
  ) 
) 
(defun func (Lst0 / Lst1 Lst2 Lst3 Lst4 ReLst) 
  (setq Lst3 Lst0 
        Lst2 '((T T T)) 
        ReLst nil 
        ) 
  (while (member 'T (mapcar 'caddr Lst2)) 
    (setq Lst1  (cons (car Lst3) (FindNextSubList (cadr (car Lst3)) (cdr Lst3))) 
          Lst4  (cons (car (car Lst1)) (mapcar 'cadr Lst1)) 
          ReLst (cons Lst4 ReLst) 
          Lst2  (reverse (AddTorNil Lst1 Lst3)) 
          Lst3  (RemoveIsNilLast Lst2 Lst3) 
    ) 
  ) 
  (reverse ReLst) 
)

也不知道行不行

wowan1314 · 发表于 2013-3-28 23:57:57

nzl1116 发表于 2013-3-28 21:49
也不知道行不行

明天测试下！感谢！！！

nzl1116 · 发表于 2013-3-29 09:44:51

wowan1314 发表于 2013-3-28 23:57
明天测试下！感谢！！！

汗，有一处毛病，把"="改成"equal"就行了

Gu_xl · 发表于 2013-3-29 09:52:21

http://bbs.mjtd.com/forum.php?mo ... id=83780&page=1
7楼代码稍加修改即可满足楼主要求！

Gu_xl · 发表于 2013-3-29 10:26:17

Gu_xl 发表于 2013-3-29 09:52
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=83780&page=1
7楼代码稍加修改即可满足楼主要求！

每次递归结束便是完成一条线路，所有路线搜索完成后，比较一下便知！

nzl1116 · 发表于 2013-3-29 20:04:31

这样应该可以了

(defun FindNextSubList (Pnt sLst / sLst0 sLst1 sLst2 Pmt)
(setq sLst0 sLst
Pmt Pnt
sLst1 nil
)
(while (setq sLst2 (car (vl-member-if '(lambda (x) (member Pmt x)) sLst0)))
(setq sLst0 (vl-remove sLst2 sLst0))
(if (equal (cadr sLst2) Pmt)
(setq sLst2 (reverse sLst2))
)
(setq sLst1 (append sLst1 (list sLst2))
Pmt (cadr sLst2)
)
)
sLst1
)
(defun AddTorNil (NLst MLst / n m RetLst AddLst SecondI Return)
(setq n 0
m (length NLst)
RetLst nil
)
(while (< n m)
(setq AddLst (nth n NLst)
SecondI (cadr AddLst)
Return (cdr (vl-member-if '(lambda (x) (member SecondI x)) MLst))
Return (cdr (vl-member-if '(lambda (x) (member SecondI x)) Return))
Return (vl-member-if '(lambda (x) (member SecondI x)) Return)
)
(if Return
(setq AddLst (append AddLst '(T)))
(setq AddLst (append AddLst '(nil)))
)
(setq RetLst (append RetLst (list AddLst))
n (1+ n)
)
)
RetLst
)
(defun RemoveIsNilLast (NLst MLst)
(if (and NLst MLst)
(if (not (caddr (car NLst)))
(RemoveIsNilLast
(cdr NLst)
(vl-remove (if (member (vl-remove 'nil (car NLst)) MLst)
(vl-remove 'nil (car NLst))
(reverse (vl-remove 'nil (car NLst)))
)
MLst
)
)
MLst
)
MLst
)
)
(defun GetAllPathAtStartPt (Pt aLst / aLst1 aLst2 aLst3 aLst4 ReLst)
(setq aLst3 aLst
aLst2 '((T T T))
ReLst nil
)
(while (member 'T (mapcar 'caddr aLst2))
;;获取一条线路链
(setq aLst1 (FindNextSubList Pt aLst3)
;;将线路链以线的方式转化成以点的方式
aLst4 (cons Pt (mapcar 'cadr aLst1))
;;添加到表中
ReLst (append ReLst (list aLst4))
;;给线路链的各条线添加一个符号，如果此线后面有分支，就添加T，否则添加nil。
aLst2 (reverse (AddTorNil aLst1 aLst3))
;;在主表中移除线路链后面的分支
aLst3 (RemoveIsNilLast aLst2 aLst3)
)
)
ReLst
)
(defun funct (Lst / Lst0 Lst1 n m Pn Lst2 ReVal)
;;第一步，寻找线路链的一个起点
(setq Lst0 (apply 'append Lst)
;;所有端点的表
Lst1 (vl-remove-if
'(lambda (x) (member x (cdr (member x Lst0))))
Lst0
)
n 0
;;最后一个端点不用运算
m (1- (length Lst1))
ReVal nil
)
(while (< n m)
(setq Pn (nth n Lst1)
Lst2 (GetAllPathAtStartPt Pn Lst)
Lst2 (vl-remove-if '(lambda (x) (member (reverse x) ReVal)) Lst2)
ReVal (append ReVal Lst2)
n (1+ n)
)
)
ReVal
)

(defun FindNextSubList (Pnt sLst / sLst0 sLst1 sLst2 Pmt) 
  (setq sLst0 sLst 
        Pmt   Pnt 
        sLst1 nil 
  ) 
  (while (setq sLst2 (car (vl-member-if '(lambda (x) (member Pmt x)) sLst0))) 
    (setq sLst0 (vl-remove sLst2 sLst0)) 
    (if (equal (cadr sLst2) Pmt) 
      (setq sLst2 (reverse sLst2)) 
    ) 
    (setq sLst1 (append sLst1 (list sLst2)) 
          Pmt    (cadr sLst2) 
    ) 
  ) 
  sLst1 
) 
(defun AddTorNil (NLst MLst / n m RetLst AddLst SecondI Return) 
  (setq        n      0 
        m      (length NLst) 
        RetLst nil 
  ) 
  (while (< n m) 
    (setq AddLst  (nth n NLst) 
          SecondI (cadr AddLst) 
          Return  (cdr (vl-member-if '(lambda (x) (member SecondI x)) MLst)) 
          Return  (cdr (vl-member-if '(lambda (x) (member SecondI x)) Return)) 
          Return  (vl-member-if '(lambda (x) (member SecondI x)) Return) 
    ) 
    (if        Return 
      (setq AddLst (append AddLst '(T))) 
      (setq AddLst (append AddLst '(nil))) 
    ) 
    (setq RetLst (append RetLst (list AddLst)) 
          n         (1+ n) 
    ) 
  ) 
  RetLst 
) 
(defun RemoveIsNilLast (NLst MLst) 
  (if (and NLst MLst) 
    (if        (not (caddr (car NLst))) 
      (RemoveIsNilLast 
        (cdr NLst) 
        (vl-remove (if (member (vl-remove 'nil (car NLst)) MLst) 
                     (vl-remove 'nil (car NLst)) 
                     (reverse (vl-remove 'nil (car NLst))) 
                   ) 
                   MLst 
        ) 
      ) 
      MLst 
    ) 
    MLst 
  ) 
) 
(defun GetAllPathAtStartPt (Pt aLst / aLst1 aLst2 aLst3 aLst4 ReLst) 
  (setq aLst3 aLst 
        aLst2 '((T T T)) 
        ReLst nil 
  ) 
  (while (member 'T (mapcar 'caddr aLst2)) 
          ;;获取一条线路链 
    (setq aLst1  (FindNextSubList Pt aLst3) 
          ;;将线路链以线的方式转化成以点的方式 
          aLst4  (cons Pt (mapcar 'cadr aLst1)) 
          ;;添加到表中 
          ReLst        (append ReLst (list aLst4)) 
          ;;给线路链的各条线添加一个符号，如果此线后面有分支，就添加T，否则添加nil。 
          aLst2        (reverse (AddTorNil aLst1 aLst3)) 
          ;;在主表中移除线路链后面的分支 
          aLst3        (RemoveIsNilLast aLst2 aLst3) 
    ) 
  ) 
  ReLst 
) 
(defun funct (Lst / Lst0 Lst1 n m Pn Lst2 ReVal) 
  ;;第一步，寻找线路链的一个起点 
  (setq        Lst0  (apply 'append Lst) 
        ;;所有端点的表 
        Lst1  (vl-remove-if 
                '(lambda (x) (member x (cdr (member x Lst0)))) 
                Lst0 
              ) 
        n     0 
        ;;最后一个端点不用运算 
        m     (1- (length Lst1)) 
        ReVal nil 
  ) 
  (while (< n m) 
    (setq Pn    (nth n Lst1) 
          Lst2  (GetAllPathAtStartPt Pn Lst) 
          Lst2  (vl-remove-if '(lambda (x) (member (reverse x) ReVal)) Lst2) 
          ReVal (append ReVal Lst2) 
          n     (1+ n) 
    ) 
  ) 
  ReVal 
)

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

[讨论] （求助）最长路径怎么求？。

本帖子中包含更多资源

相关帖子

点评

点评

点评

点评

评分

点评

评分

点评

评分

[讨论] （求助） 最长路径怎么求？。

本帖子中包含更多资源

相关帖子

点评

点评

点评

点评

评分

点评

评分

点评

评分

[讨论] （求助）最长路径怎么求？。