(问题解决,谢谢各位大师的帮助!)

q3_2006

wowan1314 发表于 2014-5-20 20:50
看了下发现我的也错了！

跟大家结果一样。

下线了...看来只能后面二次处理下....总之不能出现排序什么的...
(defun tx (l / a b i j)
  (setq i  -1)
  (while (setq a (nth (setq i (1+ i)) l))
    (setq j i)
    (while (setq b (nth (setq j (1+ j)) l))
      (cond
       ((equal (cadr (last a)) (car (car a))) (setq l (subst (append a b) a (vl-remove b l))))
       ((equal (car (car a)) (cadr (last b))) (setq l (subst (append b a) b (vl-remove a l))))
       )
    )
  )l
)

就是觉得这样太啰嗦呀....真是麻烦大家了....不好意思....{:soso_e110:}

q3_2006

zxq0220 发表于 2014-5-20 20:44

不能出现排序的....{:soso_e127:}

wowan1314

应该差不多

2. (defun c:t123 ( / t1 t2 l1 l3 l2 l4)
   
3.     (defun t1 (lst / a b l1 l2 )
   
4.         (setq a (car lst) b (car a) lst (vl-remove a lst))
   
5.         (while
   
6.             (setq l1 (vl-member-if '(lambda(x)(= b (cadr x))) lst))
   
7.             (setq a (car l1) b (car a) lst (vl-remove a lst) l2 (cons a l2))
   
8.         )
   
9.         (setq l3 lst)
   
10.         l2
    
11.     )
    
12.     (defun t2 (lst / a b l1 l2 )
    
13.         (setq a (car lst) b (cadr a) lst (vl-remove a lst) l2 (cons a l2))
    
14.         (while
    
15.             (setq l1 (vl-member-if '(lambda(x)(= b (car x))) lst))
    
16.             (setq a (car l1) b (cadr a) lst (vl-remove a lst) l2 (cons a l2))
    
17.         )
    
18.         (setq l3 lst)
    
19.         (reverse l2)
    
20.     )
    
21.     (setq lst '((6 7)(4 "A")(8 "B")(1 2)(3 4)(6 5)(2 3)("A" 9)("B" 10)(7 8)) L3 T)
    
22.     (while l3
    
23.         (if (setq l1 (t1 lst))(setq l2 (append l1 (t2 lst)))(setq l2 (t2 lst)))
    
24.         (setq  LST L3 l4 (cons l2 l4))
    
25.     )
    
26.     (reverse L4)
    
27. )

(defun c:t123 ( / t1 t2 l1 l3 l2 l4) <br />     (defun t1 (lst / a b l1 l2 )<br />         (setq a (car lst) b (car a) lst (vl-remove a lst))<br />         (while<br />             (setq l1 (vl-member-if '(lambda(x)(= b (cadr x))) lst))<br />             (setq a (car l1) b (car a) lst (vl-remove a lst) l2 (cons a l2))<br />         )<br />         (setq l3 lst)<br />         l2<br />     )<br />     (defun t2 (lst / a b l1 l2 )<br />         (setq a (car lst) b (cadr a) lst (vl-remove a lst) l2 (cons a l2))<br />         (while<br />             (setq l1 (vl-member-if '(lambda(x)(= b (car x))) lst))<br />             (setq a (car l1) b (cadr a) lst (vl-remove a lst) l2 (cons a l2))<br />         )<br />         (setq l3 lst)<br />         (reverse l2)<br />     )<br />     (setq lst '((6 7)(4 "A")(8 "B")(1 2)(3 4)(6 5)(2 3)("A" 9)("B" 10)(7 8)) L3 T)<br />     (while l3<br />         (if (setq l1 (t1 lst))(setq l2 (append l1 (t2 lst)))(setq l2 (t2 lst)))<br />         (setq  LST L3 l4 (cons l2 l4))<br />     )<br />     (reverse L4)<br /> )

lijiao

(setq lst '((6 7)(4 "A")(8 "B")(1 2)(3 4)(6 5)(2 3)("A" 9)("B" 10)(7 8)))
(defun tt (lst / BIAOJI LST1 LST2 OUT OUT1 OUT2)
  (setq out '())
  (setq out1 (cons (setq out2 (car lst)) nil)
        lst (cdr lst)
        )
  (setq lst1 '() lst2 '())
  (foreach item lst
    (if (= (type (car item)) 'INT)
      (setq lst1 (cons item lst1))
      (setq lst2 (cons item lst2))
      )
    )
  (setq lst1 (vl-sort lst1 (function (lambda(x y) (< (car x) (car y))))))
  (setq lst2 (vl-sort lst2 (function (lambda(x y) (< (car x) (car y))))))
  (setq lst (append out1 lst1 lst2))
  (while lst
    (setq out1 (cons (setq out2 (car lst)) nil)
        lst (cdr lst)
        )
    (setq biaoji t)
    (while (and lst biaoji)
      (if (setq out2 (assoc (cadr out2) lst))
        (setq out1 (cons out2 out1)
              lst (vl-remove out2 lst))
        (setq biaoji nil)
        )
        )
    (setq out (cons (reverse out1) out))
    )
  (reverse out)
  )

ll_j

q3_2006 发表于 2014-5-20 18:09
长老...也不对哟...没这么简单...

题目本身是有点费解，联系你前面的直线首尾相连的帖子才理解。
实际上题目本身的点是无序的，所以不需要排序，和直线的情况一样，只要首尾相连，可以是朝后连，也可以朝前连，因此需要一个双向判别。
有几种思路：
1.先判断哪一个是起始点，再向后连。
2.先向后连，再对连接后的表判断，如果前面的头接后面的尾则合并。
3.先向后连，把连接后的表前后颠倒合并，再重新连接。
下面的代码是第三种方法（这种方法在简单情况下是正确的，如果分叉多，不知情况怎样，今天有点头昏，就不多想了）：

1. 
   
2. (setq lst '((6 7) (4 "A") (8 "B") (1 2) (3 4) (6 5) (2 3) ("A" 9) ("B" 10) (7 8)))
   
3. (defun tt1(lst)
   
4.   (setq b (car lst)
   
5.         a (list b)
   
6.         d nil
   
7.         lst(cdr lst)
   
8.   )
   
9.   (while lst
   
10.     (if (setq c (assoc (cadr b) lst))
    
11.       (setq a (cons c a)
    
12.             lst (vl-remove c lst)
    
13.             b c
    
14.         )
    
15.       (setq d (cons (reverse a) d)
    
16.             b (car lst)
    
17.             a (list b)
    
18.             lst (cdr lst)
    
19.       )
    
20.     )
    
21.   )
    
22.   (cons (reverse a) d)
    
23. )
    
24. (defun tt(lst)
    
25.   (tt1  (apply 'append (tt1 lst)))
    
26. )
    

<br /> (setq lst '((6 7) (4 "A") (8 "B") (1 2) (3 4) (6 5) (2 3) ("A" 9) ("B" 10) (7 8)))<br /> (defun tt1(lst)<br />   (setq b (car lst)<br />         a (list b)<br />         d nil<br />         lst(cdr lst)<br />   )<br />   (while lst<br />     (if (setq c (assoc (cadr b) lst))<br />       (setq a (cons c a)<br />             lst (vl-remove c lst)<br />             b c<br />         )<br />       (setq d (cons (reverse a) d)<br />             b (car lst)<br />             a (list b)<br />             lst (cdr lst)<br />       )<br />     )<br />   )<br />   (cons (reverse a) d)<br /> )<br /> (defun tt(lst)<br />   (tt1  (apply 'append (tt1 lst)))<br /> )<br />

_$ (tt lst)
(((6 7) (7 8) (8 "B") ("B" 10)) ((1 2) (2 3) (3 4) (4 "A") ("A" 9)) ((6 5)))

q3_2006

ll_j 发表于 2014-5-21 10:00
题目本身是有点费解，联系你前面的直线首尾相连的帖子才理解。
实际上题目本身的点是无序的，所以不需要 ...

没说清楚...不好意思....但长老....{:soso_e110:}...还是不对....其实想知道两段代码完成的事...能不能合并成一次完成....

(defun tt (lst / p1 p2 tmp1 tmp2)
(setq tmp2 (list))
(while lst
(setq p1 (car lst) tmp1 (list p1) lst (cdr lst))
(while (setq p2 (assoc (cadr p1) lst))
(setq tmp1 (cons p2 tmp1) p1 p2)
(setq lst (vl-remove p2 lst))
)
(setq tmp2 (cons (reverse tmp1) tmp2))
)
(reverse tmp2)
)

(defun tx (l / a b i j)
  (setq i  -1)
  (while (setq a (nth (setq i (1+ i)) l))
    (setq j i)
    (while (setq b (nth (setq j (1+ j)) l))
      (cond
              ((equal (cadr (last a)) (car (car b))) (setq l (subst (append a b) a (vl-remove b l))))
              ((equal (car (car a)) (cadr (last b))) (setq l (subst (append b a) b (vl-remove a l))))
              )
    )
  )l
)


(tx (tt '((6 7)(4 "A")(8 "B")(1 2)(3 4)(6 5)(2 3)("A" 9)("B" 10)(7 8))))
->(((6 7) (7 8) (8 "B") ("B" 10)) ((1 2) (2 3) (3 4) (4 "A") ("A" 9)) ((6 5)))
这样是对的......

q3_2006

wowan1314 发表于 2014-5-20 22:06
应该差不多

.....没有对哟...大师....{:soso_e110:}

csharp

实质找出所有路径, 这有个 C++ 程序

http://www.cnblogs.com/qi09/archive/2011/05/24/2055643.html

q3_2006

c++不懂.....找出所有路径...LISP基本也搞定了.....谢谢!

q3_2006

csharp 发表于 2014-5-21 11:38
实质找出所有路径, 这有个 C++ 程序

http://www.cnblogs.com/qi09/archive/2011/05/24/2055643.html

不懂..{:soso_e110:}

csharp

q3_2006 发表于 2014-5-21 12:20
不懂..

1. (defun ff (lst / ret n tmp)
   
2.   (setq        ret (list (list (car lst)))
   
3.         lst (cdr lst)
   
4.   )
   
5.   (while lst
   
6.     (while (setq n (assoc (cadr (last (car ret))) lst));_往后找
   
7.       (setq ret        (cons (append  (car ret) (list n)) (cdr ret))
   
8.             lst        (vl-remove n lst)
   
9.       )
   
10.     )
    
11.     (if        lst
    
12.       (progn
    
13.         (setq tmp (mapcar 'reverse lst))
    
14.         (while (setq n (assoc (caaar ret) tmp)) ;_往前找
    
15.           (setq        ret (cons (cons (reverse n) (car ret)) (cdr ret))
    
16.                 tmp (vl-remove n tmp)
    
17.           )
    
18.         )
    
19.         (setq lst (mapcar 'reverse tmp))
    
20.       )
    
21.     )
    
22.     (if        lst
    
23.       (setq ret        (cons (list (car lst)) ret)
    
24.             lst        (cdr lst)
    
25.       )
    
26.     )
    
27.   )
    
28.   ret
    
29. )

(defun ff (lst / ret n tmp)<br />   (setq        ret (list (list (car lst)))<br />         lst (cdr lst)<br />   )<br />   (while lst<br />     (while (setq n (assoc (cadr (last (car ret))) lst));_往后找<br />       (setq ret        (cons (append  (car ret) (list n)) (cdr ret))<br />             lst        (vl-remove n lst)<br />       )<br />     )<br />     (if        lst<br />       (progn<br />         (setq tmp (mapcar 'reverse lst))<br />         (while (setq n (assoc (caaar ret) tmp)) ;_往前找<br />           (setq        ret (cons (cons (reverse n) (car ret)) (cdr ret))<br />                 tmp (vl-remove n tmp)<br />           )<br />         )<br />         (setq lst (mapcar 'reverse tmp))<br />       )<br />     )<br />     (if        lst<br />       (setq ret        (cons (list (car lst)) ret)<br />             lst        (cdr lst)<br />       )<br />     )<br />   )<br />   ret<br /> )

q3_2006

csharp 发表于 2014-5-21 14:53

就是这样....学习了...{:soso_e152:}

wowan1314

q3_2006 发表于 2014-5-21 10:31
.....没有对哟...大师....

漏了一句！
这下应该对了！

2. ;尝试后续处理
   
3. (car
   
4.     (vl-sort
   
5.         (mapcar
   
6.             '(lambda(l1)
   
7.                 (mapcar '(lambda(x)(apply '+ x))
   
8.                     (mapcar '(lambda(x)(apply 'distance x))
   
9.                         (mapcar 'list
   
10.                             l1 (cdr l1)
    
11.                         )
    
12.                     )
    
13.                 )
    
14.             )
    
15.             l
    
16.         )
    
17.         '<
    
18.     )
    
19. )

;尝试后续处理<br /> (car <br />     (vl-sort<br />         (mapcar<br />             '(lambda(l1)<br />                 (mapcar '(lambda(x)(apply '+ x))<br />                     (mapcar '(lambda(x)(apply 'distance x))<br />                         (mapcar 'list<br />                             l1 (cdr l1)<br />                         )<br />                     )<br />                 )<br />             )<br />             l<br />         )<br />         '<<br />     )<br /> )

2. (defun t123 (lst / t1 t2 l1 l3 l2 l4)
   
3.     ;向前
   
4.     (defun t1 (lst / a b l1 l2 )
   
5.         (setq a (car lst) b (car a) lst (vl-remove a lst))
   
6.         (while
   
7.             (setq l1 (vl-member-if '(lambda(x)(= b (cadr x))) lst))
   
8.             (setq a (car l1) b (car a) lst (vl-remove a lst) l2 (cons a l2))
   
9.         )
   
10.         (setq l3 lst)
    
11.         l2
    
12.     )
    
13.     ;向后
    
14.     (defun t2 (lst / a b l1 l2 )
    
15.         (setq a (car lst) b (cadr a) lst (vl-remove a lst) l2 (cons a l2))
    
16.         (while
    
17.             (setq l1 (vl-member-if '(lambda(x)(= b (car x))) lst))
    
18.             (setq a (car l1) b (cadr a) lst (vl-remove a lst) l2 (cons a l2))
    
19.         )
    
20.         (setq l3 lst)
    
21.         (reverse l2)
    
22.     )
    
23.     (setq l3 1)
    
24.     (while l3
    
25.         (if (setq l1 (t1 lst))
    
26.             (progn
    
27.                 (setq l2 (append l1 (t2 lst)))
    
28.                 (mapcar '(lambda(x)(setq l3 (vl-remove x l3))) l1)
    
29.             )
    
30.             (setq l2 (t2 lst))
    
31.         )
    
32.         (setq lst l3 l4 (cons l2 l4))
    
33.     )
    
34.     (reverse l4)
    
35. )

(defun t123 (lst / t1 t2 l1 l3 l2 l4) <br />     ;向前<br />     (defun t1 (lst / a b l1 l2 )<br />         (setq a (car lst) b (car a) lst (vl-remove a lst))<br />         (while<br />             (setq l1 (vl-member-if '(lambda(x)(= b (cadr x))) lst))<br />             (setq a (car l1) b (car a) lst (vl-remove a lst) l2 (cons a l2))<br />         )<br />         (setq l3 lst)<br />         l2<br />     )<br />     ;向后<br />     (defun t2 (lst / a b l1 l2 )<br />         (setq a (car lst) b (cadr a) lst (vl-remove a lst) l2 (cons a l2))<br />         (while<br />             (setq l1 (vl-member-if '(lambda(x)(= b (car x))) lst))<br />             (setq a (car l1) b (cadr a) lst (vl-remove a lst) l2 (cons a l2))<br />         )<br />         (setq l3 lst)<br />         (reverse l2)<br />     )<br />     (setq l3 1)<br />     (while l3<br />         (if (setq l1 (t1 lst))<br />             (progn<br />                 (setq l2 (append l1 (t2 lst)))<br />                 (mapcar '(lambda(x)(setq l3 (vl-remove x l3))) l1)<br />             )<br />             (setq l2 (t2 lst))<br />         )<br />         (setq lst l3 l4 (cons l2 l4))<br />     )<br />     (reverse l4)<br /> )

q3_2006

wowan1314 发表于 2014-5-21 15:04
漏了一句！
这下应该对了！

对了....谢谢大家....辛苦了...{:soso_e121:}

csharp

q3_2006 发表于 2014-5-21 15:03
就是这样....学习了...

对返回值再处理就可以在树形结构中找出所有两点间的最短路径了