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

nzl1116

还是有点问题，不支持环行链

longcashman

直接用天正给排水都解决了

nzl1116

nzl1116 发表于 2013-3-30 11:41
还是有点问题，不支持环行链

还有更简单的方法

wowan1314

nzl1116 发表于 2013-8-1 11:37
还有更简单的方法

请指教，你给的函数我都没看明白呢。 如果可以请给讲解下吧？

nzl1116

wowan1314 发表于 2013-8-1 11:45
请指教，你给的函数我都没看明白呢。 如果可以请给讲解下吧？

2. (defun GetAllPath (SPnt PntLst / PtLst0 PtLst1)
   
3.   (setq PtLst1 (vl-remove-if-not
   
4.    (function (lambda (x) (member SPnt x)))
   
5.    PntLst
   
6.         ) ;_ 所有包含SPnt点的点对表
   
7. PtLst0 (vl-remove SPnt (apply 'append PtLst1)) ;_ 和点SPnt相连的所有点
   
8.   )
   
9.   (cond
   
10.     ((not SPnt) nil)
    
11.     ((not PtLst0) (list (list SPnt)))
    
12.     ;;核心代码，批量递归
    
13.     (T
    
14.      (mapcar
    
15.        (function (lambda (x) (cons SPnt x)))
    
16.        (apply
    
17.   'append
    
18.   (mapcar
    
19.     'GetAllPath
    
20.     PtLst0
    
21.     (mapcar (function (lambda (x) (vl-remove x PntLst))) PtLst1)
    
22.   )
    
23.        )
    
24.      )
    
25.     )
    
26.   )
    
27. )

(defun GetAllPath (SPnt PntLst / PtLst0 PtLst1)<br />   (setq PtLst1 (vl-remove-if-not<br />    (function (lambda (x) (member SPnt x)))<br />    PntLst<br />         ) ;_ 所有包含SPnt点的点对表<br /> PtLst0 (vl-remove SPnt (apply 'append PtLst1)) ;_ 和点SPnt相连的所有点<br />   )<br />   (cond<br />     ((not SPnt) nil)<br />     ((not PtLst0) (list (list SPnt)))<br />     ;;核心代码，批量递归<br />     (T<br />      (mapcar<br />        (function (lambda (x) (cons SPnt x)))<br />        (apply<br />   'append<br />   (mapcar<br />     'GetAllPath<br />     PtLst0<br />     (mapcar (function (lambda (x) (vl-remove x PntLst))) PtLst1)<br />   )<br />        )<br />      )<br />     )<br />   )<br /> )

wowan1314

nzl1116 发表于 2013-8-1 11:49

(setq AA '(((1 1) (2 2)) ((2 2) (3 3)) ((7 7) (3 3)) ((4 4) (3 3))  ((4 4) (5 5))  ((2 2) (100 100)) ) )
(GetAllPath '(1 1)  AA) ==nil

新给的函数算不出？

nzl1116

wowan1314 发表于 2013-8-1 12:15
(setq AA '(((1 1) (2 2)) ((2 2) (3 3)) ((7 7) (3 3)) ((4 4) (3 3))  ((4 4) (5 5))  ((2 2) (100 100 ...

上面已修复，少了一条表达式

nzl1116

nzl1116 发表于 2013-8-1 12:28
上面已修复，少了一条表达式

这叫地毯式搜索，比网上那些找节点的方法要简单许多，思路也清晰多了。搜索指定目录下的所有文件也可以用这种方法。

lijiayin110

路过学习

nzl1116

1. (defun AYL-GetAllPath (SttPnt EndPnt PtsLst / AllPathLst CurPnt CurPathLst TestLst TmpLst DPtLst NxtPnt CurPathLst-s)
   
2.   (setq AllPathLst nil)
   
3.   (setq CurPathLst (List SttPnt))
   
4.   (setq TestLst (list (list SttPnt CurPathLst PtsLst)))
   
5.   (while TestLst
   
6.     (setq TmpLst (car TestLst))
   
7.     (setq TestLst (cdr TestLst))
   
8.     (setq CurPnt (car TmpLst))
   
9.     (setq CurPathLst (cadr TmpLst))
   
10.     (setq PtsLst (caddr TmpLst))
    
11.    
    
12.     (setq TmpLst (vl-remove-if-not (function (lambda (Pts) (member CurPnt Pts))) PtsLst))
    
13.     (while TmpLst
    
14.       (setq DPtLst (car TmpLst))
    
15.       (setq TmpLst (cdr TmpLst))
    
16.       (if (equal (car DPtLst) CurPnt)
    
17.         (setq NxtPnt (cadr DPtLst))
    
18.         (setq NxtPnt (car DPtLst))
    
19.       )
    
20.       (setq CurPathLst-s (cons NxtPnt CurPathLst))
    
21.       (setq TestLst (cons (list NxtPnt CurPathLst-s (vl-remove DPtLst PtsLst)) TestLst))
    
22.       (if (equal NxtPnt EndPnt)
    
23.         (setq AllPathLst (cons (reverse CurPathLst-s) AllPathLst))
    
24.       )
    
25.     )
    
26.   )
    
27.   (princ "\n")
    
28.   (princ (length AllPathLst))
    
29.   (princ "\n")
    
30.   AllPathLst
    
31. )

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