《表排序》重金求助

redcat

【排序规则】
1、比较每个表的第1个元素从小到大排列表alist
2、如果表的第1个元素相等，则以第2个元素从小到大排列表alist
3、如果表的第2个元素相等，则以第3个元素从小到大排列表alist
...
4、以此类推
高山兄的代码错误，先将自己代码放入二楼，期待高手能将我的算法再加改进
示例1:
(sort '((36 90.0 6)
        (3 6)
        (4 5)
        (36 900.00 6)
        (4 5 45)
        (1 4567 900)
        (2 81)
        (2 5 88 1200 900)
        (2 188 7890)
       )
) ;_ 结束sort
((1 4567 900) (2 5 88 1200 900) (2 81) (2 188 7890) (3 6) (4 5) (4 5 45) (36 90.0 6) (36 900.0 6))
示例2:
(sort '(("[" 25 "a")
        ("[" 8)
        ("H" 400 "x" 200 "x" 6 "x" 12)
        ("H" 400 "~" 800 "x" 200 "x" 6 "x" 12)
        ("HW" 350 "x" 350 "x" 10 "x" 19)
        ("H" 80 "x" 20 "x" 6 "x" 8)
        ("L" 50 "x" 4)
        ("L" 100 "x" 10)
        ("~" 8)
        ("H" 400 "x" 200 "x" 6 "x" 8)
        (2 "[" 8)
        ("H" 500 "x" 240 "x" 8 "x" 12)
        ("H" 700 "x" 240 "x" 8 "x" 12)
       )
) ;_ 结束sort
(("H" 80 "x" 20 "x" 6 "x" 8)
  ("H" 400 "x" 200 "x" 6 "x" 8)
  ("H" 400 "x" 200 "x" 6 "x" 12)
  ("H" 400 "~" 800 "x" 200 "x" 6 "x" 12)
  ("H" 500 "x" 240 "x" 8 "x" 12)
  ("H" 700 "x" 240 "x" 8 "x" 12)
  ("HW" 350 "x" 350 "x" 10 "x" 19)
  ("L" 50 "x" 4)
  ("L" 100 "x" 10)
  ("[" 8)
  ("[" 25 "a")
  ("~" 8)
  (2 "[" 8)
)

redcat

保留区
【排序规则】
1、比较每个表的第1个元素从小到大排列表alist
2、如果表的第1个元素相等，则以第2个元素从小到大排列表alist
3、如果表的第2个元素相等，则以第3个元素从小到大排列表alist
...
4、以此类推

chlh_jd

