[讨论]：再探数组排序

梦断江南 · 发表于 2004-2-5 18:03:45

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

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

×

以下是秋风版主的程序，对点先x后y后z从小到大排序
我提出的问题是：以下程序只能对3维的数组有效，如果数组内元素个数不定，如何写一个通用的程序来进行排序？
如：（（n个元素）（n个元素）（n个元素）。。。）

Sort_and_Write_pList :见附件
(defun Sort_and_Write_pList (fname plist / fp pt)
;; sort plist first
(setq plist (vl-sort plist
'(lambda (p1 p2)
(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)
)
)
)
)
;; write plist then
(setq fp (open fname "w"))
(foreach pt plist (princ pt fp) (princ "\n" fp))
(close fp)
)
;;;　测试上述函数
(Sort_and_Write_pList
"c:/test.txt"
'((1 3 4)
(2 4 5)
(3 4 5)
(1 3 2)
(3 5 2)
(2 4 0)
(1 2 3)
(1 2 0)
(1 1 0)
)
)
下载：
点击浏览该文件
运行结果：c:\test.txt中内容
(1 1 0)
(1 2 0)
(1 2 3)
(1 3 2)
(1 3 4)
(2 4 0)
(2 4 5)
(3 4 5)
(3 5 2)

Sort_and_Write_pList :见附件 
(defun Sort_and_Write_pList (fname plist / fp pt) 
  ;; sort plist first 
  (setq plist (vl-sort plist 
         '(lambda (p1 p2) 
     (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) 
     ) 
   ) 
       ) 
  ) 
  ;; write plist then 
  (setq fp (open fname "w")) 
  (foreach pt plist (princ pt fp) (princ "\n" fp)) 
  (close fp) 
) 
 
;;;　测试上述函数 
(Sort_and_Write_pList 
  "c:/test.txt" 
  '((1 3 4) 
    (2 4 5) 
    (3 4 5) 
    (1 3 2) 
    (3 5 2) 
    (2 4 0) 
    (1 2 3) 
    (1 2 0) 
    (1 1 0) 
   ) 
) 
下载： 
 
 点击浏览该文件 
运行结果：c:\test.txt中内容 
(1 1 0) 
(1 2 0) 
(1 2 3) 
(1 3 2) 
(1 3 4) 
(2 4 0) 
(2 4 5) 
(3 4 5) 
(3 5 2)

陌生人 · 发表于 2004-2-6 23:17:25

有点意思，我也考虑考虑这个问题。
论坛的高手都去哪儿放风了？怎么没一个出来的？

ll_j · 发表于 2004-2-7 16:14:39

发一帖，抛砖引玉，冒泡法。

