Merge branch 'master' of git://factorcode.org/git/factor
						commit
						1cf45abf06
					
				| 
						 | 
				
			
			@ -162,7 +162,7 @@ IN: compiler.cfg.builder.tests
 | 
			
		|||
 | 
			
		||||
: count-insns ( quot insn-check -- ? )
 | 
			
		||||
    [ test-mr [ instructions>> ] map ] dip
 | 
			
		||||
    '[ _ count ] sigma ; inline
 | 
			
		||||
    '[ _ count ] map-sum ; inline
 | 
			
		||||
 | 
			
		||||
: contains-insn? ( quot insn-check -- ? )
 | 
			
		||||
    count-insns 0 > ; inline
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -26,7 +26,7 @@ M: ##box-alien allocation-size* drop 4 cells ;
 | 
			
		|||
M: ##box-displaced-alien allocation-size* drop 4 cells ;
 | 
			
		||||
 | 
			
		||||
: allocation-size ( bb -- n )
 | 
			
		||||
    instructions>> [ ##allocation? ] filter [ allocation-size* ] sigma ;
 | 
			
		||||
    instructions>> [ ##allocation? ] filter [ allocation-size* ] map-sum ;
 | 
			
		||||
 | 
			
		||||
: insert-gc-check ( bb -- )
 | 
			
		||||
    dup dup '[
 | 
			
		||||
| 
						 | 
				
			
			@ -44,4 +44,4 @@ M: ##box-displaced-alien allocation-size* drop 4 cells ;
 | 
			
		|||
    dup blocks-with-gc [
 | 
			
		||||
        over compute-uninitialized-sets
 | 
			
		||||
        [ insert-gc-check ] each
 | 
			
		||||
    ] unless-empty ;
 | 
			
		||||
    ] unless-empty ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -32,7 +32,7 @@ PREDICATE: fry-specifier < word { _ @ } member-eq? ;
 | 
			
		|||
 | 
			
		||||
GENERIC: count-inputs ( quot -- n )
 | 
			
		||||
 | 
			
		||||
M: callable count-inputs [ count-inputs ] sigma ;
 | 
			
		||||
M: callable count-inputs [ count-inputs ] map-sum ;
 | 
			
		||||
M: fry-specifier count-inputs drop 1 ;
 | 
			
		||||
M: object count-inputs drop 0 ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -7,4 +7,4 @@ USING: byte-arrays math math.bitwise math.primes.erato sequences tools.test ;
 | 
			
		|||
[ t ] [ 113 100 sieve marked-prime? ] unit-test
 | 
			
		||||
 | 
			
		||||
! There are 25997 primes below 300000. 1 must be removed and 3 5 7 added.
 | 
			
		||||
[ 25997 ] [ 299999 sieve [ bit-count ] sigma 2 + ] unit-test
 | 
			
		||||
[ 25997 ] [ 299999 sieve [ bit-count ] map-sum 2 + ] unit-test
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -12,7 +12,7 @@ IN: math.statistics
 | 
			
		|||
    [ length ] [ product ] bi nth-root ;
 | 
			
		||||
 | 
			
		||||
: harmonic-mean ( seq -- x )
 | 
			
		||||
    [ recip ] sigma recip ;
 | 
			
		||||
    [ recip ] map-sum recip ;
 | 
			
		||||
 | 
			
		||||
:: kth-smallest ( seq k -- elt )
 | 
			
		||||
    #! Wirth's method, Algorithm's + Data structues = Programs p. 84
 | 
			
		||||
| 
						 | 
				
			
			@ -75,7 +75,7 @@ IN: math.statistics
 | 
			
		|||
    dup length 1 <= [
 | 
			
		||||
        drop 0
 | 
			
		||||
    ] [
 | 
			
		||||
        [ [ mean ] keep [ - sq ] with sigma ]
 | 
			
		||||
        [ [ mean ] keep [ - sq ] with map-sum ]
 | 
			
		||||
        [ length 1 - ] bi /
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -97,7 +97,7 @@ MACRO: pack ( str -- quot )
 | 
			
		|||
    packed-length-table at ; inline
 | 
			
		||||
 | 
			
		||||
: packed-length ( str -- n )
 | 
			
		||||
    [ ch>packed-length ] sigma ;
 | 
			
		||||
    [ ch>packed-length ] map-sum ;
 | 
			
		||||
 
 | 
			
		||||
: pack-native ( seq str -- seq )
 | 
			
		||||
    '[ _ _ pack ] with-native-endian ; inline
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -43,7 +43,7 @@ PRIVATE>
 | 
			
		|||
: >ROMAN ( n -- str ) >roman >upper ;
 | 
			
		||||
 | 
			
		||||
: roman> ( str -- n )
 | 
			
		||||
    >lower [ roman>= ] monotonic-split [ (roman>) ] sigma ;
 | 
			
		||||
    >lower [ roman>= ] monotonic-split [ (roman>) ] map-sum ;
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -19,7 +19,7 @@ IN: tools.profiler
 | 
			
		|||
    [ dup counter>> ] map-counters ;
 | 
			
		||||
 | 
			
		||||
: cumulative-counters ( obj quot -- alist )
 | 
			
		||||
    '[ dup @ [ counter>> ] sigma ] map-counters ; inline
 | 
			
		||||
    '[ dup @ [ counter>> ] map-sum ] map-counters ; inline
 | 
			
		||||
 | 
			
		||||
: vocab-counters ( -- alist )
 | 
			
		||||
    vocabs [ words [ predicate? not ] filter ] cumulative-counters ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -40,13 +40,13 @@ TUPLE: line words height ;
 | 
			
		|||
    dup wrap-words [ <line> ] map ;
 | 
			
		||||
 | 
			
		||||
: line-width ( wrapped-line -- n )
 | 
			
		||||
    [ break?>> ] trim-tail-slice [ width>> ] sigma ;
 | 
			
		||||
    [ break?>> ] trim-tail-slice [ width>> ] map-sum ;
 | 
			
		||||
 | 
			
		||||
: max-line-width ( wrapped-paragraph -- x )
 | 
			
		||||
    [ words>> line-width ] [ max ] map-reduce ;
 | 
			
		||||
 | 
			
		||||
: sum-line-heights ( wrapped-paragraph -- y )
 | 
			
		||||
    [ height>> ] sigma ;
 | 
			
		||||
    [ height>> ] map-sum ;
 | 
			
		||||
 | 
			
		||||
M: paragraph pref-dim*
 | 
			
		||||
    wrap-paragraph [ max-line-width ] [ sum-line-heights ] bi 2array ;
 | 
			
		||||
| 
						 | 
				
			
			@ -82,4 +82,4 @@ M: paragraph baseline
 | 
			
		|||
 | 
			
		||||
M: paragraph cap-height pack-cap-height ;
 | 
			
		||||
    
 | 
			
		||||
PRIVATE>
 | 
			
		||||
PRIVATE>
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -118,7 +118,7 @@ ERROR: bad-superclass class ;
 | 
			
		|||
    } case define-predicate ;
 | 
			
		||||
 | 
			
		||||
: class-size ( class -- n )
 | 
			
		||||
    superclasses [ "slots" word-prop length ] sigma ;
 | 
			
		||||
    superclasses [ "slots" word-prop length ] map-sum ;
 | 
			
		||||
 | 
			
		||||
: (instance-check-quot) ( class -- quot )
 | 
			
		||||
    [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -975,12 +975,12 @@ HELP: produce-as
 | 
			
		|||
{ $description "Calls " { $snippet "pred" } " repeatedly. If the predicate yields " { $link f } ", stops, otherwise, calls " { $snippet "quot" } " to yield a value. Values are accumulated and returned in a sequence of type " { $snippet "exemplar" } " at the end." }
 | 
			
		||||
{ $examples "See " { $link produce } " for examples." } ;
 | 
			
		||||
 | 
			
		||||
HELP: sigma
 | 
			
		||||
HELP: map-sum
 | 
			
		||||
{ $values { "seq" sequence } { "quot" quotation } { "n" number } }
 | 
			
		||||
{ $description "Like map sum, but without creating an intermediate sequence." }
 | 
			
		||||
{ $example
 | 
			
		||||
    "USING: math math.ranges sequences prettyprint ;"
 | 
			
		||||
    "100 [1,b] [ sq ] sigma ."
 | 
			
		||||
    "100 [1,b] [ sq ] map-sum ."
 | 
			
		||||
    "338350"
 | 
			
		||||
} ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -243,7 +243,7 @@ unit-test
 | 
			
		|||
[ "asdf " ] [ " asdf " [ CHAR: \s = ] trim-head ] unit-test
 | 
			
		||||
[ " asdf" ] [ " asdf " [ CHAR: \s = ] trim-tail ] unit-test
 | 
			
		||||
 | 
			
		||||
[ 328350 ] [ 100 [ sq ] sigma ] unit-test
 | 
			
		||||
[ 328350 ] [ 100 [ sq ] map-sum ] unit-test
 | 
			
		||||
 | 
			
		||||
[ 50 ] [ 100 [ even? ] count ] unit-test
 | 
			
		||||
[ 50 ] [ 100 [ odd?  ] count ] unit-test
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -932,10 +932,10 @@ PRIVATE>
 | 
			
		|||
 | 
			
		||||
: supremum ( seq -- n ) [ ] [ max ] map-reduce ;
 | 
			
		||||
 | 
			
		||||
: sigma ( seq quot -- n )
 | 
			
		||||
: map-sum ( seq quot -- n )
 | 
			
		||||
    [ 0 ] 2dip [ dip + ] curry [ swap ] prepose each ; inline
 | 
			
		||||
 | 
			
		||||
: count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; inline
 | 
			
		||||
: count ( seq quot -- n ) [ 1 0 ? ] compose map-sum ; inline
 | 
			
		||||
 | 
			
		||||
! We hand-optimize flip to such a degree because type hints
 | 
			
		||||
! cannot express that an array is an array of arrays yet, and
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -38,9 +38,9 @@ MEMO: 24-from-4 ( a b c d -- ? )
 | 
			
		|||
                1 10 [a,b] [| d |
 | 
			
		||||
                    a b c d 24-from-4
 | 
			
		||||
                ] count
 | 
			
		||||
            ] sigma
 | 
			
		||||
        ] sigma
 | 
			
		||||
    ] sigma ;
 | 
			
		||||
            ] map-sum
 | 
			
		||||
        ] map-sum
 | 
			
		||||
    ] map-sum ;
 | 
			
		||||
 | 
			
		||||
