September 2017 Update
This commit is contained in:
Ingy döt Net
parent
bba7bfd280
commit
ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
|
|
@ -14,8 +14,10 @@ Note: The Steinhaus–Johnson–Trotter algorithm generates successive permutati
|
|||
* [[wp:Steinhaus–Johnson–Trotter algorithm|Steinhaus–Johnson–Trotter algorithm]]
|
||||
* [http://www.cut-the-knot.org/Curriculum/Combinatorics/JohnsonTrotter.shtml Johnson-Trotter Algorithm Listing All Permutations]
|
||||
* [http://stackoverflow.com/a/29044942/10562 Correction to] Heap's algorithm as presented in Wikipedia and widely distributed.
|
||||
* [http://www.gutenberg.org/files/18567/18567-h/18567-h.htm#ch7] Tintinnalogia
|
||||
|
||||
|
||||
;Related task:
|
||||
* [[Matrix arithmetic]]
|
||||
* [[Gray code]]
|
||||
<br><br>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,59 @@
|
|||
(defstruct (directed-number (:conc-name dn-))
|
||||
(number nil :type integer)
|
||||
(direction nil :type (member :left :right)))
|
||||
|
||||
(defmethod print-object ((dn directed-number) stream)
|
||||
(ecase (dn-direction dn)
|
||||
(:left (format stream "<~D" (dn-number dn)))
|
||||
(:right (format stream "~D>" (dn-number dn)))))
|
||||
|
||||
(defun dn> (dn1 dn2)
|
||||
(declare (directed-number dn1 dn2))
|
||||
(> (dn-number dn1) (dn-number dn2)))
|
||||
|
||||
(defun dn-reverse-direction (dn)
|
||||
(declare (directed-number dn))
|
||||
(setf (dn-direction dn) (ecase (dn-direction dn)
|
||||
(:left :right)
|
||||
(:right :left))))
|
||||
|
||||
(defun make-directed-numbers-upto (upto)
|
||||
(let ((numbers (make-array upto :element-type 'integer)))
|
||||
(dotimes (n upto numbers)
|
||||
(setf (aref numbers n) (make-directed-number :number (1+ n) :direction :left)))))
|
||||
|
||||
(defun max-mobile-pos (numbers)
|
||||
(declare ((vector directed-number) numbers))
|
||||
(loop with pos-limit = (1- (length numbers))
|
||||
with max-value and max-pos
|
||||
for num across numbers
|
||||
for pos from 0
|
||||
do (ecase (dn-direction num)
|
||||
(:left (when (and (plusp pos) (dn> num (aref numbers (1- pos)))
|
||||
(or (null max-value) (dn> num max-value)))
|
||||
(setf max-value num
|
||||
max-pos pos)))
|
||||
(:right (when (and (< pos pos-limit) (dn> num (aref numbers (1+ pos)))
|
||||
(or (null max-value) (dn> num max-value)))
|
||||
(setf max-value num
|
||||
max-pos pos))))
|
||||
finally (return max-pos)))
|
||||
|
||||
(defun permutations (upto)
|
||||
(loop with numbers = (make-directed-numbers-upto upto)
|
||||
for max-mobile-pos = (max-mobile-pos numbers)
|
||||
for sign = 1 then (- sign)
|
||||
do (format t "~A sign: ~:[~;+~]~D~%" numbers (plusp sign) sign)
|
||||
while max-mobile-pos
|
||||
do (let ((max-mobile-number (aref numbers max-mobile-pos)))
|
||||
(ecase (dn-direction max-mobile-number)
|
||||
(:left (rotatef (aref numbers (1- max-mobile-pos))
|
||||
(aref numbers max-mobile-pos)))
|
||||
(:right (rotatef (aref numbers max-mobile-pos)
|
||||
(aref numbers (1+ max-mobile-pos)))))
|
||||
(loop for n across numbers
|
||||
when (dn> n max-mobile-number)
|
||||
do (dn-reverse-direction n)))))
|
||||
|
||||
(permutations 3)
|
||||
(permutations 4)
|
||||
|
|
@ -0,0 +1,67 @@
|
|||
S" fsl-util.fs" REQUIRED
|
||||
S" fsl/dynmem.seq" REQUIRED
|
||||
|
||||
cell darray p{
|
||||
|
||||
: sgn
|
||||
DUP 0 > IF
|
||||
DROP 1
|
||||
ELSE 0 < IF
|
||||
-1
|
||||
ELSE
|
||||
0
|
||||
THEN THEN ;
|
||||
: arr-swap {: addr1 addr2 | tmp -- :}
|
||||
addr1 @ TO tmp
|
||||
addr2 @ addr1 !
|
||||
tmp addr2 ! ;
|
||||
: perms {: n xt | my-i k s -- :}
|
||||
& p{ n 1+ }malloc malloc-fail? ABORT" perms :: out of memory"
|
||||
0 p{ 0 } !
|
||||
n 1+ 1 DO
|
||||
I NEGATE p{ I } !
|
||||
LOOP
|
||||
1 TO s
|
||||
BEGIN
|
||||
1 n 1+ DO
|
||||
p{ I } @ ABS
|
||||
-1 +LOOP
|
||||
n 1+ s xt EXECUTE
|
||||
0 TO k
|
||||
n 1+ 2 DO
|
||||
p{ I } @ 0 < ( flag )
|
||||
p{ I } @ ABS p{ I 1- } @ ABS > ( flag flag )
|
||||
p{ I } @ ABS p{ k } @ ABS > ( flag flag flag )
|
||||
AND AND IF
|
||||
I TO k
|
||||
THEN
|
||||
LOOP
|
||||
n 1 DO
|
||||
p{ I } @ 0 > ( flag )
|
||||
p{ I } @ ABS p{ I 1+ } @ ABS > ( flag flag )
|
||||
p{ I } @ ABS p{ k } @ ABS > ( flag flag flag )
|
||||
AND AND IF
|
||||
I TO k
|
||||
THEN
|
||||
LOOP
|
||||
k IF
|
||||
n 1+ 1 DO
|
||||
p{ I } @ ABS p{ k } @ ABS > IF
|
||||
p{ I } @ NEGATE p{ I } !
|
||||
THEN
|
||||
LOOP
|
||||
p{ k } @ sgn k + TO my-i
|
||||
p{ k } p{ my-i } arr-swap
|
||||
s NEGATE TO s
|
||||
THEN
|
||||
k 0 = UNTIL ;
|
||||
: .perm ( p0 p1 p2 ... pn n s )
|
||||
>R
|
||||
." Perm: [ "
|
||||
1 DO
|
||||
. SPACE
|
||||
LOOP
|
||||
R> ." ] Sign: " . CR ;
|
||||
|
||||
3 ' .perm perms CR
|
||||
4 ' .perm perms
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
' version 31-03-2017
|
||||
' compile with: fbc -s console
|
||||
|
||||
Sub perms(n As ULong)
|
||||
|
||||
Dim As Long p(n), i, k, s = 1
|
||||
|
||||
For i = 1 To n
|
||||
p(i) = -i
|
||||
Next
|
||||
|
||||
Do
|
||||
Print "Perm: [ ";
|
||||
For i = 1 To n
|
||||
Print Abs(p(i)); " ";
|
||||
Next
|
||||
Print "] Sign: "; s
|
||||
|
||||
k = 0
|
||||
For i = 2 To n
|
||||
If p(i) < 0 Then
|
||||
If Abs(p(i)) > Abs(p(i -1)) Then
|
||||
If Abs(p(i)) > Abs(p(k)) Then k = i
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
|
||||
For i = 1 To n -1
|
||||
If p(i) > 0 Then
|
||||
If Abs(p(i)) > Abs(p(i +1)) Then
|
||||
If Abs(p(i)) > Abs(p(k)) Then k = i
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
|
||||
If k Then
|
||||
For i = 1 To n
|
||||
If Abs(p(i)) > Abs(p(k)) Then p(i) = -p(i)
|
||||
Next
|
||||
i = k + Sgn(p(k))
|
||||
Swap p(k), p(i)
|
||||
s = -s
|
||||
End If
|
||||
|
||||
Loop Until k = 0
|
||||
|
||||
End Sub
|
||||
|
||||
' ------=< MAIN >=------
|
||||
|
||||
perms(3)
|
||||
print
|
||||
perms(4)
|
||||
|
||||
' empty keyboard buffer
|
||||
While Inkey <> "" : Wend
|
||||
Print : Print "hit any key to end program"
|
||||
Sleep
|
||||
End
|
||||
|
|
@ -1,14 +1,15 @@
|
|||
s_permutations :: [a] -> [([a], Int)]
|
||||
s_permutations = flip zip (cycle [1, -1]) . (foldl aux [[]])
|
||||
where aux items x = do
|
||||
(f,item) <- zip (cycle [reverse,id]) items
|
||||
f (insertEv x item)
|
||||
insertEv x [] = [[x]]
|
||||
insertEv x l@(y:ys) = (x:l) : map (y:) (insertEv x ys)
|
||||
sPermutations :: [a] -> [([a], Int)]
|
||||
sPermutations = flip zip (cycle [-1, 1]) . foldr aux [[]]
|
||||
where
|
||||
aux x items = do
|
||||
(f, item) <- zip (repeat id) items
|
||||
f (insertEv x item)
|
||||
insertEv x [] = [[x]]
|
||||
insertEv x l@(y:ys) = (x : l) : ((y :) <$> insertEv x ys)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
putStrLn "3 items:"
|
||||
mapM_ print $ s_permutations [0..2]
|
||||
putStrLn "4 items:"
|
||||
mapM_ print $ s_permutations [0..3]
|
||||
mapM_ print $ sPermutations [1 .. 3]
|
||||
putStrLn "\n4 items:"
|
||||
mapM_ print $ sPermutations [1 .. 4]
|
||||
|
|
|
|||
|
|
@ -0,0 +1,68 @@
|
|||
package org.rosettacode.java;
|
||||
|
||||
import java.util.Arrays;
|
||||
import java.util.stream.IntStream;
|
||||
|
||||
public class HeapsAlgorithm {
|
||||
|
||||
public static void main(String[] args) {
|
||||
Object[] array = IntStream.range(0, 4)
|
||||
.boxed()
|
||||
.toArray();
|
||||
HeapsAlgorithm algorithm = new HeapsAlgorithm();
|
||||
algorithm.recursive(array);
|
||||
System.out.println();
|
||||
algorithm.loop(array);
|
||||
}
|
||||
|
||||
void recursive(Object[] array) {
|
||||
recursive(array, array.length, true);
|
||||
}
|
||||
|
||||
void recursive(Object[] array, int n, boolean plus) {
|
||||
if (n == 1) {
|
||||
output(array, plus);
|
||||
} else {
|
||||
for (int i = 0; i < n; i++) {
|
||||
recursive(array, n - 1, i == 0);
|
||||
swap(array, n % 2 == 0 ? i : 0, n - 1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void output(Object[] array, boolean plus) {
|
||||
System.out.println(Arrays.toString(array) + (plus ? " +1" : " -1"));
|
||||
}
|
||||
|
||||
void swap(Object[] array, int a, int b) {
|
||||
Object o = array[a];
|
||||
array[a] = array[b];
|
||||
array[b] = o;
|
||||
}
|
||||
|
||||
void loop(Object[] array) {
|
||||
loop(array, array.length);
|
||||
}
|
||||
|
||||
void loop(Object[] array, int n) {
|
||||
int[] c = new int[n];
|
||||
output(array, true);
|
||||
boolean plus = false;
|
||||
for (int i = 0; i < n; ) {
|
||||
if (c[i] < i) {
|
||||
if (i % 2 == 0) {
|
||||
swap(array, 0, i);
|
||||
} else {
|
||||
swap(array, c[i], i);
|
||||
}
|
||||
output(array, plus);
|
||||
plus = !plus;
|
||||
c[i]++;
|
||||
i = 0;
|
||||
} else {
|
||||
c[i] = 0;
|
||||
i++;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
// version 1.1.2
|
||||
|
||||
fun johnsonTrotter(n: Int): Pair<List<IntArray>, List<Int>> {
|
||||
val p = IntArray(n) { it } // permutation
|
||||
val q = IntArray(n) { it } // inverse permutation
|
||||
val d = IntArray(n) { -1 } // direction = 1 or -1
|
||||
var sign = 1
|
||||
val perms = mutableListOf<IntArray>()
|
||||
val signs = mutableListOf<Int>()
|
||||
|
||||
fun permute(k: Int) {
|
||||
if (k >= n) {
|
||||
perms.add(p.copyOf())
|
||||
signs.add(sign)
|
||||
sign *= -1
|
||||
return
|
||||
}
|
||||
permute(k + 1)
|
||||
for (i in 0 until k) {
|
||||
val z = p[q[k] + d[k]]
|
||||
p[q[k]] = z
|
||||
p[q[k] + d[k]] = k
|
||||
q[z] = q[k]
|
||||
q[k] += d[k]
|
||||
permute(k + 1)
|
||||
}
|
||||
d[k] *= -1
|
||||
}
|
||||
|
||||
permute(0)
|
||||
return perms to signs
|
||||
}
|
||||
|
||||
fun printPermsAndSigns(perms: List<IntArray>, signs: List<Int>) {
|
||||
for ((i, perm) in perms.withIndex()) {
|
||||
println("${perm.contentToString()} -> sign = ${signs[i]}")
|
||||
}
|
||||
}
|
||||
|
||||
fun main(args: Array<String>) {
|
||||
val (perms, signs) = johnsonTrotter(3)
|
||||
printPermsAndSigns(perms, signs)
|
||||
println()
|
||||
val (perms2, signs2) = johnsonTrotter(4)
|
||||
printPermsAndSigns(perms2, signs2)
|
||||
}
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
function spermutations(integer p, integer i)
|
||||
-- generate the i'th permutation of [1..p]:
|
||||
-- first obtain the appropriate permutation of [1..p-1],
|
||||
-- then insert p/move it down k(=0..p-1) places from the end.
|
||||
integer k = mod(i-1,2*p)
|
||||
if k>=p then k=2*p-1-k end if
|
||||
sequence res
|
||||
integer parity
|
||||
if p>1 then
|
||||
{res,parity} = spermutations(p-1,floor((i-1)/p)+1)
|
||||
res = res[1..length(res)-k]&p&res[length(res)-k+1..$]
|
||||
else
|
||||
res = {1}
|
||||
end if
|
||||
return {res,iff(and_bits(i,1)?1:-1)}
|
||||
end function
|
||||
|
||||
for p=1 to 4 do
|
||||
printf(1,"==%d==\n",p)
|
||||
for i=1 to factorial(p) do
|
||||
?{i,spermutations(p,i)}
|
||||
end for
|
||||
end for
|
||||
|
|
@ -1,20 +1,20 @@
|
|||
func perms(n) {
|
||||
var perms = [[+1]]
|
||||
n.times { |x|
|
||||
var sign = -1;
|
||||
for x in (1..n) {
|
||||
var sign = -1
|
||||
perms = gather {
|
||||
for s,*p in perms {
|
||||
var r = (0 .. p.len);
|
||||
var r = (0 .. p.len)
|
||||
take((s < 0 ? r : r.flip).map {|i|
|
||||
[sign *= -1, p[0..i-1], x, p[i..p.end]]
|
||||
[sign *= -1, p[^i], x, p[i..p.end]]
|
||||
}...)
|
||||
}
|
||||
}
|
||||
}
|
||||
perms;
|
||||
perms
|
||||
}
|
||||
|
||||
var n = 4;
|
||||
var n = 4
|
||||
for p in perms(n) {
|
||||
var s = p.shift
|
||||
s > 0 && (s = '+1')
|
||||
|
|
|
|||
|
|
@ -0,0 +1,13 @@
|
|||
fcn permute(seq)
|
||||
{
|
||||
insertEverywhere := fcn(x,list){ //(x,(a,b))-->((x,a,b),(a,x,b),(a,b,x))
|
||||
(0).pump(list.len()+1,List,'wrap(n){list[0,n].extend(x,list[n,*]) })};
|
||||
insertEverywhereB := fcn(x,t){ //--> insertEverywhere().reverse()
|
||||
[t.len()..-1,-1].pump(t.len()+1,List,'wrap(n){t[0,n].extend(x,t[n,*])})};
|
||||
|
||||
seq.reduce('wrap(items,x){
|
||||
f := Utils.Helpers.cycle(insertEverywhereB,insertEverywhere);
|
||||
items.pump(List,'wrap(item){f.next()(x,item)},
|
||||
T.fp(Void.Write,Void.Write));
|
||||
},T(T));
|
||||
}
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
p := permute(T(1,2,3));
|
||||
p.println();
|
||||
|
||||
p := permute([1..4]);
|
||||
p.len().println();
|
||||
p.toString(*).println()
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
fcn [private] _permuteW(seq){ // lazy version
|
||||
N:=seq.len(); NM1:=N-1;
|
||||
ds:=(0).pump(N,List,T(Void,-1)).copy(); ds[0]=0; // direction to move e: -1,0,1
|
||||
es:=(0).pump(N,List).copy(); // enumerate seq
|
||||
|
||||
while(1) {
|
||||
vm.yield(es.pump(List,seq.__sGet));
|
||||
|
||||
// find biggest e with d!=0
|
||||
reg i=Void, c=-1;
|
||||
foreach n in (N){ if(ds[n] and es[n]>c) { c=es[n]; i=n; } }
|
||||
if(Void==i) return();
|
||||
|
||||
d:=ds[i]; j:=i+d;
|
||||
es.swap(i,j); ds.swap(i,j); // d tracks e
|
||||
if(j==NM1 or j==0 or es[j+d]>c) ds[j]=0;
|
||||
foreach e in (N){ if(es[e]>c) ds[e]=(i-e).sign }
|
||||
}
|
||||
}
|
||||
|
||||
fcn permuteW(seq) { Utils.Generator(_permuteW,seq) }
|
||||
|
|
@ -0,0 +1 @@
|
|||
foreach p in (permuteW(T("a","b","c"))){ println(p) }
|
||||
Loading…
Add table
Add a link
Reference in a new issue