Цикл для упорядоченных пар эквивалентных в Common Lisp

Question

Предположим, у вас есть список и вы хотите сгенерировать список всех упорядоченных пар элементов, например, список равен '(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.

Мой вопрос сейчас таков: как будет выглядеть идиоматическая версия Common Lisp для for-as-in-list тип итерации?

У меня есть кое-что, что работает, но выглядит принудительно:

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

Answer 1

Я не вижу «вынужденного».В C у вас есть два вложенных цикла.В Common Lisp у вас есть два вложенных цикла.Это потому, что проблема имеет такую ​​структуру.

Вы можете быть озадачены многословностью loop, но это так, как это задумано.По крайней мере, вам не нужно самостоятельно разбирать индексы.

Если вам это не нравится, есть другие конструкции, например:

(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))))

Answer 2

Используя 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))

Answer 3

Вот немного более простая версия:

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))