Декартово произведение множеств

(defun decart (x y)
(setq dek ())
(do ((i 0 (+ i 1))) ((= i (length x)))
(setq z ())
(do ((j 0 (+ j 1))) ((= j (length y))) (setq z (cons (nth i x)
(cons (nth j y) nil))) (push z dek)))
(reverse dek))

;; Рекурсия
 
(defun decart-r (x y &optional (s y))
  (cond ((null x) nil)
        ((null y) (decart-r (cdr x) s s))
        (t (cons (list (car x) (car y)) (decart-r x (cdr y) s))))) 
                
==> decart-r
 
(decart-r '(1 2 3 4) '(11 22 33))
 
==> ((1 11) (1 22) (1 33) (2 11) (2 22) (2 33) (3 11) (3 22) (3 33) (4 11) (4 22) (4 33))
 
;; Функционалы
 
(defun decart-f (x y)
 (apply 'append (mapcar #'(lambda (a) (mapcar #'(lambda (b) (list a b)) y)) x))) 
 
==> decart-f
 
(decart-f '(1 2 3 4) '(11 22 33))
 
==> ((1 11) (1 22) (1 33) (2 11) (2 22) (2 33) (3 11) (3 22) (3 33) (4 11) (4 22) (4 33))
 
;; Итерация (iter)
 
(defun decart-i (x y)
 (let ((r nil))
  (iter (for i in x)
    (iter (for j in y)
      (collecting (list i j) into r)))
 r))
 
==> decart-i
 
(decart-i '(1 2 3 4) '(11 22 33))
 
==> ((1 11) (1 22) (1 33) (2 11) (2 22) (2 33) (3 11) (3 22) (3 33) (4 11) (4 22) (4 33))
 
;; Итерация dolist
 
(defun decart-ii (x y)
 (let ((r nil))
   (dolist (i (reverse x) r)
     (dolist (j (reverse y) t)
       (push (list i j) r)))))
 
==> decart-ii
 
(decart-ii '(1 2 3 4) '(11 22 33))
 
==> ((1 11) (1 22) (1 33) (2 11) (2 22) (2 33) (3 11) (3 22) (3 33) (4 11) (4 22) (4 33))

(defun decart (x y)
  (decart-f x (qsort y)))  ;; вместо decart-f можно поставить любую из приведенных выше
 
==> decart
 
(decart '(a b) '(5 3 7))
 
==> ((a 3) (a 5) (a 7) (b 3) (b 5) (b 7))  ;; оно ???

;; функция проверяет, стоят ли символы x и y в том порядке, в каком они стоят 
;; в упорядочивающем списке L
 
 (defun Order (x y L) 
    (COND ((NULL L) NIL) 
              ((equal x (CAR L)) T) 
              ((equal y (CAR L)) NIL) 
              (T (order x y (CDR L)))))
 
;; Быстрая сортировка символов
 
(defun qsorts (lst)
 (let ((olist '(a b c d e f g h i j k l m n o p q r s t u v w x y z)))
   (cond ((null lst) nil)
         (t (append (qsorts (remove-if-not #'(lambda (x) (order x (car lst) olist)) (cdr lst)))
                    (list (car lst))
                    (qsorts (remove-if #'(lambda (x) (order x (car lst) olist)) (cdr lst))))))))
 
(qsorts '(q w e r t y u i o p))
 
==> (e i o p q r T u w y)

;Restructuring.
(defmacro RS (&rest body)
  `(,(first body) ,(third body) ,(second body)))

(defun decart (x y)
  (RS mapcan x #'(lambda (col)
  (RS mapcar y #'(lambda (row) (list col row))))))
 
> (decart '(a b c) '(1 2 3))
((a 1) (a 2) (a 3) (b 1) (b 2) (b 3) (c 1) (c 2) (c 3))

(defun qsorts (lst)
  (let ((olist '(a b c d e f g h i j k l m n o p q r s t u v w x y z)))
    (cond
      ((null lst) nil)
      (t (append
         (qsorts (RS remove-if-not (cdr lst) #'(lambda (x) (order x (car lst) olist))))
         (list (car lst))
         (qsorts (RS remove-if (cdr lst) #'(lambda (x) (order x (car lst) olist)))))))))