Paste: a powerset word
Author: | rks |
Mode: | factor |
Date: | Mon, 27 Dec 2010 20:38:47 |
Plain Text |
USING: kernel arrays sequences combinators combinators.short-circuit
generalizations math ;
IN: mysets
: init-acc ( seq -- seq tuple ) dup { } 2array ;
: clean ( n seq -- seq ) [ dupd length = ] filter nip ;
: prepare ( tuple elt -- acc elt set ) swap first2 -rot dupd remove ;
DEFER: fixed-length-subs
: smaller-subs ( n x x s -- n x x s ss ) 4 npick 1 - dupd fixed-length-subs ;
: construct ( n tuple elt -- n newtuple )
prepare smaller-subs swapd [ over prefix ] map nip swapd append 2array ;
: fixed-length-subs ( set n -- sets )
{
{ [ 2dup { [ nip 0 = ] [ swap length > ] } 2|| ] [ 2drop { { } } ] }
{ [ dup 1 = ] [ drop [ 1array ] map ] }
[ swap init-acc [ construct ] reduce second clean ]
} cond ;
: powerset ( set -- sets )
dup length iota [ dupd fixed-length-subs ] map concat swap suffix ;
New Annotation