首先从LISP中的列表中排序原子然后再列出子列表

时间:2012-05-13 15:59:47

标签: lisp common-lisp difference-lists

我在LISP中有这个功课,我需要从列表中挑选出原子然后的子列表。我确信这应该是一件容易的事,但由于我不是一个程序员,所以我真的花了很长时间才能理解。

我有这个数字列表:

(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)

如果我理解我的任务,那么我应该得到这样的东西:

(5 -1 -6 (2 6 1) (8 7 -3) (0 (9 4)))

到目前为止,我发现的是如何计算原子和/或子列表,但我不需要。

(DEFUN ATOMNUMBER (L) (COND ((NULL L) 0)
  ((ATOM (CAR L)) (+ 1 (ATOMNUMBER (CDR L))))
  (T (ATOMNUMBER (CDR L))) ))

即使只有子列表,只有原子或只是空列表,该函数也应正常工作。

也许有人可以给我任何例子?

提前致谢!

5 个答案:

答案 0 :(得分:7)

Common Lisp有几种可能的方法:

  • 使用REMOVE-IF删除不需要的项目。 (或者使用REMOVE-IF-NOT来保存想要的物品。)你需要两个清单。附加它们。

  • 使用DOLIST并遍历列表,将项目收集到两个列表中并附加

  • 编写一个递归过程,您需要保留两个结果列表。

  • 也可以使用带有特殊排序谓词的SORT。

示例:

> (sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
        (lambda (a b)
           (atom a)))

(1 10 -6 1 4 4 1 (2 6 1) (8 7 -3) (0 (9 4)))

作为稳定版本:

(stable-sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
             (lambda (a b)
               (and (atom a)
                    (not (atom b)))))

(1 4 4 1 -6 10 1 (2 6 1) (8 7 -3) (0 (9 4)))

答案 1 :(得分:2)

我更习惯于Scheme,但这里有一个适用于Lisp的解决方案:

(defun f (lst)
  (labels 
      ((loop (lst atoms lists)
         (cond
          ((null lst) 
           (append (reverse atoms) (reverse lists)))
          ((atom (car lst))
           (loop (cdr lst) (cons (car lst) atoms) lists))
          (T
           (loop (cdr lst) atoms (cons (car lst) lists))))))
    (loop lst '() '())))

(f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))

基本上,您遍历列表,并将每个元素附加到原子列表或列表列表中。最后,您加入两者以获得结果。

修改

remove-if版本当然更短:

(let ((l '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
   (append
    (remove-if-not #'atom l)
    (remove-if     #'atom l)))

答案 2 :(得分:0)

这是一个迭代代码,以自上而下的方式构造其输出(注释采用Haskell语法):

;atomsFirst xs = separate xs id id where
;  separate [] f g  = f (g [])
;  separate (x:xs) f g
;      | atom x = separate xs (f.(x:)) g
;      | True   = separate xs f (g.(x:))

(defmacro app (l v)
   `(progn (rplacd ,l (list ,v)) (setq ,l (cdr ,l))))

(defun atoms-first (xs)
  (let* ((f (list nil)) (g (list nil)) (p f) (q g))
    (dolist (x xs)
      (if (atom x) (app p x) (app q x)))
    (rplacd p (cdr g))
    (cdr f)))

以自上而下的方式构造的两个中间列表被维护为开放式列表(即具有显式结束指针),基本上遵循差异列表范例。

答案 3 :(得分:0)

万一你想要锻炼更多,你会发现这里提供的例子还不够:P

(defun sort-atoms-first-recursive (x &optional y)
  (cond
    ((null x) y)
    ((consp (car x))
     (sort-atoms-first-recursive (cdr x) (cons (car x) y)))
    (t (cons (car x) (sort-atoms-first-recursive (cdr x) y)))))

(defun sort-atoms-first-loop (x)
  (do ((a x (cdr a))
       (b) (c) (d) (e))
      (nil)
    (if (consp (car a))
      (if b (setf (cdr b) a b (cdr b)) (setf b a d a))
      (if c (setf (cdr c) a c (cdr c)) (setf c a e a)))
    (when (null (cdr a))
      (cond
        ((null d) (return e))
        ((null c) (return d))
        (t (setf (cdr b) nil (cdr c) d) (return e))))))


(sort-atoms-first-recursive '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))

(sort-atoms-first-loop '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))

第二个是破坏性的(但不会产生任何新的结果)。

答案 4 :(得分:0)

你可以这样递归:

(defun f (lst) 
    (cond 
        ((null lst) nil)
        ((atom (car lst)) 
        (append (list (car lst)) (f (cdr lst)))) 
        (T
            (append (f (cdr lst)) (list (f (car lst))))
        )
    )
)
(step (f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))

输出:

step 1 --> (F '(5 -1 (2 6 1) (8 7 -3) ...))                                                                   
step 1 ==> value: (5 -1 -6 (0 (9 4)) (8 7 -3) (2 6 1))