CONSTANT: words { 24-from-1 24-from-2 24-from-3 24-from-4 }
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -4,7 +4,7 @@ USING: kernel math math.combinatorics math.ranges sequences ;
 | 
			
		|||
IN: benchmark.e-ratios
 | 
			
		||||
 | 
			
		||||
: calculate-e-ratios ( n -- e )
 | 
			
		||||
    iota [ factorial recip ] sigma ;
 | 
			
		||||
    iota [ factorial recip ] map-sum ;
 | 
			
		||||
 | 
			
		||||
: calculate-e-ratios-benchmark ( -- )
 | 
			
		||||
    5 [ 300 calculate-e-ratios drop ] times ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -14,7 +14,7 @@ TUPLE-ARRAY: point
 | 
			
		|||
            [ 1 + ] change-x
 | 
			
		||||
            [ 1 - ] change-y
 | 
			
		||||
            [ 1 + 2 / ] change-z
 | 
			
		||||
        ] map [ z>> ] sigma
 | 
			
		||||
    ] sigma . ;
 | 
			
		||||
        ] map [ z>> ] map-sum
 | 
			
		||||
    ] map-sum . ;
 | 
			
		||||
 | 
			
		||||
MAIN: tuple-array-benchmark
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -18,7 +18,7 @@ PRIVATE>
 | 
			
		|||
 | 
			
		||||
