sequences: Add some short useful factors. Clean up the use of longest.

diff --git a/basis/compiler/codegen/gc-maps/gc-maps.factor b/basis/compiler/codegen/gc-maps/gc-maps.factor
index 1f12b7a13a5251099204e05ee497f0f9c8c3ec00..474781ea95a561189d65ebdefde394ebc65491a0 100644 (file)
--- 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 cec851eb76da71d2945f1ba1c557eb64e4e7d673..2ab73b9a1327787a98318440c8eaa901e0b6b55e 100644 (file)
--- 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 83a121352591a36d3ad77ca84816a6bfce7afe54..aa914885ef0c2e4fc2dc59f035fcc1e52da28a38 100644 (file)
--- a/basis/strings/tables/tables.factor
+++ b/basis/strings/tables/tables.factor
@@ -5,14 +5,11 @@ IN: strings.tables
 
 <PRIVATE
 
-: max-length ( seq -- n )
-    [ length ] [ max ] map-reduce ; inline
-
 : format-row ( seq -- seq )
-    dup max-length '[ _ "" pad-tail ] map! ;
+    dup longest length '[ _ "" pad-tail ] map! ;
 
 : format-column ( seq -- seq )
-    dup max-length '[ _ CHAR: \s pad-tail ] map! ;
+    dup longest length '[ _ CHAR: \s pad-tail ] map! ;
 
 PRIVATE>
 

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 4bb2af05cdfe3d6cfd82f9c28d7d7b6dabba3fe2..cdd88081f7c3dfde7e44a03713fcd6fdd22cb38b 100644 (file)
--- 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 f5f87af98ab8a6e7867acc50e0b59ed405c33a58..b5374ed965469e6d2f2e76dc9b19077e045ee980 100644 (file)
--- 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 cbf45c9e326281ab44a10276424cb421d97aa6cf..e7a7bf89024f6099cce07894768a106955c7ed0c 100644 (file)
--- 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 6176ac81d2f3765db1376916b1eb5478e8324737..6a4f6ee80e2cdb3c7fee72efd8dfb7f0246b1527 100644 (file)
--- 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 8f16a7bf83c7be0b38a5a01aaf5715edba6673d2..d6786519c7c97a76d25473cac351033ce6950155 100644 (file)
--- 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 605d5555e187a5ddf99d92f75c3f5d361f1bface..9ea2c42ea2d4d045bf2bd39dadcc36a4abf4c814 100644 (file)
--- 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 ;