steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

extend sort-by-slots to work with nested objects, add split-by-slots for already-sorted sequences of tuples

db4
Doug Coleman 2009-01-13 00:20:34 -06:00
parent 4a01649d15
commit f920007959
3 changed files with 126 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
basis/sorting/slots/slots-docs.factor
View File

@ -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:"

105
basis/sorting/slots/slots-tests.factor
View File

@ -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

21
basis/sorting/slots/slots.factor
View File

@ -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 ] ;