:: passwd-md5 ( magic salt password -- bytes )
 | 
			
		||||
    password magic salt 3append
 | 
			
		||||
    salt password tuck 3append md5 checksum-bytes
 | 
			
		||||
    salt password dup surround md5 checksum-bytes
 | 
			
		||||
    password length
 | 
			
		||||
    [ 16 / ceiling swap <repetition> concat ] keep
 | 
			
		||||
    head-slice append
 | 
			
		||||
| 
						 | 
				
			
			@ -42,7 +42,7 @@ PRIVATE>
 | 
			
		|||
    11 final nth 2 to64 3append ;
 | 
			
		||||
        
 | 
			
		||||
: parse-shadow-password ( string -- magic salt password )
 | 
			
		||||
    "$" split harvest first3 [ "$" tuck 3append ] 2dip ;
 | 
			
		||||
    "$" split harvest first3 [ "$" dup surround ] 2dip ;
 | 
			
		||||
    
 | 
			
		||||
: authenticate-password ( shadow password -- ? )
 | 
			
		||||
    '[ parse-shadow-password drop _ passwd-md5 ] keep = ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -30,7 +30,7 @@ IN: project-euler.021
 | 
			
		|||
    { [ = not ] [ sum-proper-divisors = ] } 2&& ;
 | 
			
		||||
 | 
			
		||||
: euler021 ( -- answer )
 | 
			
		||||
    10000 [1,b] [ dup amicable? [ drop 0 ] unless ] sigma ;
 | 
			
		||||
    10000 [1,b] [ dup amicable? [ drop 0 ] unless ] map-sum ;
 | 
			
		||||
 | 
			
		||||
! [ euler021 ] 100 ave-time
 | 
			
		||||
! 335 ms ave run time - 18.63 SD (100 trials)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -33,7 +33,7 @@ IN: project-euler.028
 | 
			
		|||
    dup 1 = [ [ sq 4 * ] [ 6 * ] bi - 6 + ] unless ;
 | 
			
		||||
 | 
			
		||||
: sum-diags ( n -- sum )
 | 
			
		||||
    1 swap 2 <range> [ sum-corners ] sigma ;
 | 
			
		||||
    1 swap 2 <range> [ sum-corners ] map-sum ;
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -33,7 +33,7 @@ IN: project-euler.030
 | 
			
		|||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: sum-fifth-powers ( n -- sum )
 | 
			
		||||
    number>digits [ 5 ^ ] sigma ;
 | 
			
		||||
    number>digits [ 5 ^ ] map-sum ;
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -34,7 +34,7 @@ IN: project-euler.034
 | 
			
		|||
    { 1 1 2 6 24 120 720 5040 40320 362880 } nth ;
 | 
			
		||||
 | 
			
		||||
: factorion? ( n -- ? )
 | 
			
		||||
    dup number>digits [ digit-factorial ] sigma = ;
 | 
			
		||||
    dup number>digits [ digit-factorial ] map-sum = ;
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -92,7 +92,7 @@ PRIVATE>
 | 
			
		|||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: euler043a ( -- answer )
 | 
			
		||||
    interesting-pandigitals [ 10 digits>integer ] sigma ;
 | 
			
		||||
    interesting-pandigitals [ 10 digits>integer ] map-sum ;
 | 
			
		||||
 | 
			
		||||
! [ euler043a ] 100 ave-time
 | 
			
		||||
! 10 ms ave run time - 1.37 SD (100 trials)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -18,7 +18,7 @@ IN: project-euler.048
 | 
			
		|||
! --------
 | 
			
		||||
 | 
			
		||||
: euler048 ( -- answer )
 | 
			
		||||
    1000 [1,b] [ dup ^ ] sigma 10 10^ mod ;
 | 
			
		||||
    1000 [1,b] [ dup ^ ] map-sum 10 10^ mod ;
 | 
			
		||||
 | 
			
		||||
