找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 2438|回复: 5

[大家来试试]:将表的排序进行到底!全能的表排序函数!

[复制链接]

已领礼包: 6个

财富等级: 恭喜发财

发表于 2006-5-31 19:06:56 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
前面写的那个点排序只对点表
下面发的可对任何[B]"对应项可排序"[/B]的表.
没有太多用过不知道效果乍的?
请大家试用!看还有什么不足!敬请指教!多谢!

  1. (defun sort-one        (getlist st / intlst astr bstr fun-lambda intlst lam
  2.                  str-a str-b)
  3.   (setq intlst (mapcar '1- (read (strcat "(" (substr st 2) ")"))))
  4.   (setq str-a " a")
  5.   (setq str-b " b")
  6.   (if intlst
  7.     (setq astr (foreach        tmp intlst
  8.                  (setq str-a (strcat " (nth " (itoa tmp) str-a ")"))
  9.                )
  10.           bstr (foreach        tmp intlst
  11.                  (setq str-b (strcat " (nth " (itoa tmp) str-b ")"))
  12.                )
  13.     )
  14.   )
  15.   (setq        lam (strcat "(FUNCTION (lambda (a b) ("
  16.                     (substr st 1 1)
  17.                     astr
  18.                     bstr
  19.                     ")))"
  20.             )
  21.   )
  22.   (setq fun-lambda (cadr (eval (read lam))))
  23.   (vl-sort getlist
  24.            'fun-lambda
  25.   )
  26. )
  27. (defun sortlist        (lst fun-lst)
  28.   (foreach tmp (reverse fun-lst)
  29.     (setq lst (sort-one lst tmp))
  30.   )
  31. )




  1. ;;用法说明:
  2. ;;顺次写出比较式"< or >"与比较量于list中
  3. ;;多层次时用"/s"空格连接如:记下表为testlist
  4. ;;'(
  5. ;;  ("kaj" (4 ("c" 1)))
  6. ;;  ("kbj" (6 ("a" 3)))
  7. ;;  ("kcj" (5 ("b" 2)))
  8. ;; )
  9. ;;比较1,3,2时请用(sortlist testlist (list ">2 2 2"))
  10. ;;比较c,a,b时请用(sortlist testlist (list ">2 2 1"))
  11. ;;比较4,6,5时请用(sortlist testlist (list ">2 1"))
  12. ;;比较kaj,kbj,kcj时请用(sortlist testlist (list ">1"))
  13. ;;一起按级别比是用:(sortlist testlist (list ">2 2 2" ">2 2 1" ">2 1" ">1"))


  14. ;;;测试如下:
  15. (defun c:test ()
  16.   (sortlist
  17.     '(
  18.       (1 (1 . 2) 3 ("kkj" 4) (3 0))
  19.       (1 (1 . 4) 1 ("skj" 45) (2 3))
  20.       (1 (1 . 2) 3 ("Aej" 45) (7 1))
  21.       (1 (2 . 3) 2 ("ser" 4) (9 2))
  22.       (2 (6 . 2) 2 ("Serj" 9) (1 4))
  23.       (3 (3 . 5) 1 ("kkjsd" 35) (7 6))
  24.       (2 (4 . 7) 2 ("Akjdd" 3) (5 4))
  25.       (3 (3 . 3) 3 ("sekj" 446) (3 4))
  26.       (2 (2 . 2) 2 ("serj" 9) (1 4))
  27.       (1 (8 . 2) 2 ("wggj" 46) (2 4))
  28.       (1 (1 . 4) 1 ("kkj" 9) (4 4))
  29.       (3 (3 . 3) 3 ("sekj" 446) (3 4))
  30.       (1 (8 . 2) 2 ("wggj" 46) (2 4))
  31.      )
  32.     (list
  33.       ;;排序条件:
  34.       ;;第一条件,依据数据("kkj" 4)中的'kkj'   =4项中第1
  35.       ">4 1"
  36.       ;;第二条件,依据数据'1',即             =第1项
  37.       ">1"
  38.       ;;第三条件,依据数据(1 . 4)中的 1       =2项中第1
  39.       ">2 1"
  40.       ;;第四条件,依据数据(3 0)中的 0         =5项中第2
  41.       ">5 2"
  42.       ;;第五条件,依据数据("kkj" 4)中的 4     =4项中第2
  43.       ">4 2"
  44.       ;;排序的优先级为1、2、3、4、5
  45. )
  46.   )
  47. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 3个

财富等级: 恭喜发财

发表于 2006-5-31 21:17:58 | 显示全部楼层
兄弟有思路和我大同小异,但兄弟的条件参数更通俗易懂

[PHP]
                                        ;表排序通用函数,By xiao_longxin

;;;测试程序
(defun c:test (/ coord tt)
  (setq        coord
         '(
           (1 (1 . 2) 3 ("kkj" 4) (3 0))
           (1 (1 . 4) 1 ("skj" 45) (2 3))
           (1 (1 . 2) 3 ("Aej" 45) (7 1))
           (1 (2 . 3) 2 ("ser" 4) (9 2))
           (2 (6 . 2) 2 ("Serj" 9) (1 4))
           (3 (3 . 5) 1 ("kkjsd" 35) (7 6))
           (2 (4 . 7) 2 ("Akjdd" 3) (5 4))
           (3 (3 . 3) 3 ("sekj" 446) (3 4))
           (2 (2 . 2) 2 ("serj" 9) (1 4))
           (1 (8 . 2) 2 ("wggj" 46) (2 4))
           (1 (1 . 4) 1 ("kkj" 9) (4 4))
           (3 (3 . 3) 3 ("sekj" 446) (3 4))
           (1 (8 . 2) 2 ("wggj" 46) (2 4))
          )
  )
  
;;表第一项为要排序的依据,注意后面的括号没有,第二项即为后括号的个数,第三项为按升还是降排序
  (setq        tt '(("(nth 0 (nth 3 " 2 ">")
             ("(nth 0" 1 "<")
             ("(car (nth 1 " 2 "<")
             ("(nth 1 (nth 4 " 2 ">")
             ("(nth 1 (nth 3" 2 ">")
            )
  )

  (order coord tt)
)


