From Newsgroup: comp.lang.scheme
B. Pym wrote:
B. Pym wrote:
John Gilson wrote:
(defun power-set (set)
(let ((power-set (list ()))) ; power set always contains empty set
(labels
((insert (subset)
(loop for elt in set
until (eql elt (first subset))
collect (cons elt subset)))
(power-set-length-n (length-m-sets)
(mapcan #'(lambda (length-m-set)
(insert length-m-set))
length-m-sets))
(power-set-aux (length-m-sets)
;; n = m + 1
(unless (null length-m-sets)
(let ((length-n-sets (power-set-length-n length-m-sets)))
(setf power-set (append length-n-sets power-set))
(power-set-aux length-n-sets)))))
(power-set-aux power-set))
power-set))
(power-set '(1 2 3))
((1 2 3) (1 2) (1 3) (2 3) (1) (2) (3) NIL)
Scheme
;; Adapted from a CL version.
(define (powerset List)
(if (null? List)
'(())
(let* ((x (car List))
(p (powerset (cdr List))))
(append p
(map (lambda(xs) (cons x xs)) p)))))
(powerset '(a b c))
===>
(() (c) (b) (b c) (a) (a c) (a b) (a b c))
(powerset '(a b c d))
===>
(() (d) (c) (c d) (b) (b d) (b c) (b c d) (a) (a d) (a c) (a c d)
(a b) (a b d) (a b c) (a b c d))
Gauche Scheme
(use util.match)
(define powerset
(match-lambda
[() '(())]
[(h . t) (let1 p (powerset t) `(,@p ,@(map. cons h p)))]))
Given:
(define (map. func obj seq)
(map (lambda(x) (func obj x)) seq))
Another way:
(use util.combinations)
(define (powerset L)
(append-map (^n (combinations L n)) (iota (+ 1 (length L)))))
Andre Thieme wrote:
Or see this Haskell function:
powerset = foldr (\x ys -> ys ++ (map (x:) ys)) [[]]
In Lisp we can do exactly the same one liner. Here it is (also in one
line, in some sense):
(defun powerset (set)
(reduce (lambda (x ys)
(append ys (mapcar (lambda (y)
(cons x y))
ys)))
set
:initial-value '(())
:from-end t))
There's obviously no need for ":from-end t";
in Scheme, there's no need for "fold-right" instead
of "fold". We're dealing with sets. The order of
the items doesn't matter.
(defun powerset (set)
(reduce
(lambda (ys x) (append ys (mapcar (lambda (y) (cons x y)) ys)))
set
:initial-value '(())))
* (powerset '(a b c))
(NIL (A) (B) (B A) (C) (C A) (C B) (C B A))
Gauche Scheme
(define (powerset set)
(fold. x ys (++ ys (map. cons x ys)) '(()) set))
Given:
(define ++ append)
(define (map. func obj seq)
(map (lambda(x) (func obj x)) seq))
(define-syntax fold.
(syntax-rules ()
[(_ x accum expr init List)
(fold (lambda(x accum) expr) init List)]))
--- Synchronet 3.21a-Linux NewsLink 1.2