在Common Lisp中等效的有序对循环

时间:2018-12-08 17:51:35

标签: loops iteration lisp common-lisp

假设您有一个列表,并且想生成所有有序元素对的列表,例如列表是'(1 3 5 7 9),期望的结果是

((1 . 1) (1 . 3) (1 . 5) (1 . 7) (1 . 9) (3 . 3) (3 . 5) (3 . 7) (3 . 9)
 (5 . 5) (5 . 7) (5 . 9) (7 . 7) (7 . 9) (9 . 9))

如果它是C中具有索引的数组,则可以将一个for嵌套在另一个索引中,然后让第二个索引从相应的外部索引开始,即

#include <stdio.h>

int main()
{

    int arr[] = {1,3,5,7,9};

    for (int i=0; i<5; ++i) {
        for (int j = i; j<5; ++j) {
            printf("(%d, %d) ", arr[i], arr[j]);
        }
    }
    puts("");

    return 0;
}

现在,显然以上内容仅能打印出所需的结果。

索引版本应相当直接地转换为Common Lisp。

现在我的问题是:对于for-as-in-list迭代类型,惯用的Common Lisp版本看起来如何?

我有一些有效的方法,但看起来有点强迫:

(loop
     for cdrs on list
     for x in list nconc
       (loop
          for y in cdrs collect (cons x y)))

3 个答案:

答案 0 :(得分:4)

这是一个稍微简单的版本:

CL-USER> (loop for x on '(1 3 5 7 9)
               nconc (loop for y in x collect (cons (car x) y)))

((1 . 1) (1 . 3) (1 . 5) (1 . 7) (1 . 9) (3 . 3) (3 . 5) (3 . 7) (3 . 9) (5 . 5) (5 . 7) (5 . 9) (7 . 7) (7 . 9) (9 . 9))

答案 1 :(得分:2)

我看不到“被逼”。在C中,您有两个嵌套循环。在Common Lisp中,您有两个嵌套循环。这是因为问题具有这种结构。

您可能会对loop的冗长感到困惑,但这只是它的设计方式。至少您不必自己弄乱索引。

如果您不喜欢它,还可以使用其他构造。 g。:

