slim down the sorting.functor using more combinators
parent
dd4766798c
commit
6f2c4fc02a
|
@ -7,18 +7,10 @@ FUNCTOR: define-sorting ( NAME QUOT -- )
|
|||
|
||||
NAME<=> DEFINES ${NAME}<=>
|
||||
NAME>=< DEFINES ${NAME}>=<
|
||||
NAME-compare DEFINES ${NAME}-compare
|
||||
NAME-sort DEFINES ${NAME}-sort
|
||||
NAME-sort-keys DEFINES ${NAME}-sort-keys
|
||||
NAME-sort-values DEFINES ${NAME}-sort-values
|
||||
|
||||
WHERE
|
||||
|
||||
: NAME<=> ( obj1 obj2 -- <=> ) QUOT bi@ <=> ;
|
||||
: NAME>=< ( obj1 obj2 -- >=< ) NAME<=> invert-comparison ;
|
||||
: NAME-compare ( obj1 obj2 quot -- <=> ) bi@ NAME<=> ; inline
|
||||
: NAME-sort ( seq -- sortedseq ) [ NAME<=> ] sort ;
|
||||
: NAME-sort-keys ( seq -- sortedseq ) [ [ first ] NAME-compare ] sort ;
|
||||
: NAME-sort-values ( seq -- sortedseq ) [ [ second ] NAME-compare ] sort ;
|
||||
|
||||
;FUNCTOR
|
||||
|
|
|
@ -25,46 +25,11 @@ HELP: human>=<
|
|||
}
|
||||
{ $description "Compares two objects using the " { $link human<=> } " word and inverts the result." } ;
|
||||
|
||||
HELP: human-compare
|
||||
{ $values
|
||||
{ "obj1" object } { "obj2" object } { "quot" quotation }
|
||||
{ "<=>" "an ordering specifier" }
|
||||
}
|
||||
{ $description "Compares the results of applying the quotation to both objects via <=>." } ;
|
||||
|
||||
HELP: human-sort
|
||||
{ $values
|
||||
{ "seq" sequence }
|
||||
{ "sortedseq" sequence }
|
||||
}
|
||||
{ $description "Sorts a sequence of objects by comparing the magnitude of any integers in the input string using the <=> word." } ;
|
||||
|
||||
HELP: human-sort-keys
|
||||
{ $values
|
||||
{ "seq" "an alist" }
|
||||
{ "sortedseq" "a new sorted sequence" }
|
||||
}
|
||||
{ $description "Sorts the elements comparing first elements of pairs using the " { $link human<=> } " word." } ;
|
||||
|
||||
HELP: human-sort-values
|
||||
{ $values
|
||||
{ "seq" "an alist" }
|
||||
{ "sortedseq" "a new sorted sequence" }
|
||||
}
|
||||
{ $description "Sorts the elements comparing second elements of pairs using the " { $link human<=> } " word." } ;
|
||||
|
||||
{ <=> >=< human-compare human-sort human-sort-keys human-sort-values } related-words
|
||||
|
||||
ARTICLE: "sorting.human" "Human-friendly sorting"
|
||||
"The " { $vocab-link "sorting.human" } " vocabulary sorts by numbers as a human would -- by comparing their magnitudes -- rather than in a lexicographic way. For example, sorting a1, a10, a03, a2 with human sort returns a1, a2, a03, a10, while sorting with natural sort returns a03, a1, a10, a2." $nl
|
||||
"Comparing two objects:"
|
||||
{ $subsection human<=> }
|
||||
{ $subsection human>=< }
|
||||
{ $subsection human-compare }
|
||||
"Sort a sequence:"
|
||||
{ $subsection human-sort }
|
||||
{ $subsection human-sort-keys }
|
||||
{ $subsection human-sort-values }
|
||||
"Splitting a string into substrings and integers:"
|
||||
{ $subsection find-numbers } ;
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
USING: sorting.human tools.test ;
|
||||
USING: sorting.human tools.test sorting.slots ;
|
||||
IN: sorting.human.tests
|
||||
|
||||
\ human-sort must-infer
|
||||
|
||||
[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } human-sort ] unit-test
|
||||
[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } { human<=> } sort-by ] unit-test
|
||||
|
|
|
@ -7,8 +7,8 @@ IN: sorting.slots
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: short-circuit-comparator ( word -- quot )
|
||||
execute dup +eq+ eq? [ drop f ] when ; inline
|
||||
: short-circuit-comparator ( obj1 obj2 word -- comparator/? )
|
||||
execute dup +eq+ eq? [ drop f ] when ;
|
||||
|
||||
: slot-comparator ( seq -- quot )
|
||||
[
|
||||
|
@ -34,6 +34,12 @@ MACRO: compare-seq ( seq -- quot )
|
|||
: sort-by ( seq sort-seq -- sortedseq )
|
||||
'[ _ compare-seq ] sort ;
|
||||
|
||||
: sort-keys-by ( seq sort-seq -- sortedseq )
|
||||
'[ [ first ] bi@ _ compare-seq ] sort ;
|
||||
|
||||
: sort-values-by ( seq sort-seq -- sortedseq )
|
||||
'[ [ second ] bi@ _ compare-seq ] sort ;
|
||||
|
||||
MACRO: split-by-slots ( accessor-seqs -- quot )
|
||||
[ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map
|
||||
'[ [ _ 2&& ] slice monotonic-slice ] ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test sorting.title ;
|
||||
USING: tools.test sorting.title sorting.slots ;
|
||||
IN: sorting.title.tests
|
||||
|
||||
: sort-me ( -- seq )
|
||||
|
@ -36,5 +36,5 @@ IN: sorting.title.tests
|
|||
"la vida loca"
|
||||
}
|
||||
] [
|
||||
sort-me title-sort
|
||||
sort-me { title<=> } sort-by
|
||||
] unit-test
|
||||
|
|
Loading…
Reference in New Issue