Skip to content
This repository
  • 2 commits
  • 3 files changed
  • 0 comments
  • 1 contributor
6  basis/math/combinatorics/combinatorics-docs.factor
@@ -103,6 +103,12 @@ HELP: >permutation
103 103
 { $notes "For clarification, the following two statements are equivalent:" { $code "10 factoradic >permutation" "{ 1 2 0 0 } >permutation" } }
104 104
 { $examples { $example "USING: math.combinatorics.private prettyprint ;" "{ 0 0 0 0 } >permutation ." "{ 0 1 2 3 }" } } ;
105 105
 
  106
+HELP: next-permutation
  107
+{ $values { "seq" sequence } { "seq" sequence } }
  108
+{ $description "Rearranges the elements in " { $snippet "seq" } " into the lexicographically next greater permutation of elements." }
  109
+{ $notes "Performs an in-place modification of " { $snippet "seq" } "." }
  110
+{ $examples { $example "USING: math.combinatorics prettyprint ;" "\"ABC\" next-permutation ." "\"ACB\"" } } ;
  111
+
106 112
 HELP: all-subsets
107 113
 { $values { "seq" sequence } { "subsets" sequence } }
108 114
 { $description
6  basis/math/combinatorics/combinatorics-tests.factor
@@ -44,6 +44,12 @@ IN: math.combinatorics.tests
44 44
 [ { 2 1 0 } ] [ { "c" "b" "a" } inverse-permutation ] unit-test
45 45
 [ { 3 0 2 1 } ] [ { 12 45 34 2 } inverse-permutation ] unit-test
46 46
 
  47
+[ "" ] [ "" next-permutation ] unit-test
  48
+[ "1" ] [ "1" next-permutation ] unit-test
  49
+[ "21" ] [ "12" next-permutation ] unit-test
  50
+[ "8344112666" ] [ "8342666411" next-permutation ] unit-test
  51
+[ "ABC" "ACB" "BAC" "BCA" "CAB" "CBA" "ABC" ]
  52
+[ "ABC" 6 [ dup >string next-permutation ] times ] unit-test
47 53
 
48 54
 [ 2598960 ] [ 52 iota 5 <combo> choose ] unit-test
49 55
 
21  basis/math/combinatorics/combinatorics.factor
@@ -61,6 +61,27 @@ PRIVATE>
61 61
 : inverse-permutation ( seq -- permutation )
62 62
     <enum> sort-values keys ;
63 63
 
  64
+<PRIVATE
  65
+
  66
+: cut-point ( seq -- n )
  67
+    [ last ] keep [ [ > ] keep swap ] find-last drop nip ;
  68
+
  69
+: greater-from-last ( n seq -- i )
  70
+    [ nip ] [ nth ] 2bi [ > ] curry find-last drop ;
  71
+
  72
+: reverse-tail! ( n seq -- seq )
  73
+    [ swap 1 + tail-slice reverse! drop ] keep ;
  74
+
  75
+: (next-permutation) ( seq -- seq )
  76
+    dup cut-point [
  77
+        swap [ greater-from-last ] 2keep
  78
+        [ exchange ] [ reverse-tail! nip ] 3bi
  79
+    ] [ reverse! ] if* ;
  80
+
  81
+PRIVATE>
  82
+
  83
+: next-permutation ( seq -- seq )
  84
+    dup [ ] [ drop (next-permutation) ] if-empty ;
64 85
 
65 86
 ! Combinadic-based combination methodology
66 87
 

No commit comments for this range

Something went wrong with that request. Please try again.