extend sort-by-slots to work with nested objects, add split-by-slots for already...

diff --git a/basis/sorting/slots/slots-docs.factor b/basis/sorting/slots/slots-docs.factor
index 64d0a1efdfd5bf1768ca6f1523b8237e647980dd..a3bdbf9ac1cbc880ac883eed136c091507484558 100644 (file)
--- a/basis/sorting/slots/slots-docs.factor
+++ b/basis/sorting/slots/slots-docs.factor
@@ -6,17 +6,17 @@ IN: sorting.slots
 
 HELP: compare-slots
 { $values
-     { "sort-specs" "a sequence of accessor/comparator pairs" }
+     { "sort-specs" "a sequence of accessors ending with a comparator" }
      { "<=>" { $link +lt+ } " " { $link +eq+ } " or " { $link +gt+ } }
 }
 { $description "Compares two objects using a chain of intrinsic linear orders such that if two objects are " { $link +eq+ } ", then the next comparator is tried. The comparators are slot-name/comparator pairs." } ;
 
 HELP: sort-by-slots
 { $values
-     { "seq" sequence } { "sort-specs" "a sequence of accessor/comparator pairs" }
+     { "seq" sequence } { "sort-specs" "a sequence of accessors ending with a comparator" }
      { "seq'" sequence }
 }
-{ $description "Sorts a sequence of tuples by the sort-specs in " { $snippet "sort-spec" } ". A sort-spec is a slot accessor and a comparator." }
+{ $description "Sorts a sequence of tuples by the sort-specs in " { $snippet "sort-spec" } ". A sort-spec is a sequence of slot accessors ending in a comparator." }
 { $examples
     "Sort by slot c, then b descending:"
     { $example
@@ -32,6 +32,13 @@ HELP: sort-by-slots
     }
 } ;
 
+HELP: split-by-slots
+{ $values
+     { "accessor-seqs" "a sequence of sequences of tuple accessors" }
+     { "quot" quotation }
+}
+{ $description "Splits a sequence of tuples into a sequence of slices of tuples that have the same values in all slots in the accessor sequence. This word is only useful for splitting a sorted sequence, but is more efficient than partitioning in such a case." } ;
+
 ARTICLE: "sorting.slots" "Sorting by slots"
 "The " { $vocab-link "sorting.slots" } " vocabulary can sort tuples by slot in ascending or descending order, using subsequent slots as tie-breakers." $nl
 "Comparing two objects by a sequence of slots:"

diff --git a/basis/sorting/slots/slots-tests.factor b/basis/sorting/slots/slots-tests.factor
index ab130d1eed03a778e42a588450335097b63cde8d..7a4eeb8e7593cfcbf0966563eba28ee1a302bfdb 100644 (file)
--- a/basis/sorting/slots/slots-tests.factor
+++ b/basis/sorting/slots/slots-tests.factor
@@ -1,10 +1,12 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors math.order sorting.slots tools.test
-sorting.human ;
+sorting.human arrays sequences kernel assocs multiline ;
 IN: sorting.literals.tests
 
