powerset
Frank Buss
powerset. In Haskell it is a 2 liner:
powerset [] = [[]]
powerset (x:xs) = let p = powerset xs in p ++ map (x:) p
Usage:
powerset [1,2,3]
[[],[3],[2],[2,3],[1],[1,3],[1,2],[1,2,3]]
Another version in Prolog:
combination([], []).
combination([H|T], P) :- combination(T,P).
combination([H|T], [H|P]) :- combination(T,P).
Usage:
?- combination([1,2,3], R).
R=[]
R=[3]
R=[2]
R=[2,3]
...
I don't post the more than 30 lines Java solutions now. How would it look
like in Common Lisp? One intersting fact: for my Java translation of the
Haskell solution I needed half an hour, for the Lisp solution I needed only
some minutes:
(defun powerset (list)
(let ((x (car list)))
(if x
(let ((p (powerset (cdr list))))
(append p (mapcar (lambda (list) (cons x list)) p)))
'(()))))
How would a more Lisp-like solution look like? And I'm sure an OCaml
solution would be better than every any solution in any other language :-)
--
Frank Buss, f...@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Alex Mizrahi
(you :wrote :on '(Wed, 4 Jul 2007 21:08:24 +0200))
(
FB> How would a more Lisp-like solution look like?
my "cleanroom" implemenation looks exactly like yours :)
although i didn't bother naming X:
(defun powerset (list)
(if list
(let ((rps (powerset (rest list))))
(append rps (mapcar (lambda (s) (cons (first list) s)) rps)))
(list ())))
i suspect without using some library (ITERATE?) "sane" implementation
wouldn't be much different.
btw it would be more haskellish (since they like pattern matching :) to use
DESTRUCTURING-BIND:
(defun powerset (list)
(if list
(destructuring-bind (x . xs)
(let ((p (powerset xs)))
(append p (mapcar (lambda (s) (cons x s)) p)))
(list ())))
)
(With-best-regards '(Alex Mizrahi) :aka 'killer_storm)
"scorn")
Geoffrey Summerhayes
Don't know about more 'Lisp-like' but here's two alternates:
Tail-recursive:
(defun powerset(list &optional (partial '(())))
(if (null list)
partial
(powerset (cdr list)
(append partial
(loop :for set
:in partial
:collect (cons (car list) set))))))
Collection loop:
(defun powerset(list)
(let ((result '(())))
(loop :for x :in list
:do (setf result
(loop :for set :in result
:appending (list set (cons x set)))))
result))
---
Geoff
Kaz Kylheku
> (defun powerset (list)
> (let ((x (car list)))
> (if x
> (let ((p (powerset (cdr list))))
> (append p (mapcar (lambda (list) (cons x list)) p)))
> '(()))))
>
> How would a more Lisp-like solution look like?
This one uses backquotes, LOOP, as well as the use of a generic
function to handle the two recursion cases, analogous to the pattern
matching in the examples for the other languages:
(defmethod powerset ((s null))
'(nil))
(defmethod powerset ((s list))
(loop with pn = (powerset (rest s))
for e in pn
collect `(,(first s) ,@e) into pn+e
finally (return `(,@pn ,@pn+e))))
The pn, e and pn+e notation is borrowed from the algorithm description
given in the Wikipedia.
Pascal Costanza
> (defun powerset (list)
> (let ((x (car list)))
> (if x
> (let ((p (powerset (cdr list))))
> (append p (mapcar (lambda (list) (cons x list)) p)))
> '(()))))
>
> How would a more Lisp-like solution look like? And I'm sure an OCaml
> solution would be better than every any solution in any other language :-)
(defgeneric powerset (list)
(:method ((list null)) '(()))
(:method ((list cons) &aux (p (powerset (cdr list))))
(append p (loop for x in p collect (cons (car list) x)))))
Pascal
--
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
Madhu
| There was an interesting discussion in de.comp.lang.java how to
| implement a powerset.
|
| How would a more Lisp-like solution look like?
Here is the non-recursive code to generate a "canonical listing" of all
subsets wrapped to return the powerset. (Using algorithm I described in
<m3smzfn...@robolove.meer.net>)
[In working with exponential algorithms, using indices in the listing is
typically more useful than dealing with the consed powerset itself, I've
found]
(defun q (m)
"The largest power of 2 which divides m>0"
(loop for j from 0 do
(multiple-value-bind (f r) (floor m 2)
(setq m f)
(when (= r 1) (return j)))))
(defun powerset (set)
"Set of all subsets of the given SET. Thanks MV Tamahankar[95]."
(nconc
(list nil)
(loop with size = (length set)
with mask = (make-array size :initial-element 0)
with cardinality = 0
for m from 1
for j = (q m)
while (or (/= cardinality 1)
(zerop (aref mask (- size 1))))
collect (let ((x (aref mask j)))
(setf (aref mask j) (- 1 x))
(setq cardinality (+ cardinality -1 (* 2 (aref mask j))))
(loop for i from 0 below size
when (= 1 (aref mask i))
collect (elt set i))))))
--
Madhu
Nicolas Neuss
here is a version which computes also subsets of a given size (also the
ordering is quite reasonable):
(defun subsets (set &optional (from 0) (to (length set)))
(cond ((< to from) ())
((= to from)
(if (zerop from)
(list ())
(loop for elems on set
nconc (mapcar #'(lambda (set) (cons (car elems) set))
(subsets (cdr elems) (- from 1) (- from 1))))))
(t (loop for i :from from :to to
nconc (subsets set i i)))))
(subsets '())
(subsets '(1 2 3) 2 2)
(subsets '(1 2 3))
...
Nicolas
Mattias Nilsson
> There was an interesting discussion in de.comp.lang.java how to implement a
> powerset.
> How would a more Lisp-like solution look like?
Maybe like this:
(defun powerset (set)
(let ((powerset (list nil)))
(dolist (element set powerset)
(dolist (set powerset)
(push (cons element set) powerset)))))
/Mattias
btke...@gmail.com
> solution would be better than every any solution in any other language :-)
Not sure how 'lisp like' this one is, but it's tail recursive, doesn't
use append (expensive), and works (most important).
(defun powerset_ (elts queuelist curlist)
(cond ((null elts) curlist)
((null queuelist) (powerset_ (cdr elts) curlist curlist))
(t (powerset_ elts (cdr queuelist) (cons (cons (car elts) (car
queuelist)) curlist)))
)
)
(defun powerset (elts)
(powerset_ elts '(()) '(()))
)
jim burton
> There was an interesting discussion in de.comp.lang.java how to implement a
> powerset. In Haskell it is a 2 liner:
>
> powerset [] = [[]]
> powerset (x:xs) = let p = powerset xs in p ++ map (x:) p
>
powerset = foldr (\x ys -> ys ++ (map (x:) ys)) [[]]
Mattias Nilsson
That's possible in CL too:
(defun powerset(s)(let((p '(())))(dolist(e s p)(dolist(s p)(push(cons
e s)p)))))
Any function in CL can be a one-liner; you just need long lines.
/Mattias
André Thieme
You can solve it exactly like this in Lisp.
The Lisp code will have more lines if we write it in typical Lisp style.
While in Haskell you say
function = code
in Lisp you would have:
(defun function ()
(code))
(defun powerset (set)
(reduce (lambda (x ys)
(append ys (mapcar (lambda (y)
(cons x y))
ys)))
set
:initial-value '(())
:from-end t))
So, although we have it on 8 lines it really is just one line.
powerset =
foldr (\x ys ->
++ ys (map (x:)
ys))
[[]]
which is not Haskell style. Haskell can save three lines here
because it does implicit currying (x:) instead of saying (\y -> x:y)
and you don't have to let the argument go in. Also haskell offers foldl
and foldr which are in CL both done by reduce. But that means if you
want to go with foldr you need to do :from-end t .
So, if we would
put in the argument and if we pass the implicit curry we would also
have the same 8-1 lines of code:
powerset set =
foldr (\x ys ->
++ ys (map (\y
x:y)
ys))
[[]]
set
With my DEF macro we would say in Lisp:
(def powerset (set)
(reduce {x ys ~ (append ys (mapcar {cons x} ys)}
set
:initial-value '(()) :from-end t))
which is a bit closer to the haskell version as it gets rid of the
explicit lambda and also uses implicit currying for the cons.
The Haskell code has 15 code elements, the lisp version with my def
has 20. Haskell can save 5 elements in complexity because even with
my small addition for functional programming I need to put in here
def, set, set, :from-end, t - and these are the 5 elements saves,
which makes it the winner complexity wise.
But you probably agree that Lisp conceptually is really close.
It's syntaxlessnes makes it at least in this case more gabby.
jim burton
2007.dec...@justmail.de> wrote:
> jim burton schrieb:
[...]
>
> You can solve it exactly like this in Lisp.
> The Lisp code will have more lines if we write it in typical Lisp style.
Hi André, that's an interesting comparison. I certainly agree that the
c.l. versions (which avoid loop etc) are conceptually very close. I
wasn't making any particular point about compactness by posting a one
line version, it's just that I happen to think a point-free higher
order style makes readable and elegant code. This can sometimes tip
over into idioms that are obscure to me (at the moment) however. This
version is pointsfree in the function passed to the fold:
powerset = foldr (ap (++) . map . (:)) [[]]
which relies on Monad.ap and the fact that List is a Monad. That's on
the right side of power and expressivity vs. being too abstract, while
this version, being discussed on haskell-cafe I think, makes my head
hurt:
powerset = filterM (const [True, False])
Alan Crowe
> I
> wasn't making any particular point about compactness by posting a one
> line version, it's just that I happen to think a point-free higher
> order style makes readable and elegant code. This can sometimes tip
> over into idioms that are obscure to me (at the moment) however. This
> version is pointsfree in the function passed to the fold:
>
> powerset = foldr (ap (++) . map . (:)) [[]]
>
> which relies on Monad.ap and the fact that List is a Monad. That's on
> the right side of power and expressivity vs. being too abstract, while
> this version, being discussed on haskell-cafe I think, makes my head
> hurt:
>
> powerset = filterM (const [True, False])
>
This code is also being discussed on Reddit and it set me
thinking about trying to write code that brings out the
underlying concepts. After a little noodling at the REPL,
sauce be upon it, I came up with:
#| Start from a generalisation of the cartesian product of two sets, so that
f, {a,b}, {x,y} => {f(a,x), f(a,y), f(b,x), f(b,y)} |#
(defun product-set (f)
(lambda (u v)
(let (w)
(dolist (x u w)
(dolist (y v)
(push (funcall f x y) w))))))
#| I think this function has a clear theme
(funcall (product-set #'*) '(1 2 3) '(5 7))
=> (21 15 14 10 7 5)
|#
;;; Minor utility function, turns an item into a set
;;; with two elements, the singleton set and the empty set
;;; (in-and-out 3) => ((3) NIL)
(defun in-and-out (x)
"x => ({x} {})"
(list (list x) nil))
;;; Now we can define power-set and cartesian-product as folds
;;; that is, we use REDUCE to raise a suitably chosen product-set function
;;; from binary to n-ary
;;; (power-set '(1 2 3)) => ((2 1) (2 1 3) (1) (1 3) (2) (2 3) NIL (3))
(defun power-set (set)
(reduce (product-set #'union)
(mapcar #'in-and-out set)))
;;; (cartesian-product '(0) '(1 2) '(3 4 5))
;;; => ((0 1 5) (0 1 4) (0 1 3) (0 2 5) (0 2 4) (0 2 3))
(defun cartesian-product (&rest sets)
(reduce (product-set #'cons)
sets
:from-end t
:initial-value (list nil)))
I think this brings new obscurity to the darkness.
Alan Crowe
Edinburgh
Scotland
Damien Kick
> There was an interesting discussion in de.comp.lang.java how to implement a
>
> Another version in Prolog:
>
> combination([], []).
> combination([H|T], P) :- combination(T,P).
> combination([H|T], [H|P]) :- combination(T,P).
>
> Usage:
>
> ?- combination([1,2,3], R).
>
> R=[]
> R=[3]
> R=[2]
> R=[2,3]
>
> I don't post the more than 30 lines Java solutions now. How would it look
(require :prolog)
(<-- (combination () ()))
(<- (combination (?h . ?t) ?p) (combination ?t ?p))
(<- (combination (?h . ?t) (?h . ?p)) (combination ?t ?p))
Sorry, I'm just having too much fun with the programmable programming
language. I wonder if Kenny will post a Cells version.
Frank Buss
> That's on
> the right side of power and expressivity vs. being too abstract, while
> this version, being discussed on haskell-cafe I think, makes my head
> hurt:
>
> powerset = filterM (const [True, False])
I understood most of the Lisp solutions given in this thread without
problems, maybe because Lisp has the advantage that there is nearly no
syntax and things like operator overloading, you write what you mean and
you can read what you mean, without too much implicit knowledge. In
contrast to this is Haskell, which provides many syntatic sugar for things
like monads, currying etc. To understand this, it can help to translate it
to Lisp again.
I've found an explanation for Haskell programmers at this page:
http://community.livejournal.com/evan_tech/220036.html
First "const [True, False]" is a fancy syntax for "\_ -> [True, False]",
which is "(lambda () (list t nil))" in Lisp. filterM has two arguments: a
function and a monad. The function is applied to the argument to produce a
new monad. The second argument is omitted, which is called currying and
means the same like "powerset m = filterM (const [True, False]) m". To
understand how it works, first a little introduction to monads (this is
inspired by the monad scheme implementation at
http://groups.google.com/group/comp.lang.functional/msg/2fde5545c6657c81 ).
According to http://en.wikipedia.org/wiki/Monads_in_functional_programming
a monad has the following components:
1. A type construction
2. A unit function that maps a value in an underlying type to a value in
the corresponding monadic type
3. A binding operation, which applies the mapped type to a function and
which returns a new monad of the same type
Lets see how the "maybe" monad could look like in Common Lisp:
1. A type construction:
(defclass maybe () ())
(defclass just (maybe)
((wrapped-object :accessor wrapped-object :initarg :wrapped-object)))
(defclass nothing (maybe) ())
2. A unit function:
(defgeneric unit (object)
(:method ((maybe maybe)) maybe)
(:method ((simple-object t))
(make-instance 'just :wrapped-object simple-object)))
3. A binding operation:
(defgeneric bind (object fun)
(:method ((object just) fun) (funcall fun (wrapped-object object)))
(:method ((object nothing) fun) object))
Every monad must obey the following 3 axioms:
axiom 1. "bind" left-identity:
(bind (unit wrapped-type) fun) == (funcall fun wrapped-type)
axiom 2. "bind" right-identity:
(bind monad unit) == monad
axiom 3. "bind" associativity:
(bind (bind monad fun1) fun2) ==
(bind monad (lambda (x) (bind (funcall fun1 x) fun2)))
A formal proof would be nice for my monad definition, but I'm just an
application programmer, so lets try it with an example. First some methods
for nicer displaying the results:
(defmethod print-object ((object just) stream)
(format stream "just: ~a" (wrapped-object object)))
(defmethod print-object ((object nothing) stream)
(declare (ignore object))
(format stream "nothing"))
For testing the axioms, we need some useful functions, which takes a simple
type and returns a monad:
(defun maybe-identity (wrapped-object)
(make-instance 'just :wrapped-object wrapped-object))
(defun maybe-1/ (wrapped-object)
(make-instance 'just :wrapped-object (/ wrapped-object)))
Now testing the axioms:
axiom 1:
CL-USER > (defparameter *foo* 42)
*FOO*
CL-USER > (bind (unit *foo*) #'maybe-identity)
just: 42
CL-USER > (maybe-identity *foo*)
just: 42
axiom 2:
CL-USER > (defparameter *m* (make-instance 'just :wrapped-object 3))
*M*
CL-USER > (bind *m* #'unit)
just: 3
CL-USER > *m*
just: 3
axiom 3:
CL-USER > (bind (bind *m* #'maybe-identity) #'maybe-1/)
just: 1/3
CL-USER > (bind *m* (lambda (x) (bind (maybe-identity x) #'maybe-1/)))
just: 1/3
Ok, now that we have proved that the maybe-monad is a monad, we can do
something useful with it:
(defmethod safe-/ ((x maybe) (y maybe))
(bind x (lambda (a)
(bind y (lambda (b)
(if (zerop b)
(make-instance 'nothing)
(make-instance 'just
:wrapped-object (/ a b))))))))
CL-USER > (defparameter *a* (make-instance 'just :wrapped-object 3))
*A*
CL-USER > (defparameter *b* (make-instance 'just :wrapped-object 2))
*B*
CL-USER > (defparameter *c* (make-instance 'just :wrapped-object 0))
*C*
CL-USER > (safe-/ *a* *b*)
just: 3/2
CL-USER > (safe-/ *a* *c*)
nothing
You can nest this, too. If one object is "nothing", the whole result is
nothing. The order doesn't matter:
CL-USER > (safe-/ (safe-/ *a* *c*) *b*)
nothing
Now the interesting thing. filterM is implemented in Haskell like this:
filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
filterM _ [] = return []
filterM p (x:xs) = do
flg <- p x
ys <- filterM p xs
return (if flg then x:ys else ys)
The trick is that there are monads defined for lists in Haskell. This can
be implemented in Lisp like this (todo: list-bind should be overloaded,
which should be possible, but the bind-operator, which is simple #'list in
this example, would be difficult) :
(defun concat (list)
(when list (append (car list) (concat (cdr list)))))
(defun list-bind (list fun)
(concat (mapcar fun list)))
(defun filter-monad (predicate list)
(if (null list)
(list ())
(let ((x (first list))
(xs (rest list)))
(list-bind (funcall predicate x)
(lambda (flag)
(list-bind (filter-monad predicate xs)
(lambda (ys)
(list (if flag
(cons x ys)
ys)))))))))
Maybe some macros could help to simplify the syntax, but this is what the
Haskell implementation does. It can be used like this:
CL-USER > (filter-monad (lambda (x) (list t nil)) '(1 2 3))
((1 2 3) (1 2) (1 3) (1) (2 3) (2) (3) NIL)