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 ;