-TUPLE: sort-test a b c ;
+TUPLE: sort-test a b c tuple2 ;
+
+TUPLE: tuple2 d ;
 
 [
     {
@@ -43,8 +45,101 @@ TUPLE: sort-test a b c ;
 ] unit-test
 
 [
-    { }
+    {
+        {
+            T{ sort-test { a 1 } { b 1 } { c 10 } }
+            T{ sort-test { a 1 } { b 1 } { c 11 } }
+        }
+        { T{ sort-test { a 1 } { b 3 } { c 9 } } }
+        {
+            T{ sort-test { a 2 } { b 5 } { c 3 } }
+            T{ sort-test { a 2 } { b 5 } { c 2 } }
+        }
+    }
 ] [
-    { }
-    { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by-slots
+    {
+        T{ sort-test f 1 3 9 }
+        T{ sort-test f 1 1 10 }
+        T{ sort-test f 1 1 11 }
+        T{ sort-test f 2 5 3 }
+        T{ sort-test f 2 5 2 }
+    }
+    { { a>> human-<=> } { b>> <=> } } [ sort-by-slots ] keep
+    [ but-last-slice ] map split-by-slots [ >array ] map
+] unit-test
+
+: split-test ( seq -- seq' )
+    { { a>> } { b>> } } split-by-slots ;
+
+[ split-test ] must-infer
+
+[ { } ]
+[ { } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by-slots ] unit-test
+
+[
+    {
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 1 } } } }
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 2 } } } }
+        T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 3 } } } }
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } }
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } }
+        T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 4 } } } }
+    }
+] [
+    {
+        T{ sort-test f 6 f f T{ tuple2 f 1 } }
+        T{ sort-test f 5 f f T{ tuple2 f 4 } }
+        T{ sort-test f 6 f f T{ tuple2 f 3 } }
+        T{ sort-test f 6 f f T{ tuple2 f 3 } }
+        T{ sort-test f 5 f f T{ tuple2 f 3 } }
+        T{ sort-test f 6 f f T{ tuple2 f 2 } }
+    } { { tuple2>> d>> <=> } { a>> <=> } } sort-by-slots
+] unit-test
+
+[
+    {
+        {
+            T{ sort-test
+                { a 6 }
+                { tuple2 T{ tuple2 { d 1 } } }
+            }
+        }
+        {
+            T{ sort-test
+                { a 6 }
+                { tuple2 T{ tuple2 { d 2 } } }
+            }
+        }
+        {
+            T{ sort-test
+                { a 5 }
+                { tuple2 T{ tuple2 { d 3 } } }
+            }
+        }
+        {
+            T{ sort-test
+                { a 6 }
+                { tuple2 T{ tuple2 { d 3 } } }
+            }
+            T{ sort-test
+                { a 6 }
+                { tuple2 T{ tuple2 { d 3 } } }
+            }
+        }
+        {
+            T{ sort-test
+                { a 5 }
+                { tuple2 T{ tuple2 { d 4 } } }
+            }
+        }
+    }
+] [
+    {
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 1 } } } }
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 2 } } } }
+        T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 3 } } } }
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } }
+        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } }
+        T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 4 } } } }
+    } { { tuple2>> d>> } { a>> } } split-by-slots [ >array ] map
 ] unit-test

diff --git a/basis/sorting/slots/slots.factor b/basis/sorting/slots/slots.factor
index 02a11428f9756dd20a02004f68708be8f2846ecb..56b6a115f07350f505dfb588fc8176512a6ac68c 100644 (file)
--- a/basis/sorting/slots/slots.factor
+++ b/basis/sorting/slots/slots.factor
@@ -1,19 +1,30 @@
 ! Copyright (C) 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators.short-circuit fry kernel macros math.order
-sequences words sorting ;
+sequences words sorting sequences.deep assocs splitting.monotonic
+math ;
 IN: sorting.slots
 
 <PRIVATE
 
-: slot-comparator ( accessor comparator -- quot )
-    '[ [ _ execute ] bi@ _ execute dup +eq+ eq? [ drop f ] when ] ;
+: slot-comparator ( seq -- quot )
+    [
+        but-last-slice
+        [ '[ [ _ execute ] bi@ ] ] map concat
+    ] [
+        peek
+        '[ @ _ execute dup +eq+ eq? [ drop f ] when ]
+    ] bi ;
 
 PRIVATE>
 
 MACRO: compare-slots ( sort-specs -- <=> )
-    #! sort-spec: { accessor comparator }
-    [ first2 slot-comparator ] map '[ _ 2|| +eq+ or ] ;
+    #! sort-spec: { accessors comparator }
+    [ slot-comparator ] map '[ _ 2|| +eq+ or ] ;
 
 : sort-by-slots ( seq sort-specs -- seq' )
     '[ _ compare-slots ] sort ;
+
+MACRO: split-by-slots ( accessor-seqs -- quot )
+    [ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map
+    '[ [ _ 2&& ] slice monotonic-slice ] ;