slim down the sorting.functor using more combinators

db4
Doug Coleman 2009-04-04 00:02:15 -05:00
parent dd4766798c
commit 6f2c4fc02a
5 changed files with 12 additions and 49 deletions

View File

@ -7,18 +7,10 @@ FUNCTOR: define-sorting ( NAME QUOT -- )
NAME<=> DEFINES ${NAME}<=> NAME<=> DEFINES ${NAME}<=>
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 WHERE
: NAME<=> ( obj1 obj2 -- <=> ) QUOT bi@ <=> ; : NAME<=> ( obj1 obj2 -- <=> ) QUOT bi@ <=> ;
: NAME>=< ( obj1 obj2 -- >=< ) NAME<=> invert-comparison ; : 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 ;FUNCTOR

View File

@ -25,46 +25,11 @@ HELP: human>=<
} }
{ $description "Compares two objects using the " { $link human<=> } " word and inverts the result." } ; { $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" 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 "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:" "Comparing two objects:"
{ $subsection human<=> } { $subsection human<=> }
{ $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:" "Splitting a string into substrings and integers:"
{ $subsection find-numbers } ; { $subsection find-numbers } ;

View File

@ -1,6 +1,6 @@
USING: sorting.human tools.test ; USING: sorting.human tools.test sorting.slots ;
IN: sorting.human.tests IN: sorting.human.tests
\ human-sort must-infer \ 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

View File

@ -7,8 +7,8 @@ IN: sorting.slots
<PRIVATE <PRIVATE
: short-circuit-comparator ( word -- quot ) : short-circuit-comparator ( obj1 obj2 word -- comparator/? )
execute dup +eq+ eq? [ drop f ] when ; inline execute dup +eq+ eq? [ drop f ] when ;
: slot-comparator ( seq -- quot ) : slot-comparator ( seq -- quot )
[ [
@ -34,6 +34,12 @@ MACRO: compare-seq ( seq -- quot )
: sort-by ( seq sort-seq -- sortedseq ) : sort-by ( seq sort-seq -- sortedseq )
'[ _ compare-seq ] sort ; '[ _ 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 ) MACRO: split-by-slots ( accessor-seqs -- quot )
[ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map [ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map
'[ [ _ 2&& ] slice monotonic-slice ] ; '[ [ _ 2&& ] slice monotonic-slice ] ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: sorting.title.tests
: sort-me ( -- seq ) : sort-me ( -- seq )
@ -36,5 +36,5 @@ IN: sorting.title.tests
"la vida loca" "la vida loca"
} }
] [ ] [
sort-me title-sort sort-me { title<=> } sort-by
] unit-test ] unit-test