Given that this must be a common homework problem, one would suppose
there'd be several implementations on the web, however, I didn't
find any. The problem could be worded thus:
Return (in a list) all combinations of length N with M ones
and (- N M) zeros.
And my solution is:
(defun combinations (number-of-ones number-of-elements
&optional prefix result)
(cond ((= number-of-ones 0)
(cons (append prefix (make-list number-of-elements
:initial-element 0)) result))
((= number-of-ones number-of-elements)
(cons (append prefix (make-list number-of-elements
:initial-element 1)) result))
(t
(append (combinations number-of-ones (1- number-of-elements)
(append prefix (list 0)) result)
(combinations (1- number-of-ones) (1- number-of-elements)
(append prefix (list 1)) result)
result))))
However, I have a suspicion this is not nearly the most optimal one,
nor the most elegant way of doing this. Any suggestions?
PS: Despite what I said above, this is not, for me, a homework problem...
--
Ola Rinta-Koski ···@cyberell.com
Cyberell Oy +358 41 467 2502
Rauhankatu 8 C, FIN-00170 Helsinki, FINLAND www.cyberell.com
[Ola Rinta-Koski]
: Given that this must be a common homework problem, one would suppose
: there'd be several implementations on the web, however, I didn't
: find any. The problem could be worded thus:
:
: Return (in a list) all combinations of length N with M ones
: and (- N M) zeros.
How about:
(defun combinations (zeros ones)
(cond ((zerop zeros) (list (make-list ones :initial-element 1)))
((zerop ones) (list (make-list zeros :initial-element 0)))
(t (append (loop for x in (combinations (1- zeros) ones)
collect (cons 0 x))
(loop for x in (combinations zeros (1- ones))
collect (cons 1 x))))))
--
Knut Arild Erstad
But if less is more, then just think how much more more will be.
-- from "Frasier"
··········@ii.uib.no (Knut Arild Erstad) writes:
> [Ola Rinta-Koski]
> : Return (in a list) all combinations of length N with M ones
> : and (- N M) zeros.
>
> How about:
>
> (defun combinations (zeros ones)
> (cond ((zerop zeros) (list (make-list ones :initial-element 1)))
> ((zerop ones) (list (make-list zeros :initial-element 0)))
> (t (append (loop for x in (combinations (1- zeros) ones)
> collect (cons 0 x))
> (loop for x in (combinations zeros (1- ones))
> collect (cons 1 x))))))
Changing that APPEND to NCONC would win big. More seriously, this
approach recomputes large numbers of subproblems since, e.g.,
(COMBINATIONS (1- ZEROS) ONES) and (COMBINATIONS ZEROS (1- ONES))
both have (COMBINATIONS (1- ZEROS) (1- ONES)) as a subproblem, unless
ZEROS or ONES equals 1.
The subproblems form a lattice indexed by ZEROS and ONES. Above,
you've got the rule there that relates lattice element (ZEROS, ONES)
to elements (ZEROS-1, ONES) and (ZEROS, ONES-1). The least wasteful
way to calculate the top corner of the lattice (the requested result)
is to build one of the edge rows (0...ZEROS, 0), then calculate each
element in the next row (0...ZEROS, 1) using the rule, and repeat as
necessary.
(defun supercomb (zeros ones)
(loop for row first (loop repeat (1+ zeros)
for z/0 first '() then (cons 0 z/0)
collect (list z/0))
then (loop for z/o-1 in row
for z-1/o first '() then z/o
for z/o = (nconc (loop for x in z-1/o
collect (cons 0 x))
(loop for x in z/o-1
collect (cons 1 x)))
collect z/o)
repeat ones
finally (return (car (last row)))))
This is much faster since it doesn't duplicate any subresults and gets
maximum sharing between the items (most of the conses created are
returned in the result). I think it's actually algorithmically
better, because of the duplication, but the calculation is too complex
for me to do for Friday afternoon fun.
--
Pekka P. Pirinen
Mail should be private, whether on paper or on disk. Public gatherings
should be a right, whether virtual or in person.
·····@harlequin.co.uk (Pekka P. Pirinen) writes:
> (defun supercomb (zeros ones)
> (loop for row first (loop repeat (1+ zeros)
> for z/0 first '() then (cons 0 z/0)
> collect (list z/0))
> then (loop for z/o-1 in row
> for z-1/o first '() then z/o
> for z/o = (nconc (loop for x in z-1/o
> collect (cons 0 x))
> (loop for x in z/o-1
> collect (cons 1 x)))
> collect z/o)
> repeat ones
> finally (return (car (last row)))))
Couldn't get this to run on CMUCL at first; changing FIRST to = did
the trick. Different LOOP implementations? Anyway, thanks, this is
by far the fastest of the three.
--
Ola Rinta-Koski ···@cyberell.com
Cyberell Oy +358 41 467 2502
Rauhankatu 8 C, FIN-00170 Helsinki, FINLAND www.cyberell.com
Ola Rinta-Koski <···@cyberell.com> writes:
> ·····@harlequin.co.uk (Pekka P. Pirinen) writes:
> > for z/0 first '() then (cons 0 z/0)
>
> Couldn't get this to run on CMUCL at first; changing FIRST to = did
> the trick. Different LOOP implementations?
Yes, LispWorks has one of its own. FIRST/THEN seems logical, but it's
definitely non-standard. I guess I learned to do that on Symbolics
and have just been (un)lucky that LW has it as an extension.
--
Pekka P. Pirinen, Harlequin Limited
Only fools learn by their experience; smart people use the experience
of others. - Bismarck