;;比较两个数值表的大小，fun可以是“'<”（升序）或“'>”（降序）
(defun comp_list (list1 list2 fun / sign i len1 len2 listt list_c list_a)
(setq sign nil
i 0
len1 (length list1)
len2 (length list2)
n (eval (list 'min len1 len2))
list_a (list list1 list2)
)
(if (not (eval (list fun len1 len2)))
(setq listt list1
list1 list2
list2 listt
)
)
(setq list_c (list list1 list2))
(while (and (not sign) (< i n))
(setq atom1 (nth i list1)
atom2 (nth i list2)
)
(if (= atom1 atom2)
(setq i (1+ i))
(if (eval (list fun atom1 atom2))
(setq sign t)
(setq sign t
list_c (list list2 list1)
)
)
)
)
; (princ list_c) ;返回排序后组合表
(if (equal list_c list_a) ;返回是否符合函数fun
t
nil
)
)
;;二阶数值表排序，fun可以是“'<”（升序）或“'>”（降序）
(defun sort_list (nlist fun / len lista list_b list_o)
(setq list_o nil
len (length nlist)
)
(repeat len
(setq lista (car nlist)
nlist (cdr nlist)
list_b nil
)
(mapcar
'(lambda (x)
(if (comp_list lista x fun)
(setq list_b (cons x list_b))
(setq list_b (cons lista list_b)
lista x
)
)
)
nlist
)
(setq nlist list_b)
(setq list_o (cons lista list_o))
)
(reverse list_o)
)

;;比较两个数值表的大小，fun可以是“'<”（升序）或“'>”（降序） 
(defun comp_list (list1 list2 fun / sign i len1 len2 listt list_c list_a) 
  (setq        sign   nil 
        i      0 
        len1   (length list1) 
        len2   (length list2) 
        n      (eval (list 'min len1 len2)) 
        list_a (list list1 list2) 
  ) 
  (if (not (eval (list fun len1 len2))) 
    (setq listt        list1 
          list1        list2 
          list2        listt 
    ) 
  ) 
  (setq list_c (list list1 list2)) 
  (while (and (not sign) (
    (setq atom1        (nth i list1) 
          atom2        (nth i list2) 
    ) 
    (if        (= atom1 atom2) 
      (setq i (1+ i)) 
      (if (eval (list fun atom1 atom2)) 
        (setq sign t) 
        (setq sign   t 
              list_c (list list2 list1) 
        ) 
      ) 
    ) 
  ) 
;  (princ list_c)                ;返回排序后组合表 
  (if (equal list_c list_a)        ;返回是否符合函数fun 
    t 
    nil 
  ) 
) 
 
;;二阶数值表排序，fun可以是“'<”（升序）或“'>”（降序） 
(defun sort_list (nlist fun / len lista list_b list_o) 
  (setq        list_o nil 
        len    (length nlist) 
  ) 
  (repeat len 
    (setq lista         (car nlist) 
          nlist         (cdr nlist) 
          list_b nil 
    ) 
    (mapcar 
      '(lambda (x) 
         (if (comp_list lista x fun) 
           (setq list_b (cons x list_b)) 
           (setq list_b        (cons lista list_b) 
                 lista        x 
           ) 
         ) 
       ) 
      nlist 
    ) 
    (setq nlist list_b) 
    (setq list_o (cons lista list_o)) 
  ) 
  (reverse list_o) 
)

测试：

命令: (setq nlist '((1 2 3) (3 3) (3 1 2 4) (2 1 3) (3 3 3) (2 1 3 4) (2 2) (1 2) (1 2 3 4 5)))
((1 2 3) (3 3) (3 1 2 4) (2 1 3) (3 3 3) (2 1 3 4) (2 2) (1 2) (1 2 3 4 5))
命令: (sort_list nlist '<)
((1 2) (1 2 3) (1 2 3 4 5) (2 1 3) (2 1 3 4) (2 2) (3 1 2 4) (3 3) (3 3 3))
命令: (sort_list nlist '>)
((3 3 3) (3 3) (3 1 2 4) (2 2) (2 1 3 4) (2 1 3) (1 2 3 4 5) (1 2 3) (1 2))

841594 · 发表于 2004-2-7 21:41:30

我的办法：

(defun sort_list (nlist)
 (vl-sort nlist
 '(lambda (a b)
 (while (and a (equal (car a) (car b))) (setq a (cdr a) b (cdr b)))
 (cond
((and a b) (< (car a) (car b)))
(a nil)
(b T)
 )
 )
 )
)

这是从小到大排序；若要从大到小可用
(reverse (sort_list nlist))
呵呵。

wkai · 发表于 2004-2-11 17:39:44

测测这个:

[FONT=courier new]
(defun c:tt ()
(setq a '((1 2 3 5) (4 2 4 5 9) (1 2 3 4) (5 2 5 1 2)(1 2 5) (1 1 3) (1 3 4) (1 7 6) (2 2 3) ))
(setq len 0)
(foreach n a (if(> (length n) len)(setq len (length n))))
(setq n len)
(repeat len
(setq n (1- n))
(setq a (vl-sort a '(lambda (s1 s2) (< (nth n s1) (nth n s2)))))
)
(foreach n a (print n))(princ)
)
[/FONT]

ll_j · 发表于 2004-2-11 19:19:25

最初由 wkai 发布
[B]测测这个:

(defun c:tt ()
  (setq a '((1 2 3 5) (4 2 4 5 9) (1 2 3 4) (5 2 5 1 2)(1 2 5) (1 1 3) (1 3 4) (1 7 6) (2 2 3)  ))
  (setq len 0)
  (foreach n a (if(> (lengt... [/B]

将子表原子从后向前依次排序，太巧妙了！按wkai的程序归纳出通用代码：

(defun sort_list (a / n)
(repeat (setq n (apply 'max (mapcar 'length a)))
(setq n (1- n))
(setq a (vl-sort a '(lambda (s1 s2) (< (nth n s1) (nth n s2)))))
)
; (foreach n a (print n))(princ)
)

陌生人 · 发表于 2004-2-11 22:27:16

好棋！建议加分

账号		自动登录	找回密码
密码			立即注册

[讨论]：再探数组排序

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

相关帖子

浏览过的版块