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

Summary:
Author:
Mode:
Body: