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