sorting.extras: adding 'argsort'.

diff --git a/extra/sorting/extras/extras-tests.factor b/extra/sorting/extras/extras-tests.factor
new file mode 100644 (file)
index 0000000..931ff3e
--- /dev/null
+++ b/extra/sorting/extras/extras-tests.factor
@@ -0,0 +1,7 @@
+USING: kernel math.order sequences tools.test ;
+IN: sorting.extras
+
+{ { 0 2 1 } } [ { 10 30 20 } [ <=> ] argsort ] unit-test
+{ { 2 0 1 } } [
+    { "hello" "goodbye" "yo" } [ [ length ] bi@ <=> ] argsort
+] unit-test

diff --git a/extra/sorting/extras/extras.factor b/extra/sorting/extras/extras.factor
new file mode 100644 (file)
index 0000000..6f0ef81
--- /dev/null
+++ b/extra/sorting/extras/extras.factor
@@ -0,0 +1,7 @@
+USING: assocs kernel sequences sequences.private sorting ;
+IN: sorting.extras
+
+: argsort ( seq quot: ( obj1 obj2 -- <=> ) -- sortedseq )
+    [ dup length iota zip ] dip
+    [ [ first-unsafe ] bi@ ] prepose
+    sort [ 1 swap nth-unsafe ] map! ; inline