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

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 )

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 ;
 

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>
 

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

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 -- )
+: make-anagram-hash ( strings -- assoc )
-    '[ dup natural-sort _ push-at ] each ;
+    [ natural-sort ] collect-by
-
+    [ members ] assoc-map
-: all-anagrams ( seq -- assoc )
-    H{ } clone [ (all-anagrams) ] keep
     [ 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 ;
-
-
-

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

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 ;
 

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+ ;
 

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 ;