From 247f57b828329d81f799f38104f43cfd2dd316ce Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 11 Mar 2013 18:33:54 -0700
Subject: [PATCH] sequences: More efficient longest and shortest by moving
 infimum-by/supremum-by into core.

---
 core/sequences/sequences-tests.factor      | 26 +++++++++++++++++++++-
 core/sequences/sequences.factor            | 21 ++++++++++++++---
 extra/sequences/extras/extras-tests.factor | 23 -------------------
 extra/sequences/extras/extras.factor       | 15 -------------
 4 files changed, 43 insertions(+), 42 deletions(-)

diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index 26f75e50f9..3912211872 100644
--- a/core/sequences/sequences-tests.factor
+++ b/core/sequences/sequences-tests.factor
@@ -1,7 +1,7 @@
 USING: arrays byte-arrays kernel math math.order math.parser
 namespaces sequences kernel.private sequences.private strings
 sbufs tools.test vectors assocs generic vocabs.loader
-generic.single ;
+generic.single math.vectors ;
 IN: sequences.tests
 
 [ "empty" ] [ { } [ "empty" ] [ "not empty" ] if-empty ] unit-test
@@ -351,3 +351,27 @@ USE: make
 [ { } { } [ [ string>digits product ] bi@ + ] [ + ] 2map-reduce ] must-infer
 [ { } { } [ + ] [ + ] 2map-reduce ] must-fail
 [ 24 ] [ { 1 2 } { 3 4 } [ + ] [ * ] 2map-reduce ] unit-test
+
+[ 4 ] [ 5 iota [ ] supremum-by ] unit-test
+[ 0 ] [ 5 iota [ ] infimum-by ] unit-test
+{ "bar" } [ { "bar" "baz" "qux" } [ length ] supremum-by ] unit-test
+{ "bar" } [ { "bar" "baz" "qux" } [ length ] infimum-by ] unit-test
+[ { "foo" } ] [ { { "foo" } { "bar" } } [ first ] supremum-by ] unit-test
+[ { "bar" } ] [ { { "foo" } { "bar" } } [ first ] infimum-by ] unit-test
+
+[ { 0 0 255 } ] [
+    {
+        { 0 0 0 }
+        { 95 255 95 }
+        { 215 95 95 }
+        { 95 135 255 }
+        { 135 95 135 }
+        { 135 255 255 }
+        { 0 0 255 }
+        { 0 95 95 }
+        { 0 255 215 }
+        { 135 0 95 }
+        { 255 0 175 }
+    } [ { 0 0 255 } distance ] infimum-by
+] unit-test
+
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index cdd88081f7..df0da366ca 100644
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -1016,11 +1016,26 @@ M: object sum 0 [ + ] binary-reduce ; inline
 : cartesian-product ( seq1 seq2 -- newseq )
     [ { } 2sequence ] cartesian-map ;
 
-: filter-length ( seq n -- seq' ) [ swap length = ] curry filter ;
+: each-from ( ... seq quot: ( ... x -- ... ) i -- ... )
+    -rot (each) (each-integer) ; inline
 
-: shortest ( seqs -- elt ) [ ] [ shorter ] map-reduce ;
+: supremum-by ( seq quot: ( ... elt -- ... x ) -- elt )
+    [ [ first dup ] dip call ] 2keep [
+        dupd call pick dupd after?
+        [ [ 2drop ] 2dip ] [ 2drop ] if
+    ] curry 1 each-from drop ; inline
 
-: longest ( seqs -- elt ) [ ] [ longer ] map-reduce ;
+: infimum-by ( seq quot: ( ... elt -- ... x ) -- elt )
+    [ [ first dup ] dip call ] 2keep [
+        dupd call pick dupd before?
+        [ [ 2drop ] 2dip ] [ 2drop ] if
+    ] curry 1 each-from drop ; inline
+
+: filter-length ( seq n -- seq' ) swap [ length = ] with filter ;
+
+: shortest ( seqs -- elt ) [ length ] infimum-by ;
+
+: longest ( seqs -- elt ) [ length ] supremum-by ;
 
 : all-shortest ( seqs -- seqs' ) dup shortest length filter-length ;
 
diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index c68c26b812..eeaa3e00eb 100644
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -4,29 +4,6 @@ tools.test ;
 
 IN: sequences.extras.tests
 
-[ 4 ] [ 5 iota [ ] supremum-by ] unit-test
-[ 0 ] [ 5 iota [ ] infimum-by ] unit-test
-{ "bar" } [ { "bar" "baz" "qux" } [ length ] supremum-by ] unit-test
-{ "bar" } [ { "bar" "baz" "qux" } [ length ] infimum-by ] unit-test
-[ { "foo" } ] [ { { "foo" } { "bar" } } [ first ] supremum-by ] unit-test
-[ { "bar" } ] [ { { "foo" } { "bar" } } [ first ] infimum-by ] unit-test
-
-[ { 0 0 255 } ] [
-    {
-        { 0 0 0 }
-        { 95 255 95 }
-        { 215 95 95 }
-        { 95 135 255 }
-        { 135 95 135 }
-        { 135 255 255 }
-        { 0 0 255 }
-        { 0 95 95 }
-        { 0 255 215 }
-        { 135 0 95 }
-        { 255 0 175 }
-    } [ { 0 0 255 } distance ] infimum-by
-] unit-test
-
 { V{ 0 1 2 3 4 5 6 7 8 9 } } [
     V{ } clone
     10 iota >array randomize
diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 9ea2c42ea2..87704d7d55 100644
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -28,24 +28,9 @@ IN: sequences.extras
 : insert-sorted ( elt seq -- seq )
     2dup [ < ] with find drop over length or swap insert-nth ;
 
-: each-from ( ... seq quot: ( ... x -- ... ) i -- ... )
-    -rot (each) (each-integer) ; inline
-
 : reduce-from ( ... seq identity quot: ( ... prev elt -- ... next ) i -- ... result )
     [ swap ] 2dip each-from ; inline
 
-: supremum-by ( seq quot: ( ... elt -- ... x ) -- elt )
-    [ [ first dup ] dip call ] 2keep [
-        dupd call pick dupd after?
-        [ [ 2drop ] 2dip ] [ 2drop ] if
-    ] curry 1 each-from drop ; inline
-
-: infimum-by ( seq quot: ( ... elt -- ... x ) -- elt )
-    [ [ first dup ] dip call ] 2keep [
-        dupd call pick dupd before?
-        [ [ 2drop ] 2dip ] [ 2drop ] if
-    ] curry 1 each-from drop ; inline
-
 : all-subseqs ( seq -- seqs )
     dup length [1,b] [ <clumps> ] with map concat ;