sorting: sort-with and inv-sort-with combinators to simplify common […

… [ ... ] compare ] sort idiom

core/sorting/sorting-docs.factor

@@ -12,6 +12,8 @@ $nl
 "Sorting a sequence with a custom comparator:"
 { $subsection sort }
 "Sorting a sequence with common comparators:"
+{ $subsection sort-with }
+{ $subsection inv-sort-with }
 { $subsection natural-sort }
 { $subsection sort-keys }
 { $subsection sort-values } ;
@@ -20,16 +22,24 @@ ABOUT: "sequences-sorting"
 
 HELP: sort
 { $values { "seq" "a sequence" } { "quot" { $quotation "( obj1 obj2 -- <=> )" } } { "sortedseq" "a new sorted sequence" } }
-{ $description "Sorts the elements into a new array using a stable sort." }
+{ $description "Sorts the elements of " { $snippet "seq" } " into a new array using a stable sort." }
 { $notes "The algorithm used is the merge sort." } ;
 
+HELP: sort-with
+{ $values { "seq" "a sequence" } { "quot" { $quotation "( object -- key )" } } { "sortedseq" "a new sorted sequence" } }
+{ $description "Sorts the elements of " { $snippet "seq" } " by applying " { $link compare } " with " { $snippet "quot" } " to each pair of elements in the sequence." } ;
+
+HELP: inv-sort-with
+{ $values { "seq" "a sequence" } { "quot" { $quotation "( object -- key )" } } { "sortedseq" "a new sorted sequence" } }
+{ $description "Sorts the elements of " { $snippet "seq" } " by applying " { $link compare } " with " { $snippet "quot" } " to each pair of elements in the sequence and inverting the results." } ;
+
 HELP: sort-keys
 { $values { "seq" "an alist" } { "sortedseq" "a new sorted sequence" } }
-{ $description "Sorts the elements comparing first elements of pairs using the " { $link <=> } " word." } ;
+{ $description "Sorts the elements of " { $snippet "seq" } " comparing first elements of pairs using the " { $link <=> } " word." } ;
 
 HELP: sort-values
 { $values { "seq" "an alist" } { "sortedseq" "a new sorted sequence" } }
-{ $description "Sorts the elements comparing second elements of pairs using the " { $link <=> } " word." } ;
+{ $description "Sorts the elements of " { $snippet "seq" } " comparing second elements of pairs using the " { $link <=> } " word." } ;
 
 HELP: natural-sort
 { $values { "seq" "a sequence of real numbers" } { "sortedseq" "a new sorted sequence" } }
@@ -43,4 +53,4 @@ HELP: midpoint@
 { $values { "seq" "a sequence" } { "n" integer } }
 { $description "Outputs the index of the midpoint of " { $snippet "seq" } "." } ;
 
-{ <=> compare natural-sort sort-keys sort-values } related-words
+{ <=> compare natural-sort sort-with inv-sort-with sort-keys sort-values } related-words

core/sorting/sorting.factor

@@ -155,6 +155,11 @@ PRIVATE>
 
 : natural-sort ( seq -- sortedseq ) [ <=> ] sort ;
 
+: sort-with ( seq quot -- sortedseq )
+    [ compare ] curry sort ; inline
+: inv-sort-with ( seq quot -- sortedseq )
+    [ compare invert-comparison ] curry sort ; inline
+
 : sort-keys ( seq -- sortedseq ) [ [ first ] compare ] sort ;
 
 : sort-values ( seq -- sortedseq ) [ [ second ] compare ] sort ;