math.combinatorics: improve all-subsets and selections words.
							parent
							
								
									0b7ed3bdb9
								
							
						
					
					
						commit
						f1eb6a9d6e
					
				| 
						 | 
				
			
			@ -78,7 +78,7 @@ IN: math.combinatorics.tests
 | 
			
		|||
 | 
			
		||||
[ { } ] [ { 1 2 } 0 selections ] unit-test
 | 
			
		||||
 | 
			
		||||
[ { { 1 2 } } ] [ { 1 2 } 1 selections ] unit-test
 | 
			
		||||
[ { { 1 } { 2 } } ] [ { 1 2 } 1 selections ] unit-test
 | 
			
		||||
 | 
			
		||||
[ { { 1 1 } { 1 2 } { 2 1 } { 2 2 } } ]
 | 
			
		||||
[ { 1 2 } 2 selections ] unit-test
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,8 +1,10 @@
 | 
			
		|||
! Copyright (c) 2007-2010 Slava Pestov, Doug Coleman, Aaron Schaefer, John Benediktsson.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: accessors assocs binary-search fry kernel locals math math.order
 | 
			
		||||
    math.ranges namespaces sequences sorting make sequences.deep arrays
 | 
			
		||||
    combinators ;
 | 
			
		||||
 | 
			
		||||
USING: accessors arrays assocs binary-search fry kernel locals
 | 
			
		||||
math math.order math.ranges namespaces sequences sequences.deep
 | 
			
		||||
sorting ;
 | 
			
		||||
 | 
			
		||||
IN: math.combinatorics
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
| 
						 | 
				
			
			@ -129,21 +131,14 @@ PRIVATE>
 | 
			
		|||
    [ -rot ] dip each-combination ; inline
 | 
			
		||||
 | 
			
		||||
: all-subsets ( seq -- subsets )
 | 
			
		||||
    dup length [0,b] [
 | 
			
		||||
        [ dupd all-combinations [ , ] each ] each
 | 
			
		||||
    ] { } make nip ;
 | 
			
		||||
    dup length [0,b] [ all-combinations ] with map concat ;
 | 
			
		||||
 | 
			
		||||
: (selections) ( seq n -- selections )
 | 
			
		||||
    dupd [ dup 1 > ] [
 | 
			
		||||
        swap pick cartesian-product [
 | 
			
		||||
            [ [ dup length 1 > [ flatten ] when , ] each ] each
 | 
			
		||||
        ] { } make swap 1 -
 | 
			
		||||
    ] while drop nip ;
 | 
			
		||||
    [ [ 1array ] map dup ] [ 1 - ] bi*
 | 
			
		||||
    [ cartesian-product concat ] with times
 | 
			
		||||
    [ flatten ] map ;
 | 
			
		||||
 | 
			
		||||
: selections ( seq n -- selections )
 | 
			
		||||
    {
 | 
			
		||||
        { 0 [ drop { } ] }
 | 
			
		||||
        { 1 [ 1array ] }
 | 
			
		||||
        [ (selections) ]
 | 
			
		||||
    } case ;
 | 
			
		||||
    dup 0 > [ (selections) ] [ 2drop { } ] if ;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue