N维表排序及自定义顺序

llsheng_73

对一维表排序简单，(vl-sort l '<)

对二维表复杂点，通常写法(vl-sort l'(lambda(x y)(if(=(car x)(car y))(<(cadr x)(cadr y)(<(car x)(car y)))
那么对于三维甚至多维呢？难道象二维表那样一直套下去？
当然不是不行，但存在的问题很明显，一是不能通用，二是代码很长，多维应该能把自己先搞晕。
如果反过来，对排序参数x,y先去除相同的，再对它们进行排序是不是就可以通用了呢？
有想法就上码，经测试想法是正确的

1. (defun sortn(l fun)
   
2. (vl-sort l'(lambda(x y)(while(and(=(car x)(car y))(cdr x)(cdr y))(setq x(cdr x)y(cdr y)))(fun(car x)(car y)))))

(defun sortn(l fun)<br /> (vl-sort l'(lambda(x y)(while(and(=(car x)(car y))(cdr x)(cdr y))(setq x(cdr x)y(cdr y)))(fun(car x)(car y)))))

这样虽然解决了二维到多维的问题，但明显不支持一维表排序了

1. (defun sortn(l fun)
   
2. (or(listp(car l))(setq l(mapcar'list l)))
   
3. (vl-sort l'(lambda(x y)(while(and(=(car x)(car y))(cdr x)(cdr y))(setq x(cdr x)y(cdr y)))(fun(car x)(car y)))))

(defun sortn(l fun)<br /> (or(listp(car l))(setq l(mapcar'list l)))<br /> (vl-sort l'(lambda(x y)(while(and(=(car x)(car y))(cdr x)(cdr y))(setq x(cdr x)y(cdr y)))(fun(car x)(car y)))))

但缺点同样明显，所有维数的排序依据都是相同的，如果要按指定维数指定依据的话，首先应该按维数给定排序依据，即 fun应该为funs

1. (defun sortn(l funs)
   
2.   (or(listp(car l))(setq l(mapcar'list l)))
   
3.   (or(listp funs)(setq funs(list funs)))
   
4.   (while(<(length funs)(length(car l)))
   
5.     (setq funs(cons(car funs)funs)))
   
6.   (vl-sort l'(lambda(x y / n)(setq n 0)
   
7.        (while(and(=(car x)(car y))(cdr x)(cdr y))(setq x(cdr x)y(cdr y)n(1+ n)))((nth n funs)(car x)(car y)))))

(defun sortn(l funs)<br />   (or(listp(car l))(setq l(mapcar'list l)))<br />   (or(listp funs)(setq funs(list funs)))<br />   (while(<(length funs)(length(car l)))<br />     (setq funs(cons(car funs)funs)))<br />   (vl-sort l'(lambda(x y / n)(setq n 0)<br />        (while(and(=(car x)(car y))(cdr x)(cdr y))(setq x(cdr x)y(cdr y)n(1+ n)))((nth n funs)(car x)(car y)))))

对于菜卷鱼提出的很关键的一个问题，先排序第几维,另外根据masterlong的思路，增加容差，并修改为只排序指定维数
再增加一个自定义序列支持，让就它彻底成为EXCEL的排序吧，感觉白折腾了

1. (defun sortn(l keys funs fuzz / n mposition);;;keys关键字列号要么为nil要么为表，funs各个关键字的排序方式,通常为<或>,也可以为自定义序列,比如'("张三""李四")
   
2.   (defun mposition(e l / i)(if(setq i(vl-position e l))i(length l)))
   
3.   (or(listp(car l))(setq l(mapcar'list l)))
   
4.   (or(listp funs)(setq funs(list funs)))
   
5.   (if(zerop(setq n(length keys)))(setq n(length(car l))))
   
6.   (while(<(length funs)n)(setq funs(cons(car funs)funs)))
   
7.   (mapcar(function(lambda(x)(nth x l)))
   
8.          (vl-sort-i(if keys(mapcar(function(lambda(x)(mapcar'(lambda(y)(nth y x))keys)))l)l)
   
9.                    (function(lambda(x y / n )(setq n 0)
   
10.                       (while(and(equal(car x)(car y)fuzz)(cdr x)(cdr y))(setq x(cdr x)y(cdr y)n(1+ n)))
    
11.                               (if(listp(setq n(nth n funs)))
    
12.                                 (<(mposition(car x)n)(mposition(car y)n))
    
13.                                 (n(car x)(car y))))))))

(defun sortn(l keys funs fuzz / n mposition);;;keys关键字列号要么为nil要么为表，funs各个关键字的排序方式,通常为<或>,也可以为自定义序列,比如'("张三""李四")<br />   (defun mposition(e l / i)(if(setq i(vl-position e l))i(length l)))<br />   (or(listp(car l))(setq l(mapcar'list l)))<br />   (or(listp funs)(setq funs(list funs)))<br />   (if(zerop(setq n(length keys)))(setq n(length(car l))))<br />   (while(<(length funs)n)(setq funs(cons(car funs)funs)))<br />   (mapcar(function(lambda(x)(nth x l)))<br />          (vl-sort-i(if keys(mapcar(function(lambda(x)(mapcar'(lambda(y)(nth y x))keys)))l)l)<br />                    (function(lambda(x y / n )(setq n 0)<br />                       (while(and(equal(car x)(car y)fuzz)(cdr x)(cdr y))(setq x(cdr x)y(cdr y)n(1+ n)))<br />                               (if(listp(setq n(nth n funs)))<br />                                 (<(mposition(car x)n)(mposition(car y)n))<br />                                 (n(car x)(car y))))))))

对于需要排序的表比较大的情况，是否可以考虑直接调用EXCEL来排序？

(SORTN '((2 2 3 4)(1 1 1 7)(2 2 1 5)(1 1 0 4))'(1 3)(list > <)0)
((2 2 3 4) (2 2 1 5) (1 1 0 4) (1 1 1 7))


(SORTN'(("上海""崇明区")("北京""朝阳区")("上海""静安区")("北京""房山区")("重庆""酉阳")("四川""成都"))nil'(("北京""上海")("静安区""朝阳区""房山区""崇明区""成都""酉阳"))0)
(("北京" "朝阳区") ("北京" "房山区") ("上海" "静安区") ("上海" "崇明区") ("四川" "成都") ("重庆" "酉阳"))

masterlong

1. ;999公共函数
   
2. ;|
   
3. my_px   给定排序优先级和排序方式，对多维坐标表进行排序  
   
4. (my_px pobiao biao1 biao2 fuzz)
   
5. 
   
6. pobiao----点坐标集合，每一个元素均为n维坐标点
   
7. biao1-----每一维的排序优先级，是一个0~n-1的整数表，数字越小级别越高。如'(1 2 0) 表示Z优先级最高，X其次，Y最低
   
8. biao2-----各维的排序关系，元素个数n-1，元素为“>”或“<”。如'(> > <) 表示X按大小排序，Y按大小排序，Z按小大排序
   
9. fuzz------容差值。
   
10. 
    
11. 实例：
    
12. 二维坐标从上到下从左到右，容差为0【这是人阅读的习惯模式】
    
13. (my_px '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) '(1 0) '(< >) 0)
    
14. 返回：((7 9) (1 6) (6 4) (7 3) (2 2) (6 2))
    
15. 
    
16. 实例：
    
17. 二维坐标从上到下从左到右，容差为1
    
18. (my_px '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) '(1 0) '(< >) 1)
    
19. 返回：((7 9) (1 6) (6 4) (2 2) (6 2) (7 3))
    
20. 
    
21. 实例：
    
22. 四维坐标指定方式排序
    
23. (my_px '((2 2 3 4)(1 1 1 7)(2 2 1 5)(1 1 0 4)) '(2 1 0 3) '(< > > <) 0)
    
24. 返回：((2 2 3 4) (2 2 1 5) (1 1 1 7) (1 1 0 4))
    
25. |;
    
26. ;;
    
27. (defun my_px( pobiao biao1 biao2 fuzz )
    
28.   (vl-sort pobiao
    
29.      ''((a b)
    
30.           (setq n (length biao1))
    
31.           (setq i 0)
    
32.           (while (< i n)
    
33.             (setq id (vl-position i biao1))    ;;比较维度
    
34.             (setq bj (nth id biao2))           ;;比较符号
    
35.             
    
36.             ;;ab比较
    
37.             (setq aa (nth id a))
    
38.             (setq bb (nth id b))
    
39.             (if (> (abs (- aa bb)) fuzz)
    
40.               (progn
    
41.                 (setq i n)
    
42.                 ((eval bj) aa bb)
    
43.               )
    
44.               (setq i (1+ i))
    
45.             )
    
46.           )
    
47.      )
    
48.   )
    
49. )

;999公共函数<br /> ;|<br /> my_px   给定排序优先级和排序方式，对多维坐标表进行排序  <br /> (my_px pobiao biao1 biao2 fuzz)<br /> <br /> pobiao----点坐标集合，每一个元素均为n维坐标点<br /> biao1-----每一维的排序优先级，是一个0~n-1的整数表，数字越小级别越高。如'(1 2 0) 表示Z优先级最高，X其次，Y最低<br /> biao2-----各维的排序关系，元素个数n-1，元素为“>”或“<”。如'(> > <) 表示X按大小排序，Y按大小排序，Z按小大排序<br /> fuzz------容差值。<br /> <br /> 实例：<br /> 二维坐标从上到下从左到右，容差为0【这是人阅读的习惯模式】<br /> (my_px '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) '(1 0) '(< >) 0)<br /> 返回：((7 9) (1 6) (6 4) (7 3) (2 2) (6 2))<br /> <br /> 实例：<br /> 二维坐标从上到下从左到右，容差为1<br /> (my_px '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) '(1 0) '(< >) 1)<br /> 返回：((7 9) (1 6) (6 4) (2 2) (6 2) (7 3))<br /> <br /> 实例：<br /> 四维坐标指定方式排序<br /> (my_px '((2 2 3 4)(1 1 1 7)(2 2 1 5)(1 1 0 4)) '(2 1 0 3) '(< > > <) 0)<br /> 返回：((2 2 3 4) (2 2 1 5) (1 1 1 7) (1 1 0 4))<br /> |;<br /> ;;<br /> (defun my_px( pobiao biao1 biao2 fuzz )<br />   (vl-sort pobiao<br />      ''((a b)<br />           (setq n (length biao1))<br />           (setq i 0)<br />           (while (< i n)<br />             (setq id (vl-position i biao1))    ;;比较维度<br />             (setq bj (nth id biao2))           ;;比较符号<br />             <br />             ;;ab比较<br />             (setq aa (nth id a))<br />             (setq bb (nth id b))<br />             (if (> (abs (- aa bb)) fuzz)<br />               (progn<br />                 (setq i n)<br />                 ((eval bj) aa bb)<br />               )<br />               (setq i (1+ i))<br />             )<br />           )<br />      )<br />   )<br /> )

masterlong

2. ;999公共函数
   
3. ;|
   
4. my_px_v2   给定排序优先级和排序方式，对多维坐标表进行排序   （允许对某个维度忽略排序）
   
5. (my_px_v2 pobiao biao1 biao2 fuzz)
   
6. 
   
7. pobiao----点坐标集合，每一个元素均为n维坐标点
   
8. biao1-----每一维的排序优先级，是一个0~n-1的整数表，数字越小级别越高。如'(1 2 0) 表示Z优先级最高，X其次，Y最低
   
9. biao2-----各维的排序关系，元素个数n-1，元素为“>”或“<”或nil，nil表示对应维度不排序。如'(> > nil) 表示X按大小排序，Y按大小排序，Z不进行排序
   
10. fuzz------容差值。
    
11. 
    
12. 实例：
    
13. 二维坐标从上到下从左到右，容差为0【这是人阅读的习惯模式】
    
14. (my_px_v2 '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) '(1 0) '(< >) 0)
    
15. 返回：((7 9) (1 6) (6 4) (7 3) (2 2) (6 2))
    
16. 
    
17. 实例：
    
18. 二维坐标从上到下从左到右，容差为1
    
19. (my_px_v2 '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) '(1 0) '(< >) 1)
    
20. 返回：((7 9) (1 6) (6 4) (2 2) (6 2) (7 3))
    
21. 
    
22. 实例：
    
23. 四维坐标指定方式排序1
    
24. (my_px_v2 '((2 2 3 4)(1 1 1 7)(2 2 1 5)(1 1 0 4)) '(2 1 0 3) '(< > > <) 0)
    
25. 返回：((2 2 3 4) (2 2 1 5) (1 1 1 7) (1 1 0 4))
    
26. 
    
27. 实例：
    
28. 四维坐标指定方式排序2
    
29. (my_px_v2 '((2 2 3 4)(1 1 1 7)(2 2 1 5)(1 1 0 4)) '(2 1 0 3) '(< > < <) 0)
    
30. 返回：((1 1 0 4) (2 2 1 5) (1 1 1 7) (2 2 3 4))
    
31. 
    
32. 实例：
    
33. 四维坐标指定方式排序3
    
34. (my_px_v2 '((2 2 3 4)(1 1 1 7)(2 2 1 5)(1 1 0 4)) '(2 1 0 3) '(< > nil <) 0)
    
35. 返回：((2 2 3 4) (2 2 1 5) (1 1 0 4) (1 1 1 7))
    
36. |;
    
37. ;;
    
38. (defun my_px_v2( pobiao biao1 biao2 fuzz / n i id bj aa bb )
    
39.   (vl-sort pobiao
    
40.         ''((a b)
    
41.             (setq n (length biao1))
    
42.             (setq i 0)
    
43.             (while (< i n)
    
44.               (setq id (vl-position i biao1))    ;;比较维度
    
45.               (setq bj (nth id biao2))            ;;比较符号
    
46.               
    
47.               ;;ab比较
    
48.               (if (null bj)
    
49.                 (setq i (1+ i))
    
50.                 (progn
    
51.                   (setq aa (nth id a))
    
52.                   (setq bb (nth id b))
    
53.                   (if (> (abs (- aa bb)) fuzz)
    
54.                     (progn
    
55.                       (setq i n)
    
56.                       ((eval bj) aa bb)
    
57.                     )
    
58.                     (setq i (1+ i))
    
59.                   )
    
60.                 )
    
61.               )
    
62.             )
    
63.         )
    
64.   )
    
65. )

;999公共函数<br /> ;|<br /> my_px_v2   给定排序优先级和排序方式，对多维坐标表进行排序   （允许对某个维度忽略排序）<br /> (my_px_v2 pobiao biao1 biao2 fuzz)<br /> <br /> pobiao----点坐标集合，每一个元素均为n维坐标点<br /> biao1-----每一维的排序优先级，是一个0~n-1的整数表，数字越小级别越高。如'(1 2 0) 表示Z优先级最高，X其次，Y最低<br /> biao2-----各维的排序关系，元素个数n-1，元素为“>”或“<”或nil，nil表示对应维度不排序。如'(> > nil) 表示X按大小排序，Y按大小排序，Z不进行排序<br /> fuzz------容差值。<br /> <br /> 实例：<br /> 二维坐标从上到下从左到右，容差为0【这是人阅读的习惯模式】<br /> (my_px_v2 '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) '(1 0) '(< >) 0)<br /> 返回：((7 9) (1 6) (6 4) (7 3) (2 2) (6 2))<br /> <br /> 实例：<br /> 二维坐标从上到下从左到右，容差为1<br /> (my_px_v2 '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) '(1 0) '(< >) 1)<br /> 返回：((7 9) (1 6) (6 4) (2 2) (6 2) (7 3))<br /> <br /> 实例：<br /> 四维坐标指定方式排序1<br /> (my_px_v2 '((2 2 3 4)(1 1 1 7)(2 2 1 5)(1 1 0 4)) '(2 1 0 3) '(< > > <) 0)<br /> 返回：((2 2 3 4) (2 2 1 5) (1 1 1 7) (1 1 0 4))<br /> <br /> 实例：<br /> 四维坐标指定方式排序2<br /> (my_px_v2 '((2 2 3 4)(1 1 1 7)(2 2 1 5)(1 1 0 4)) '(2 1 0 3) '(< > < <) 0)<br /> 返回：((1 1 0 4) (2 2 1 5) (1 1 1 7) (2 2 3 4))<br /> <br /> 实例：<br /> 四维坐标指定方式排序3<br /> (my_px_v2 '((2 2 3 4)(1 1 1 7)(2 2 1 5)(1 1 0 4)) '(2 1 0 3) '(< > nil <) 0)<br /> 返回：((2 2 3 4) (2 2 1 5) (1 1 0 4) (1 1 1 7))<br /> |;<br /> ;;<br /> (defun my_px_v2( pobiao biao1 biao2 fuzz / n i id bj aa bb )<br />   (vl-sort pobiao<br />         ''((a b)<br />             (setq n (length biao1))<br />             (setq i 0)<br />             (while (< i n)<br />               (setq id (vl-position i biao1))    ;;比较维度<br />               (setq bj (nth id biao2))            ;;比较符号<br />               <br />               ;;ab比较<br />               (if (null bj)<br />                 (setq i (1+ i))<br />                 (progn<br />                   (setq aa (nth id a))<br />                   (setq bb (nth id b))<br />                   (if (> (abs (- aa bb)) fuzz)<br />                     (progn<br />                       (setq i n)<br />                       ((eval bj) aa bb)<br />                     )<br />                     (setq i (1+ i))<br />                   )<br />                 )<br />               )<br />             )<br />         )<br />   )<br /> )

菜卷鱼

你这个问题问得很抽象
一维表排序好说，就1个数字，可以直接排序
二维表就说不通了，是先排X位呢，还是先排Y位
三维表也是，X，Y，Z先排哪个总得有个顺序吧？

llsheng_73

菜卷鱼 发表于 2022-9-17 09:41
你这个问题问得很抽象
一维表排序好说，就1个数字，可以直接排序
二维表就说不通了，是先排X位呢，还是先 ...

确实这一点很重要。。。

aihuyujian

所以说搞个二维的感觉头都秃了  更别说三维了
  

菜卷鱼

l 排序次数
d 排序方向，nil 表示从左至右
f 排序方法 > , <

(setq lst '((1 2 3)(2 3 2)(3 4 1)))
(ldfsort lst 3 nil >) ==>((1 2 3) (2 3 2) (3 4 1))
(ldfsort lst 3 t >)==>((3 4 1) (2 3 2) (1 2 3))

1. (defun ldfsort (lst l d f / ldf_sort s nf lst)
   
2.   (defun ldf_sort (lst n f)
   
3.     (vl-sort lst '(lambda (x y) (f (nth n x) (nth n y))))
   
4.   )
   
5.   (if (null d)
   
6.     (setq s  -1
   
7.           nf 1+
   
8.     )
   
9.     (setq s  l
   
10.           nf 1-
    
11.     )
    
12.   )
    
13.   (repeat l
    
14.     (setq s (nf s))
    
15.     (setq lst (ldf_sort lst s f))
    
16.   )
    
17. )
    

(defun ldfsort (lst l d f / ldf_sort s nf lst)<br />   (defun ldf_sort (lst n f)<br />     (vl-sort lst '(lambda (x y) (f (nth n x) (nth n y))))<br />   )<br />   (if (null d)<br />     (setq s  -1<br />           nf 1+<br />     )<br />     (setq s  l<br />           nf 1-<br />     )<br />   )<br />   (repeat l<br />     (setq s (nf s))<br />     (setq lst (ldf_sort lst s f))<br />   )<br /> )<br />

llsheng_73

aihuyujian 发表于 2022-9-17 10:03
所以说搞个二维的感觉头都秃了  更别说三维了

按L表中各维顺序给定排序依据，按排序优先次序给出sorts
对于先Y按增加x按减来说 （sortn l '(1 0) (list < >))

guosheyang

masterlong 发表于 2022-9-19 14:32

感谢优化，加上了容差   代码好像更简洁了

masterlong

73兄的代码看着费劲
执行效率比我的高

(progn
        (time_start)
        (repeat 50000 (my_px '((2 2 3 4)(1 1 1 7)(2 2 1 5)(1 1 0 4)) '(2 1 0 3) '(< > > <) 0))
        (time_end)
)
********程序运行完成   耗时 28.07 秒********

(progn
        (time_start)
        (repeat 50000 (SORTN '((2 2 3 4)(1 1 1 7)(2 2 1 5)(1 1 0 4)) '(2 1 0 3) (list < >  > <)))
        (time_end)
)
********程序运行完成   耗时 5.44 秒********

差距还挺大
是我的代码里nth用的比较多？