@@ -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 basis/compiler/cfg/builder/builder-tests.factor @@ -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 ; \ No newline at end of file + ] unless-empty ; basis/compiler/cfg/gc-checks/gc-checks.factor @@ -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 ; basis/fry/fry.factor @@ -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 \ No newline at end of file +[ 25997 ] [ 299999 sieve [ bit-count ] map-sum 2 + ] unit-test basis/math/primes/erato/erato-tests.factor @@ -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 ; basis/math/statistics/statistics.factor @@ -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 basis/pack/pack.factor @@ -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 basis/roman/roman.factor @@ -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 ; basis/tools/profiler/profiler.factor @@ -40,7 +40,7 @@ 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 ; @@ -82,4 +82,4 @@ M: paragraph baseline M: paragraph cap-height pack-cap-height ; -PRIVATE> \ No newline at end of file +PRIVATE> basis/ui/gadgets/paragraphs/paragraphs.factor @@ -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 ) [ core/classes/tuple/tuple.factor @@ -975,13 +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 - "! Find the sum of the squares [0,99]" "USING: math math.ranges sequences prettyprint ;" - "100 [1,b] [ sq ] sigma ." + "100 [1,b] [ sq ] map-sum ." "338350" } ; core/sequences/sequences-docs.factor @@ -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 core/sequences/sequences-tests.factor @@ -934,10 +934,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 core/sequences/sequences.factor @@ -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 } extra/benchmark/backtrack/backtrack.factor @@ -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 ; extra/benchmark/e-ratios/e-ratios.factor @@ -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 extra/benchmark/tuple-arrays/tuple-arrays.factor @@ -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) extra/project-euler/021/021.factor @@ -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> extra/project-euler/028/028.factor @@ -33,7 +33,7 @@ IN: project-euler.030 <PRIVATE : sum-fifth-powers ( n -- sum ) - number>digits [ 5 ^ ] sigma ; + number>digits [ 5 ^ ] map-sum ; PRIVATE> extra/project-euler/030/030.factor @@ -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> extra/project-euler/034/034.factor @@ -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) extra/project-euler/043/043.factor @@ -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 extra/project-euler/048/048.factor @@ -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) extra/project-euler/053/053.factor @@ -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) extra/project-euler/063/063.factor @@ -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) extra/project-euler/072/072.factor @@ -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> extra/project-euler/074/074.factor @@ -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 ; extra/project-euler/092/092.factor @@ -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> extra/project-euler/116/116.factor @@ -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) extra/project-euler/190/190.factor @@ -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 ; extra/project-euler/common/common.factor @@ -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 misc/vim/syntax/factor.vim @@ -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 ; unmaintained/graph-theory/graph-theory.factor 90325f3972e7ed96ffcd3b113f3219e5b509995a Doug Coleman doug.coleman@gmail.com http://github.com/slavapestov/factor/commit/1ee8c8f5eb05bc9be177d2a45079f47cd5a814ac 1ee8c8f5eb05bc9be177d2a45079f47cd5a814ac 2009-10-29T12:34:04-07:00 2009-10-29T12:34:04-07:00 sigma -> map-sum f894fb8ef8dad83b5ec0e6df546e7427a852531d Doug Coleman doug.coleman@gmail.com