! [ euler048 ] 100 ave-time
 | 
			
		||||
! 276 ms run / 1 ms GC ave time - 100 trials
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -27,7 +27,7 @@ IN: project-euler.053
 | 
			
		|||
! --------
 | 
			
		||||
 | 
			
		||||
: euler053 ( -- answer )
 | 
			
		||||
    23 100 [a,b] [ dup [ nCk 1000000 > ] with count ] sigma ;
 | 
			
		||||
    23 100 [a,b] [ dup [ nCk 1000000 > ] with count ] map-sum ;
 | 
			
		||||
 | 
			
		||||
! [ euler053 ] 100 ave-time
 | 
			
		||||
! 52 ms ave run time - 4.44 SD (100 trials)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -29,7 +29,7 @@ IN: project-euler.063
 | 
			
		|||
! Round down since we already know that particular value of n is no good.
 | 
			
		||||
 | 
			
		||||
: euler063 ( -- answer )
 | 
			
		||||
    9 [1,b] [ log [ 10 log dup ] dip - /i ] sigma ;
 | 
			
		||||
    9 [1,b] [ log [ 10 log dup ] dip - /i ] map-sum ;
 | 
			
		||||
 | 
			
		||||
! [ euler063 ] 100 ave-time
 | 
			
		||||
! 0 ms ave run time - 0.0 SD (100 trials)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -30,7 +30,7 @@ IN: project-euler.072
 | 
			
		|||
! The answer can be found by adding totient(n) for 2 ≤ n ≤ 1e6
 | 
			
		||||
 | 
			
		||||
: euler072 ( -- answer )
 | 
			
		||||
    2 1000000 [a,b] [ totient ] sigma ;
 | 
			
		||||
    2 1000000 [a,b] [ totient ] map-sum ;
 | 
			
		||||
 | 
			
		||||
! [ euler072 ] 100 ave-time
 | 
			
		||||
! 5274 ms ave run time - 102.7 SD (100 trials)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -48,7 +48,7 @@ IN: project-euler.074
 | 
			
		|||
    { 1 1 2 6 24 120 720 5040 40320 362880 } nth ;
 | 
			
		||||
 | 
			
		||||
: digits-factorial-sum ( n -- n )
 | 
			
		||||
    number>digits [ digit-factorial ] sigma ;
 | 
			
		||||
    number>digits [ digit-factorial ] map-sum ;
 | 
			
		||||
 | 
			
		||||
: chain-length ( n -- n )
 | 
			
		||||
    61 <hashtable>
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -29,7 +29,7 @@ IN: project-euler.092
 | 
			
		|||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: next-link ( n -- m )
 | 
			
		||||
    number>digits [ sq ] sigma ;
 | 
			
		||||
    number>digits [ sq ] map-sum ;
 | 
			
		||||
 | 
			
		||||
: chain-ending ( n -- m )
 | 
			
		||||
    dup [ 1 = ] [ 89 = ] bi or [ next-link chain-ending ] unless ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -47,7 +47,7 @@ IN: project-euler.116
 | 
			
		|||
    V{ 1 } clone [ [ next ] 2curry times ] keep last 1 - ;
 | 
			
		||||
 | 
			
		||||
: (euler116) ( length -- permutations )
 | 
			
		||||
    3 [1,b] [ ways ] with sigma ;
 | 
			
		||||
    3 [1,b] [ ways ] with map-sum ;
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -46,7 +46,7 @@ PRIVATE>
 | 
			
		|||
    m [1,b] [| i | 2 i * m 1 + / i ^ ] PI ;
 | 
			
		||||
 | 
			
		||||
: euler190 ( -- answer )
 | 
			
		||||
    2 15 [a,b] [ P_m truncate ] sigma ;
 | 
			
		||||
    2 15 [a,b] [ P_m truncate ] map-sum ;
 | 
			
		||||
 | 
			
		||||
! [ euler150 ] 100 ave-time
 | 
			
		||||