;;;主程序
(defun order (coord_list tj / coord_ord        coord_I        i j k n        tj_ tj_c tj_1
              tj_2)

  (setq n (length coord_list))
  (setq k (length tj))
  (setq tj_ "(cond ((")

  (setq tj_1 (nth 0 (nth 0 tj)))
  (setq tj_2 tj_1)
  (setq tj_1 (strcat tj_1 " p1"))
  (setq tj_2 (strcat tj_2 " p2"))
  (repeat (nth 1 (nth 0 tj))
    (setq tj_1 (strcat tj_1 ")"))
    (setq tj_2 (strcat tj_2 ")"))
  )
  (setq tj_ (strcat tj_ (nth 2 (nth 0 tj)) " " tj_1 tj_2 ") t) "))

  (setq tj_c "((and ")
  (setq i 1)
  (repeat (- k 1)
    (setq tj_c (strcat tj_c "(= " tj_1 " " tj_2 ")"))

    (setq tj_1 (nth 0 (nth i tj)))
    (setq tj_2 tj_1)
    (setq tj_1 (strcat tj_1 " p1"))
    (setq tj_2 (strcat tj_2 " p2"))
    (repeat (nth 1 (nth i tj))
      (setq tj_1 (strcat tj_1 ")"))
      (setq tj_2 (strcat tj_2 ")"))
    )

    (setq tj_ (strcat tj_
                      tj_c
                      "("
                      (nth 2 (nth i tj))
                      " "
                      tj_1
                      tj_2
                      ")) t) "
              )
    )

    (setq i (1+ i))
  )
  (setq tj_ (strcat tj_ "(t nil))"))
  ;;'(cond
  ;;((< (car p1) (car p2)) T)
  ;;((and
  ;;(= (car p1) (car p2))
  ;;(< (cadr p1) (cadr p2))
  ;;)
  ;;T
  ;;)
  ;;((and
  ;;(= (car p1) (car p2))
  ;;(= (cadr p1) (cadr p2))
  ;;(< (caddr p1) (caddr p2))
  ;;)
  ;;T
  ;;)
  ;;(T nil)
  ;;)

  (setq
    coord_i
     (vl-sort-i        coord_list
                (function (lambda (p1 p2)
                            (eval (read tj_))
                          )
                )

     )
  )

  (setq j 0)
  (repeat n
    (setq
      coord_ord        (append        coord_ord
                        (list (nth (nth j coord_i) coord_list))
                )
    )
    (setq j (1+ j))
  )
  (setq coord_ord coord_ord)
)

[/PHP]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2007-1-21 19:37:59 | 显示全部楼层
很好,多谢楼长两位奉献!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2008-1-8 23:48:15 | 显示全部楼层
师傅们做什么用处啊,我怎么使用后出现什么nil错误
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-6-25 17:29:11 | 显示全部楼层
飞诗的表排序函数,要看看
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 432个

财富等级: 日进斗金

发表于 2017-8-8 15:11:37 | 显示全部楼层
这个函数就是神器呀
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-28 18:23 , Processed in 0.340701 second(s), 41 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表