2. (defun foo (l)
   
3.   (vl-sort
   
4.     l
   
5.     (function
   
6.       (lambda (e1 e2 / is no a b)
   
7.         (while
   
8.           (and (setq a (car e1)) (setq b (car e2)) (not is) (not no))
   
9.            (if (/= (type a) (type b))
   
10.              (if (= (type a) 'STR)
    
11.                (setq is t)
    
12.                (setq no t)
    
13.              )
    
14.              (if (< (car e1) (car e2))
    
15.                (setq is t)
    
16.                (if (> (car e1) (car e2))
    
17.                  (setq no T)
    
18.                )
    
19.              )
    
20.            )
    
21.            (setq e1 (cdr e1)
    
22.                  e2 (cdr e2)
    
23.            )
    
24.         )
    
25.         (if is
    
26.           (not no)
    
27.           (if no
    
28.             nil
    
29.             e2
    
30.           )
    
31.         )
    
32.       )
    
33.     )
    
34.   )
    
35. )

(defun foo (l)<br />   (vl-sort<br />     l<br />     (function<br />       (lambda (e1 e2 / is no a b)<br />         (while<br />           (and (setq a (car e1)) (setq b (car e2)) (not is) (not no))<br />            (if (/= (type a) (type b))<br />              (if (= (type a) 'STR)<br />                (setq is t)<br />                (setq no t)<br />              )<br />              (if (< (car e1) (car e2))<br />                (setq is t)<br />                (if (> (car e1) (car e2))<br />                  (setq no T)<br />                )<br />              )<br />            )<br />            (setq e1 (cdr e1)<br />                  e2 (cdr e2)<br />            )<br />         )<br />         (if is<br />           (not no)<br />           (if no<br />             nil<br />             e2<br />           )<br />         )<br />       )<br />     )<br />   )<br /> )

chlh_jd

这种简单问题，用到挑战赛......
估计没有高手感兴趣，如果楼主是要求助，建议您直接说明

redcat

chlh_jd 发表于 2012-8-7 20:29
这种简单问题，用到挑战赛......
估计没有高手感兴趣，如果楼主是要求助，建议您直接说明

程序有bug
(foo '((1 90.0 6)
        (1 88 900)
        (1 5)
        (1 900.00 6)
        (1 5 45)(1 6 8)
        (1 4567 900)(1 6)
        (1 81)(1 6 55)
        (1 5 88 )(1 120 90)
        (1 188 7890)
       )
)
((1 90.0 6) (1 5) (1 5 88) (1 6) (1 6 55) (1 81) (1 88 900) (1 900.0 6) (1 5 45) (1 6 8) (1 120 90) (1 188 7890) (1 4567 900))
_$


我的计算结果
(sort '((1 90.0 6)
        (1 88 900)
        (1 5)
        (1 900.00 6)
        (1 5 45)(1 6 8)
        (1 4567 900)(1 6)
        (1 81)(1 6 55)
        (1 5 88 )(1 120 90)
        (1 188 7890)
       )
)
((1 5) (1 5 45) (1 5 88) (1 6) (1 6 8) (1 6 55) (1 81) (1 88 900) (1 90.0 6) (1 120 90) (1 188 7890) (1 900.0 6) (1 4567 900))
_$

chlh_jd

2. 
   
3. ;;修正了实数类型和整数类型归为不同类debug
   
4. (defun foo (l) ;_by GSLS(SS) 2012-8-10
   
5. (vl-sort  l (function  (lambda (e1 e2 / is no a b)
   
6.    (while  (and (setq a (car e1)) (setq b (car e2)) (not is) (not no))
   
7.      (cond ((and (= (type a) 'STR) (/= (type b) 'STR)) (setq is t))
   
8.               ((and (/= (type a) 'STR) (= (type b) 'STR)) (setq no t))
   
9.               ((and (= (type a) 'LIST) (/= (type b) 'LIST))(setq no t))
   
10.               ((and (/= (type a) 'LIST) (= (type b) 'LIST)) (setq is t))
    
11.               ((if (< (car e1) (car e2)) (setq is t)
    
12.                    (if (> (car e1) (car e2)) (setq no T)))))     
    
13.       (setq e1 (cdr e1)  e2 (cdr e2)))
    
14.     (if is  (not no) (if no  nil   e2 ))))))
    

<br /> ;;修正了实数类型和整数类型归为不同类debug<br /> (defun foo (l) ;_by GSLS(SS) 2012-8-10 <br /> (vl-sort  l (function  (lambda (e1 e2 / is no a b)<br />    (while  (and (setq a (car e1)) (setq b (car e2)) (not is) (not no))<br />      (cond ((and (= (type a) 'STR) (/= (type b) 'STR)) (setq is t))<br />               ((and (/= (type a) 'STR) (= (type b) 'STR)) (setq no t))<br />               ((and (= (type a) 'LIST) (/= (type b) 'LIST))(setq no t))<br />               ((and (/= (type a) 'LIST) (= (type b) 'LIST)) (setq is t))<br />               ((if (< (car e1) (car e2)) (setq is t)<br />                    (if (> (car e1) (car e2)) (setq no T)))))     <br />       (setq e1 (cdr e1)  e2 (cdr e2)))<br />     (if is  (not no) (if no  nil   e2 ))))))<br />

chlh_jd

这里增加了2个判断，一个是表和非表，如果对比项为表和原子，假定规则为原子小于表；
其实还可以加个递归函数，如果子项都是表，对比进行到底！

aroom

直接用 TeaScript 的内建函数：

caoyin

;;未考虑数字和字符串比较，关键在于排序的规则是如果定的，可以通过自定义<函数实现。。。
(defun sort (LST / REC)
(defun REC (A B);;递归
  (cond ((equal (car A) (car B) 1E-4)
         (REC (cdr A) (cdr B))
        )
        (T (< (car A) (car B)))
  )
)
(vl-sort LST '(lambda (P1 P2)(REC P1 P2)))
)

lohas1118

高手，学习了