! 5 ms ave run time - 1.01 SD (100 trials)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -57,7 +57,7 @@ IN: project-euler.common
 | 
			
		|||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: alpha-value ( str -- n )
 | 
			
		||||
    >lower [ CHAR: a - 1 + ] sigma ;
 | 
			
		||||
    >lower [ CHAR: a - 1 + ] map-sum ;
 | 
			
		||||
 | 
			
		||||
: cartesian-product ( seq1 seq2 -- seq1xseq2 )
 | 
			
		||||
    [ [ 2array ] with map ] curry map concat ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -53,7 +53,7 @@ syn keyword factorKeyword or tuck 2bi 2tri while wrapper nip 4dip wrapper? bi* c
 | 
			
		|||
syn keyword factorKeyword ?at assoc? assoc-clone-like assoc= delete-at* assoc-partition extract-keys new-assoc value? assoc-size map>assoc push-at assoc-like key? assoc-intersect assoc-refine update assoc-union assoc-combine at* assoc-empty? at+ set-at assoc-all? assoc-subset? assoc-hashcode change-at assoc-each assoc-diff zip values value-at rename-at inc-at enum? at cache assoc>map <enum> assoc assoc-map enum value-at* assoc-map-as >alist assoc-filter-as clear-assoc assoc-stack maybe-set-at substitute assoc-filter 2cache delete-at assoc-find keys assoc-any? unzip
 | 
			
		||||
syn keyword factorKeyword case execute-effect no-cond no-case? 3cleave>quot 2cleave cond>quot wrong-values? no-cond? cleave>quot no-case case>quot 3cleave wrong-values to-fixed-point alist>quot case-find cond cleave call-effect 2cleave>quot recursive-hashcode linear-case-quot spread spread>quot
 | 
			
		||||
syn keyword factorKeyword byte-array>bignum sgn >bignum next-float number= each-integer next-power-of-2 ?1+ fp-special? imaginary-part mod recip float>bits rational >float number? 2^ bignum? integer fixnum? neg fixnum sq bignum fp-snan? fp-infinity? denominator (all-integers?) times find-last-integer (each-integer) bit? * + fp-bitwise= - fp-qnan? / power-of-2? >= bitand find-integer complex <fp-nan> < log2 > integer? real number bits>double double>bits bitor 2/ zero? rem fp-nan-payload all-integers? (find-integer) real-part prev-float align bits>float float? shift float fp-nan? abs bitxor ratio? even? <= /mod odd? >integer ratio rational? bitnot real? >fixnum complex? /i numerator /f
 | 
			
		||||
syn keyword factorKeyword append assert-sequence= find-last-from trim-head-slice clone-like 3sequence assert-sequence? map-as filter! last-index-from reversed index-from cut* pad-tail (indices) concat-as remove-eq but-last snip trim-tail nths nth 2pusher sequence slice? <slice> partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length remove-eq! drop-prefix unclip iota unclip-last-slice bounds-error? sequence-hashcode-step map start midpoint@ rest-slice prepend fourth sift delete sigma new-sequence follow like remove-nth! first4 1sequence reverse slice unless-empty padding virtual@ repetition? set-last index 4sequence max-length set-second immutable-sequence first2 first3 replicate-as reduce-index unclip-slice supremum insert-nth trim-tail-slice tail 3append short count suffix concat flip filter sum immutable? 2sequence map-integers delete-all start* indices snip-slice check-slice sequence? head map-find reduce append-as reverse! sequence= halves collapse-slice interleave 2map binary-reduce virtual-seq slice-error? product bounds-check? bounds-check harvest immutable find produce remove pad-head last replicate set-fourth shorten reversed? map-find-last 3map-as 2unclip-slice shorter? 3map find-last head-slice pop* 2map-as tail-slice* but-last-slice 2map-reduce iota? accumulate each pusher cut-slice new-resizable each-index head-slice* 2reverse-each sequence-hashcode member-eq? pop set-nth ?nth <flat-slice> second map! join when-empty accumulator immutable-sequence? <reversed> all? 3append-as virtual-sequence subseq? push-either new-like length last-index push-if 2all? lengthen assert-sequence copy map-reduce move third first 3each tail? set-first prefix bounds-error any? <repetition> trim-slice exchange surround 2reduce cut change-nth min-length set-third produce-as push-all head? delete-slice rest sum-lengths 2each head* infimum glue slice-error subseq replace-slice push repetition map-index trim-head unclip-last mismatch trim
 | 
			
		||||