(mapcon (lambda (sublist)
          (mapcar (lambda (second)
                    (cons (first sublist) second))
                  sublist)
        list)

(do* ((cdrs list (cdr cdrs))
      (car (first list) (first cdrs))
      (pairs ()))
     ((null car) (nreverse pairs))
  (dolist (cdr cdrs)
    (push (cons car cdr) pairs)))

您还可以使用向量(即一维数组),并重新创建具有索引感的C感:

(let ((v #(1 3 5 7 9)))
  (loop :for i :below (length v)
        :do (loop :for j :upfrom i :below (length v)
                  :do (format t "(~a, ~a) " (aref v i) (aref v j))))
  (terpri))

在评论后编辑:要显示该关系,您可以使x依赖于子列表:

(loop :for cdrs :on list
      :for car := (car cdrs)
      :nconc (loop :for cdr :in cdrs
                   :collect (cons car cdr)))

您还可以使用向量,并且仅在子向量的开头具有索引:

(let ((vector #(1 3 5 7 9)))
  (loop :for x :across vector
        :and i :upfrom 0
        :nconc (loop :for y :across (subseq vector i)
                     :collect (cons x y))))

答案 2 :(得分:1)

仅使用map系列功能

在我看来,这非常隐秘(也许是针对loop仇恨者的解决方案):

(defun 1st-conses (l)
  (mapcar #'(lambda (x) (cons (car l) x)) l))

(mapcan #'1st-conses (maplist #'identity '(1 3 5 7 9))
;; ((1 . 1) (1 . 3) (1 . 5) (1 . 7) (1 . 9) (3 . 3) (3 . 5) (3 . 7) (3 . 9)
;;  (5 . 5) (5 . 7) (5 . 9) (7 . 7) (7 . 9) (9 . 9))

仅通过递归

针对loop-仇恨者的尾部呼叫递归解决方案:

(defun 1st-conses (l)
  (labels ((.1st-conses (l fst acc)
             (cond ((null l) (nreverse acc))
                   (t (.1st-conses (cdr l) fst (cons (cons fst (car l))
                                                                acc))))))
    (.1st-conses l (car l) '())))

(defun combine-down (l &optional (acc '()))
  (cond ((null l) acc)
        (t (pairing-down (cdr l) (nconc acc (1st-conses l))))))

(combine-down '(1 3 5 7 9))
;; ((1 . 1) (1 . 3) (1 . 5) (1 . 7) (1 . 9) (3 . 3) (3 . 5) (3 . 7) (3 . 9)
;;  (5 . 5) (5 . 7) (5 . 9) (7 . 7) (7 . 9) (9 . 9))

通过小型loop函数

这三个功能的融合版本在其他答案中给出:

(defun tails (l)
  (loop for x on l collect x))

(defun 1st-conses (l)
  (loop for x in l collect (cons (car l) x)))

(loop for l in (tails '(1 3 5 7 9))
      nconc (1st-conses l))    

功能更小的通用解决方案

组合这三个函数中的任何一个-分别具有map版本,loop版本和尾调用递归版本。 -因此,您可以选择创建

  • map解决方案
  • loop解决方案或
  • 纯递归解决方案。

或者你

  • 故意将它们混合;)

功能是:

;;;;;;;;;;;;;;;;;;;;
;; function collecting all `cdr`s of a list:
;; (tails '(a b c))
;; ;; returns: ((A B C) (B C) (C))
;;;;;;;;;;;;;;;;;;;;

;; with `map`s
(defun tails (l)
  (maplist #'identity l))

;; with `loop`
(defun tails (l)
  (loop for x on l collect x))

;; tail-call-recursion
(defun tails (l &optional (acc '()))
  (cond ((null l) (nreverse acc))
        (t (tails (cdr l) (cons l acc)))))

;;;;;;;;;;;;;;;;;;;;
;; function collecting `car` of a list `cons`ed with each list element
;; (1st-conses '(a b c))
;; ;; returns: ((A . A) (A . B) (A . C))
;;;;;;;;;;;;;;;;;;;;

;; with `map`s
(defun 1st-conses (l)
  (mapcar #'(lambda (x) (cons (car l) x)) l))

;; with `loop`
(defun 1st-conses (l)
  (loop for x in l collect (cons (car l) x)))

;; tail-call-recursion
(defun 1st-conses (l)
  (labels ((.1st-conses (l fst acc)
             (cond ((null l) (nreverse acc))
                   (t (.1st-conses (cdr l) fst (cons (cons fst (car l))
                                                                acc))))))
    (.1st-conses l (car l) '())))

;;;;;;;;;;;;;;;;;;;;
;; applying the second function on the first functions' results
;; (combine-down '(a b c))
;; ;; returning: ((A . A) (A . B) (A . C) (B . B) (B . C) (C . C))
;;;;;;;;;;;;;;;;;;;;

;; with `map`s
(defun combine-down (l)
  (mapcan #'1st-conses (tails l)))

;; with `loop`
(defun combine-down (l)
  (loop for x in (tails l)
        nconc (1st-conses x)))

;; with tail-call-recursion
(defun combine-down (l)
  (labels ((.combine-down (l acc)
            (cond ((null l) acc)
                  (t (.combine-down (cdr l) 
                                    (nconc acc 
                                           (1st-conses (car l))))))))
    (.combine-down (tails l) '())))

然后:

(combine-down '(1 3 5 7 9))
;; ((1 . 1) (1 . 3) (1 . 5) (1 . 7) (1 . 9) (3 . 3) (3 . 5) (3 . 7) (3 . 9)
;;  (5 . 5) (5 . 7) (5 . 9) (7 . 7) (7 . 9) (9 . 9))

即时方式

只是为了好玩,我尽可能地从字面上翻译了命令式cpp代码- 因为作为一种真正的多范式语言...:

(let ((arr '(1 3 5 7 9))
      (res '()))
  (loop for i from 0 below 5 by 1
        do (loop for j from i below 5 by 1
                 do (setq res (cons (cons (elt arr i)
                                          (elt arr j))
                                          res))))
  (nreverse res))

它正确返回:

((1 . 1) (1 . 3) (1 . 5) (1 . 7) (1 . 9) (3 . 3) (3 . 5) (3 . 7) (3 . 9)
 (5 . 5) (5 . 7) (5 . 9) (7 . 7) (7 . 9) (9 . 9))