From ed37418a47e1e6ef2461a9e6f4b941debfb9e5ab Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 2 Mar 2012 09:54:11 -0800
Subject: [PATCH] math.combinatorics: implementing "next-permutation".

---
 .../combinatorics/combinatorics-docs.factor   |  6 ++++++
 .../combinatorics/combinatorics-tests.factor  |  6 ++++++
 basis/math/combinatorics/combinatorics.factor | 21 +++++++++++++++++++
 3 files changed, 33 insertions(+)

diff --git a/basis/math/combinatorics/combinatorics-docs.factor b/basis/math/combinatorics/combinatorics-docs.factor
index 9b2a29bd73..72ea6bbf46 100644
--- a/basis/math/combinatorics/combinatorics-docs.factor
+++ b/basis/math/combinatorics/combinatorics-docs.factor
@@ -103,6 +103,12 @@ HELP: >permutation
 { $notes "For clarification, the following two statements are equivalent:" { $code "10 factoradic >permutation" "{ 1 2 0 0 } >permutation" } }
 { $examples { $example "USING: math.combinatorics.private prettyprint ;" "{ 0 0 0 0 } >permutation ." "{ 0 1 2 3 }" } } ;
 
+HELP: next-permutation
+{ $values { "seq" sequence } { "seq" sequence } }
+{ $description "Rearranges the elements in " { $snippet "seq" } " into the lexicographically next greater permutation of elements" }
+{ $notes "Performs an in-place modification of " { $snippet "seq" } "." }
+{ $examples { $example "USING: math.combinatorics prettyprint ;" "\"ABC\" next-permutation ." "\"ACB\"" } } ;
+
 HELP: all-subsets
 { $values { "seq" sequence } { "subsets" sequence } }
 { $description
diff --git a/basis/math/combinatorics/combinatorics-tests.factor b/basis/math/combinatorics/combinatorics-tests.factor
index 7567dd510b..e7f4c540e3 100644
--- a/basis/math/combinatorics/combinatorics-tests.factor
+++ b/basis/math/combinatorics/combinatorics-tests.factor
@@ -44,6 +44,12 @@ IN: math.combinatorics.tests
 [ { 2 1 0 } ] [ { "c" "b" "a" } inverse-permutation ] unit-test
 [ { 3 0 2 1 } ] [ { 12 45 34 2 } inverse-permutation ] unit-test
 
+[ "" ] [ "" next-permutation ] unit-test
+[ "1" ] [ "1" next-permutation ] unit-test
+[ "21" ] [ "12" next-permutation ] unit-test
+[ "8344112666" ] [ "8342666411" next-permutation ] unit-test
+[ "ABC" "ACB" "BAC" "BCA" "CAB" "CBA" "ABC" ]
+[ "ABC" 6 [ dup >string next-permutation ] times ] unit-test
 
 [ 2598960 ] [ 52 iota 5 <combo> choose ] unit-test
 
diff --git a/basis/math/combinatorics/combinatorics.factor b/basis/math/combinatorics/combinatorics.factor
index 17739cdac5..23638b0be6 100644
--- a/basis/math/combinatorics/combinatorics.factor
+++ b/basis/math/combinatorics/combinatorics.factor
@@ -61,6 +61,27 @@ PRIVATE>
 : inverse-permutation ( seq -- permutation )
     <enum> sort-values keys ;
 
+<PRIVATE
+
+: cut-point ( seq -- n )
+    [ last ] keep [ [ > ] keep swap ] find-last drop nip ;
+
+: greater-from-last ( n seq -- i )
+    [ nip ] [ nth ] 2bi [ > ] curry find-last drop ;
+
+: reverse-tail! ( n seq -- seq )
+    [ swap 1 + tail-slice reverse! drop ] keep ;
+
+: (next-permutation) ( seq -- seq )
+    dup cut-point [
+        swap [ greater-from-last ] 2keep
+        [ exchange ] [ reverse-tail! nip ] 3bi
+    ] [ reverse! ] if* ;
+
+PRIVATE>
+
+: next-permutation ( seq -- seq )
+    dup [ ] [ drop (next-permutation) ] if-empty ;
 
 ! Combinadic-based combination methodology