syn keyword factorKeyword append assert-sequence= find-last-from trim-head-slice clone-like 3sequence assert-sequence? map-as filter! last-index-from reversed index-from cut* pad-tail (indices) concat-as remove-eq but-last snip trim-tail nths nth 2pusher sequence slice? <slice> partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length remove-eq! drop-prefix unclip iota unclip-last-slice bounds-error? sequence-hashcode-step map start midpoint@ rest-slice prepend fourth sift remove! map-sum new-sequence follow like remove-nth! first4 1sequence reverse slice unless-empty padding virtual@ repetition? set-last index 4sequence max-length set-second immutable-sequence first2 first3 replicate-as reduce-index unclip-slice supremum insert-nth trim-tail-slice tail 3append short count suffix concat flip filter sum immutable? 2sequence map-integers delete-all start* indices snip-slice check-slice sequence? head map-find reduce append-as reverse! sequence= halves collapse-slice interleave 2map binary-reduce virtual-seq slice-error? product bounds-check? bounds-check harvest immutable find produce remove pad-head last replicate set-fourth shorten reversed? map-find-last 3map-as 2unclip-slice shorter? 3map find-last head-slice pop* 2map-as tail-slice* but-last-slice 2map-reduce iota? accumulate each pusher cut-slice new-resizable each-index head-slice* 2reverse-each sequence-hashcode member-eq? pop set-nth ?nth <flat-slice> second map! join when-empty accumulator immutable-sequence? <reversed> all? 3append-as virtual-sequence subseq? push-either new-like length last-index push-if 2all? lengthen assert-sequence copy map-reduce move third first 3each tail? set-first prefix bounds-error any? <repetition> trim-slice exchange surround 2reduce cut change-nth min-length set-third produce-as push-all head? delete-slice rest sum-lengths 2each head* infimum glue slice-error subseq replace-slice push repetition map-index trim-head unclip-last mismatch trim
 | 
			
		||||
syn keyword factorKeyword global +@ change set-namestack change-global init-namespaces on off set-global namespace set with-scope bind with-variable inc dec counter initialize namestack get get-global make-assoc
 | 
			
		||||
syn keyword factorKeyword <array> 2array 3array pair >array 1array 4array pair? array resize-array array?
 | 
			
		||||
syn keyword factorKeyword +character+ bad-seek-type? readln stream-seek read print with-output-stream contents write1 stream-write1 stream-copy stream-element-type with-input-stream stream-print stream-read stream-contents bl seek-output bad-seek-type nl stream-nl write flush stream-lines +byte+ stream-flush read1 seek-absolute? stream-read1 lines stream-readln stream-read-until each-line seek-end with-output-stream* seek-absolute with-streams seek-input seek-relative? input-stream stream-write read-partial seek-end? seek-relative error-stream read-until with-input-stream* with-streams* each-block output-stream stream-read-partial
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -34,7 +34,7 @@ M: graph num-vertices
 | 
			
		|||
    vertices length ;
 | 
			
		||||
 | 
			
		||||
M: graph num-edges
 | 
			
		||||
   [ vertices ] [ '[ _ adjlist length ] sigma ] bi ;
 | 
			
		||||
   [ vertices ] [ '[ _ adjlist length ] map-sum ] bi ;
 | 
			
		||||
 | 
			
		||||
M: graph adjlist
 | 
			
		||||
    [ vertices ] [ swapd '[ _ swap _ adj? ] filter ] bi ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue