diff --git a/basis/compiler/codegen/gc-maps/gc-maps.factor b/basis/compiler/codegen/gc-maps/gc-maps.factor index 1f12b7a13a..474781ea95 100644 --- a/basis/compiler/codegen/gc-maps/gc-maps.factor +++ b/basis/compiler/codegen/gc-maps/gc-maps.factor @@ -46,12 +46,9 @@ SYMBOLS: return-addresses gc-maps ; compiled-offset return-addresses get push ] [ drop ] if ; -: longest ( seqs -- n ) - [ length ] [ max ] map-reduce ; - : emit-scrub ( seqs -- n ) ! seqs is a sequence of sequences of 0/1 - dup longest + dup longest length [ '[ [ 0 = ] ?{ } map-as _ f pad-tail % ] each ] keep ; : integers>bits ( seq n -- bit-array ) diff --git a/basis/stack-checker/branches/branches.factor b/basis/stack-checker/branches/branches.factor index cec851eb76..2ab73b9a13 100644 --- a/basis/stack-checker/branches/branches.factor +++ b/basis/stack-checker/branches/branches.factor @@ -21,7 +21,7 @@ SYMBOLS: +bottom+ +top+ ; ! Terminated branches are padded with bottom values which ! unify with literals. dup empty? [ - dup [ length ] [ max ] map-reduce + dup longest length '[ _ +bottom+ pad-head ] map ] unless ; diff --git a/basis/strings/tables/tables.factor b/basis/strings/tables/tables.factor index 83a1213525..aa914885ef 100644 --- a/basis/strings/tables/tables.factor +++ b/basis/strings/tables/tables.factor @@ -5,14 +5,11 @@ IN: strings.tables diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 4bb2af05cd..cdd88081f7 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -844,6 +844,9 @@ PRIVATE> [ append ] padding ; : shorter? ( seq1 seq2 -- ? ) [ length ] bi@ < ; +: longer? ( seq1 seq2 -- ? ) [ length ] bi@ > ; +: shorter ( seq1 seq2 -- seq ) [ [ length ] bi@ <= ] 2keep ? ; inline +: longer ( seq1 seq2 -- seq ) [ [ length ] bi@ >= ] 2keep ? ; inline : head? ( seq begin -- ? ) 2dup shorter? [ @@ -1013,6 +1016,16 @@ M: object sum 0 [ + ] binary-reduce ; inline : cartesian-product ( seq1 seq2 -- newseq ) [ { } 2sequence ] cartesian-map ; +: filter-length ( seq n -- seq' ) [ swap length = ] curry filter ; + +: shortest ( seqs -- elt ) [ ] [ shorter ] map-reduce ; + +: longest ( seqs -- elt ) [ ] [ longer ] map-reduce ; + +: all-shortest ( seqs -- seqs' ) dup shortest length filter-length ; + +: all-longest ( seqs -- seqs' ) dup longest length filter-length ; + ! We hand-optimize flip to such a degree because type hints ! cannot express that an array is an array of arrays yet, and ! this word happens to be performance-critical since the compiler diff --git a/extra/anagrams/anagrams.factor b/extra/anagrams/anagrams.factor index f5f87af98a..b5374ed965 100644 --- a/extra/anagrams/anagrams.factor +++ b/extra/anagrams/anagrams.factor @@ -2,34 +2,27 @@ ! See http://factorcode.org/license.txt for BSD license USING: arrays ascii assocs fry io.encodings.ascii io.files -kernel math math.order memoize sequences sorting ; - +kernel math math.order memoize sequences sorting +math.statistics ; +FROM: sets => members ; IN: anagrams -: (all-anagrams) ( seq assoc -- ) - '[ dup natural-sort _ push-at ] each ; - -: all-anagrams ( seq -- assoc ) - H{ } clone [ (all-anagrams) ] keep +: make-anagram-hash ( strings -- assoc ) + [ natural-sort ] collect-by + [ members ] assoc-map [ nip length 1 > ] assoc-filter ; MEMO: dict-words ( -- seq ) "/usr/share/dict/words" ascii file-lines [ >lower ] map ; MEMO: dict-anagrams ( -- assoc ) - dict-words all-anagrams ; + dict-words make-anagram-hash ; : anagrams ( str -- seq/f ) >lower natural-sort dict-anagrams at ; -: longest ( seq -- subseq ) - dup 0 [ length max ] reduce '[ length _ = ] filter ; - : most-anagrams ( -- seq ) - dict-anagrams values longest ; + dict-anagrams values all-longest ; : longest-anagrams ( -- seq ) - dict-anagrams [ keys longest ] keep '[ _ at ] map ; - - - + dict-anagrams [ keys all-longest ] keep '[ _ at ] map ; diff --git a/extra/project-euler/014/014.factor b/extra/project-euler/014/014.factor index cbf45c9e32..e7a7bf8902 100644 --- a/extra/project-euler/014/014.factor +++ b/extra/project-euler/014/014.factor @@ -38,16 +38,13 @@ IN: project-euler.014 : next-collatz ( n -- n ) dup even? [ 2 / ] [ 3 * 1 + ] if ; -: longest ( seq seq -- seq ) - 2dup [ length ] bi@ > [ drop ] [ nip ] if ; - PRIVATE> : collatz ( n -- seq ) [ [ dup 1 > ] [ dup , next-collatz ] while , ] { } make ; : euler014 ( -- answer ) - 1000000 [1,b] { } [ collatz longest ] reduce first ; + 1000000 [1,b] { } [ collatz longer ] reduce first ; ! [ euler014 ] time ! 52868 ms run / 483 ms GC time @@ -65,7 +62,7 @@ PRIVATE> : euler014a ( -- answer ) 500000 1000000 [a,b] { 1 } [ - dup worth-calculating? [ collatz longest ] [ drop ] if + dup worth-calculating? [ collatz longer ] [ drop ] if ] reduce first ; ! [ euler014a ] 10 ave-time diff --git a/extra/project-euler/050/050.factor b/extra/project-euler/050/050.factor index 6176ac81d2..6a4f6ee80e 100644 --- a/extra/project-euler/050/050.factor +++ b/extra/project-euler/050/050.factor @@ -1,6 +1,7 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel locals math math.primes sequences project-euler.common ; +USING: arrays kernel locals math math.order math.primes +project-euler.common sequences ; IN: project-euler.050 ! http://projecteuler.net/index.php?section=problems&id=50 @@ -62,14 +63,11 @@ IN: project-euler.050 [ length ] dip 2array ] if ; -: longest ( pair pair -- longest ) - 2dup [ first ] bi@ > [ drop ] [ nip ] if ; - : continue? ( pair seq -- ? ) [ first ] [ length 1 - ] bi* < ; : (find-longest) ( best seq limit -- best ) - [ longest-prime longest ] 2keep 2over continue? [ + [ longest-prime max ] 2keep 2over continue? [ [ rest-slice ] dip (find-longest) ] [ 2drop ] if ; diff --git a/extra/rosetta-code/align-columns/align-columns.factor b/extra/rosetta-code/align-columns/align-columns.factor index 8f16a7bf83..d6786519c7 100644 --- a/extra/rosetta-code/align-columns/align-columns.factor +++ b/extra/rosetta-code/align-columns/align-columns.factor @@ -45,11 +45,11 @@ justified,$right$justified,$or$center$justified$within$its$column." : split-and-pad ( text -- lines ) "\n" split [ "$" split harvest ] map - dup [ length ] [ max ] map-reduce + dup longest length '[ _ "" pad-tail ] map ; : column-widths ( columns -- widths ) - [ [ length ] [ max ] map-reduce ] map ; + [ longest length ] map ; SINGLETONS: +left+ +middle+ +right+ ; diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index 605d5555e1..9ea2c42ea2 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -217,7 +217,7 @@ PRIVATE> : round-robin ( seq -- newseq ) [ { } ] [ - [ [ length ] [ max ] map-reduce iota ] keep + [ longest length iota ] keep [ [ ?nth ] with map ] curry map concat sift ] if-empty ;