Below is a function list-combinations that takes a list lst an an
integer n and returns a list of all n-element combinations of lst. The
function uses divide and conquer recursion, dividing all n-element
combinations into those that contain the first element of lst and those
that do not.
CL-USER> (dolist (elt (list-combinations '(1 2 3 4 5) 2))
(format t "~A~%" elt))
(1 2)
(1 3)
(1 4)
(1 5)
(2 3)
(2 4)
(2 5)
(3 4)
(3 5)
(4 5)
NIL
Then, I've written three special cases that use iteration, not
recursion, to find 1-element, 2-element, and 3-element combinations.
You can see the pattern -- to find n-element combinations, I use n
nested do expressions.
CL-USER> (1-combinations '(1 2 3 4 5))
((1) (2) (3) (4) (5))
CL-USER> (2-combinations '(1 2 3))
((1 2) (1 3) (2 3))
CL-USER> (3-combinations '(1 2 3 4))
((1 2 3) (1 2 4) (1 3 4) (2 3 4))
My question is this:
Is there a construct that enables me to write a macro or function that
takes an integer n and returns a function called n-combinations, such
function containing n nested do expressions?
;;;; returns a list of all n-element combinations
;;;; of the list lst
(defun list-combinations (lst n)
(cond
((> n (length lst)) nil)
((< n 1) nil)
((< n 2) (mapcar #'list lst))
(t (let ((big-list (list-combinations (cdr lst) n))
(small-list (list-combinations (cdr lst) (1- n))))
(append (mapcar (lambda (e) (cons (car lst) e)) small-list)
big-list)))))
;;;; returns a list of all 1-element combinations
;;;; of list lst
(defun 1-combinations (lst)
(let ((result nil))
(do ((x1 lst (cdr x1)))
((< (length x1) 1) result)
(setf result (append result
(list (list (car x1))))))))
;;;; returns a list of all 2-element combinations
;;;; of list lst
(defun 2-combinations (lst)
(let ((result nil))
(do ((x1 lst (cdr x1)))
((< (length x1) 2) result)
(do ((x2 (cdr x1) (cdr x2)))
((< (length x2) 1) nil)
(setf result (append result
(list (list (car x1)
(car x2)))))))))
;;;; returns a list of all 3-element combinations
;;;; of list lst
(defun 3-combinations (lst)
(let ((result nil))
(do ((x1 lst (cdr x1)))
((< (length x1) 3) result)
(do ((x2 (cdr x1) (cdr x2)))
((< (length x2) 2) nil)
(do ((x3 (cdr x2) (cdr x3)))
((< (length x3) 1) nil)
(setf result (append result
(list (list (car x1)
(car x2)
(car x3))))))))))
From: Thomas A. Russ
Subject: Re: Combinations: recursion, iteration, or other options?
Date:
Message-ID: <ymi1wyyh79r.fsf@sevak.isi.edu>
"Andrew Baine" <·······@gmail.com> writes:
> Then, I've written three special cases that use iteration, not
> recursion, to find 1-element, 2-element, and 3-element combinations.
> You can see the pattern -- to find n-element combinations, I use n
> nested do expressions.
>
> CL-USER> (1-combinations '(1 2 3 4 5))
> ((1) (2) (3) (4) (5))
> CL-USER> (2-combinations '(1 2 3))
> ((1 2) (1 3) (2 3))
> CL-USER> (3-combinations '(1 2 3 4))
> ((1 2 3) (1 2 4) (1 3 4) (2 3 4))
>
> My question is this:
> Is there a construct that enables me to write a macro or function that
> takes an integer n and returns a function called n-combinations, such
> function containing n nested do expressions?
Yes, a macro.
The beauty of lisp macros is that you can run arbitrary code and use it
to generate the expansion. The only restriction is that the parameter
"n" must be a constant, since it is needed at macro expansion time in
order to generate the code. This is sometime before run time. So what
you end up doing is figuring out how to, for example, build the
following list when given the parameter 3:
(do ((x1 lst (cdr x1)))
((< (length x1) 3) result)
(do ((x2 (cdr x1) (cdr x2)))
((< (length x2) 2) nil)
(do ((x3 (cdr x2) (cdr x3)))
((< (length x3) 1) nil)
(setf result (append result
(list (list (car x1)
(car x2)
(car x3))))))))
I would split this into a part of the code that constructs the innermost
part of the construct
(list (car x1) (car x2) (car x3))
and a part that builds up the loop superstructure. Since this macro
doesn't include any user code, you can even dispense with the need to
use gensyms for variables.
As a minor efficiency note, I would prefer to accumulate the combination
values in reverse order by using
(push (list (car x1) ...) result)
in place of
(setf result (append result (list (car x1) ...)))
If you really want to keep the order of results the same, then return
(nreverse result) instead of result.
Maybe something like:
(defmacro def-combinations (n)
(let ((function-name (intern (format nil "~D-COMBINATIONS" n)))
(variables (make-array (+ n 1))); Hold iteration variables, 1-based.
(code nil) ; Hold code generated so far
(initial-value nil)) ; Hold initial value for DO loop variable.
;; Now setup the variables and the inner bit of code
;; by looping and building things up.
;; Tricky: Put the input variable at position 0 in the array
;; of variables to allow (nearly) uniform clause generation.
(setf (aref variables 0) 'lst)
(loop for i from 1 to n
as symbol = (intern (format nil "X~D" i))
do (setf (aref variables i) symbol)
(push `(car ,symbol) code))
;; Innermost code:
(setq code `(push (list ,@(nreverse code)) result))
;; Use two counters for convenience, so we don't have to
;; use arithmetic for most of this.
(loop for depth from n downto 1 ; Counter for down
as remainder from 1 to n ; Counter for up
do (if (= depth 1)
(setq initial-value 'arg) ; special case for top iteration
(setq initial-value `(cdr ,(aref variables (1- depth)))))
(setq code `(do ((,(aref variables depth)
,initial-value
(cdr ,(aref variables depth))))
((< (length ,(aref variables depth)) ,remainder))
,code)))
`(defun ,function-name (arg)
(let ((result nil))
,code
result)))) ; Maybe (nreverse result) here?
This gives:
(pprint (macroexpand-1 '(def-combinations 3)))
==>
(DEFUN 3-COMBINATIONS (ARG)
(LET ((RESULT NIL))
(DO ((X1 ARG (CDR X1)))
((< (LENGTH X1) 3))
(DO ((X2 (CDR X1) (CDR X2)))
((< (LENGTH X2) 2))
(DO ((X3 (CDR X2) (CDR X3)))
((< (LENGTH X3) 1))
(PUSH (LIST (CAR X1) (CAR X2) (CAR X3)) RESULT))))
RESULT))
For even more efficiency, you could replace the (LENGTH ...) test with
one based on (NULL (NTH-CDR ...)) instead.
> ;;;; returns a list of all 3-element combinations
> ;;;; of list lst
> (defun 3-combinations (lst)
> (let ((result nil))
> (do ((x1 lst (cdr x1)))
> ((< (length x1) 3) result)
> (do ((x2 (cdr x1) (cdr x2)))
> ((< (length x2) 2) nil)
> (do ((x3 (cdr x2) (cdr x3)))
> ((< (length x3) 1) nil)
> (setf result (append result
> (list (list (car x1)
> (car x2)
> (car x3))))))))))
>
--
Thomas A. Russ, USC/Information Sciences Institute
Andrew Baine wrote:
> Below is a function list-combinations that takes a list lst an an
> integer n and returns a list of all n-element combinations of lst. The
> function uses divide and conquer recursion, dividing all n-element
> combinations into those that contain the first element of lst and those
> that do not.
>
> ;;;; returns a list of all n-element combinations
> ;;;; of the list lst
> (defun list-combinations (lst n)
> (cond
> ((> n (length lst)) nil)
> ((< n 1) nil)
> ((< n 2) (mapcar #'list lst))
> (t (let ((big-list (list-combinations (cdr lst) n))
> (small-list (list-combinations (cdr lst) (1- n))))
> (append (mapcar (lambda (e) (cons (car lst) e)) small-list)
> big-list)))))
>
As an alternative recursive version I think this is more idiomatic Lisp:
(defun combinations (l r)
(cond ((zerop r) (list '()))
((null l) '())
(t (spread-elt (first l)
(combinations (rest l) (1- r))
(combinations (rest l) r)))) )
;;;
;;; Distribute ELT across each sublist in PARTIAL accumulating them in
;;; (possibly pre-existing) RESULT.
;;;
;;; (spread-elt 'a '((b c) (c b)) '()) => ((A B C) (A C B))
;;;
;;; (spread-elt 'a '((b c) (c b)) '((b c a) (b a c) (c b a) (c a b))) =>
;;; ((A B C) (A C B) (B C A) (B A C) (C B A) (C A B))
;;;
(defun spread-elt (elt partial result)
(cond ((null partial) result)
(t (cons (cons elt (first partial))
(spread-elt elt (rest partial) result)))) )
Notice how we can avoid using LENGTH and APPEND. Your version appears to
cons 30-50% more than this one.
Aloha,
David Sletten