June 2018 Update

This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions

View file

@ -17,7 +17,7 @@ Note: The SteinhausJohnsonTrotter algorithm generates successive permutati
* [http://www.gutenberg.org/files/18567/18567-h/18567-h.htm#ch7] Tintinnalogia
;Related task:
;Related tasks:
*   [[Matrix arithmetic]]
*   [[Gray code]]
<br><br>

View file

@ -0,0 +1,69 @@
/*Abhishek Ghosh, 25th October 2017*/
#include<stdlib.h>
#include<string.h>
#include<stdio.h>
int flag = 1;
void heapPermute(int n, int arr[],int arrLen){
int temp;
int i;
if(n==1){
printf("\n[");
for(i=0;i<arrLen;i++)
printf("%d,",arr[i]);
printf("\b] Sign : %d",flag);
flag*=-1;
}
else{
for(i=0;i<n-1;i++){
heapPermute(n-1,arr,arrLen);
if(n%2==0){
temp = arr[i];
arr[i] = arr[n-1];
arr[n-1] = temp;
}
else{
temp = arr[0];
arr[0] = arr[n-1];
arr[n-1] = temp;
}
}
heapPermute(n-1,arr,arrLen);
}
}
int main(int argC,char* argV[0])
{
int *arr, i=0, count = 1;
char* token;
if(argC==1)
printf("Usage : %s <comma separated list of integers>",argV[0]);
else{
while(argV[1][i]!=00){
if(argV[1][i++]==',')
count++;
}
arr = (int*)malloc(count*sizeof(int));
i = 0;
token = strtok(argV[1],",");
while(token!=NULL){
arr[i++] = atoi(token);
token = strtok(NULL,",");
}
heapPermute(i,arr,count);
}
return 0;
}

View file

@ -1,5 +1,37 @@
(defn permutations [a-set]
(cond (empty? a-set) '(())
(empty? (rest a-set)) (list (apply list a-set))
:else (for [x a-set y (permutations (remove #{x} a-set))]
(cons x y))))
(defn permutation-swaps
"List of swap indexes to generate all permutations of n elements"
[n]
(if (= n 2) `((0 1))
(let [old-swaps (permutation-swaps (dec n))
swaps-> (partition 2 1 (range n))
swaps<- (reverse swaps->)]
(mapcat (fn [old-swap side]
(case side
:first swaps<-
:right (conj swaps<- old-swap)
:left (conj swaps-> (map inc old-swap))))
(conj old-swaps nil)
(cons :first (cycle '(:left :right)))))))
(defn swap [v [i j]]
(-> v
(assoc i (nth v j))
(assoc j (nth v i))))
(defn permutations [n]
(let [permutations (reduce
(fn [all-perms new-swap]
(conj all-perms (swap (last all-perms)
new-swap)))
(vector (vec (range n)))
(permutation-swaps n))
output (map vector
permutations
(cycle '(1 -1)))]
output))
(doseq [n [2 3 4]]
(dorun (map println (permutations n))))

View file

@ -0,0 +1,58 @@
function johnsontrottermove!(ints, isleft)
len = length(ints)
function ismobile(pos)
if isleft[pos] && (pos > 1) && (ints[pos-1] < ints[pos])
return true
elseif !isleft[pos] && (pos < len) && (ints[pos+1] < ints[pos])
return true
end
false
end
function maxmobile()
arr = [ints[pos] for pos in 1:len if ismobile(pos)]
if isempty(arr)
0, 0
else
maxmob = maximum(arr)
maxmob, findfirst(x -> x == maxmob, ints)
end
end
function directedswap(pos)
tmp = ints[pos]
tmpisleft = isleft[pos]
if isleft[pos]
ints[pos] = ints[pos-1]; ints[pos-1] = tmp
isleft[pos] = isleft[pos-1]; isleft[pos-1] = tmpisleft
else
ints[pos] = ints[pos+1]; ints[pos+1] = tmp
isleft[pos] = isleft[pos+1]; isleft[pos+1] = tmpisleft
end
end
(moveint, movepos) = maxmobile()
if movepos > 0
directedswap(movepos)
for (i, val) in enumerate(ints)
if val > moveint
isleft[i] = !isleft[i]
end
end
ints, isleft, true
else
ints, isleft, false
end
end
function johnsontrotter(low, high)
ints = collect(low:high)
isleft = [true for i in ints]
firstconfig = copy(ints)
iters = 0
while true
iters += 1
println("$ints $(iters & 1 == 1 ? "+1" : "-1")")
if johnsontrottermove!(ints, isleft)[3] == false
break
end
end
println("There were $iters iterations.")
end
johnsontrotter(1,4)

View file

@ -0,0 +1,23 @@
function johnsontrotter(low, high)
function permutelevel(vec)
if length(vec) < 2
return [vec]
end
sequences = []
endint = vec[end]
smallersequences = permutelevel(vec[1:end-1])
leftward = true
for seq in smallersequences
for pos in (leftward ? (length(seq)+1:-1:1): (1:length(seq)+1))
push!(sequences, insert!(copy(seq), pos, endint))
end
leftward = !leftward
end
sequences
end
permutelevel(collect(low:high))
end
for (i, sequence) in enumerate(johnsontrotter(1,4))
println("""$sequence, $(i & 1 == 1 ? "+1" : "-1")""")
end

View file

@ -0,0 +1,21 @@
local wrap, yield = coroutine.wrap, coroutine.yield
local function perm(n)
local r = {}
for i=1,n do r[i]=i end
local sign = 1
return wrap(function()
local function swap(m)
if m==0 then
sign = -sign, yield(sign,r)
else
for i=m,1,-1 do
r[i],r[m]=r[m],r[i]
swap(m-1)
r[i],r[m]=r[m],r[i]
end
end
end
swap(n)
end)
end
for sign,r in perm(3) do print(sign,table.unpack(r))end

View file

@ -1,52 +1,46 @@
/*REXX program generates all permutations of N different objects by swapping. */
parse arg things bunch . /*get optional arguments from the C.L. */
things = p(things 4) /*should use the default for THINGS ? */
bunch = p(bunch things) /* " " " " " BUNCH ? */
/*REXX program generates all permutations of N different objects by swapping. */
parse arg things bunch . /*obtain optional arguments from the CL*/
if things=='' | things=="," then things=4 /*Not specified? Then use the default.*/
if bunch =='' | bunch =="," then bunch =things /* " " " " " " */
call permSets things, bunch /*invoke permutations by swapping sub. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
!: procedure; !=1; do j=2 to arg(1); !=!*j; end /*j*/; return !
c: return substr(arg(1), arg(2), 1) /*pick a single character from a string*/
p: return word(arg(1), 1) /*pick 1st word (or number) from a list*/
!: procedure; !=1; do j=2 to arg(1); !=!*j; end; return !
/*──────────────────────────────────────────────────────────────────────────────────────*/
permSets: procedure; parse arg x,y /*take X things Y at a time. */
!.=0; pad=left('',x*y) /*Note: X can't be > length(@0abcs). */
@abc = 'abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU /*build symbols*/
@abcS= @abcU || @abc; @0abcS=123456789 || @abcS /* ··· and more*/
z= /*define Z to be a null value for start*/
do i=1 for x /*build list of (permutation) symbols. */
z=z || c(@0abcS, i) /*append the char to the symbol list. */
end /*i*/
!.=0; pad=left('', x*y) /*X can't be > length of below str (62)*/
z=left('123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ', x); q=z
#=1 /*the number of permutations (so far).*/
!.z=1; q=z; s=1; times=!(x)% !(x-y) /*calculate (#) TIMES using factorial.*/
w=max(length(z), length('permute')) /*maximum width of Z and also PERMUTE.*/
!.z=1; s=1; times=!(x) % !(x-y) /*calculate (#) TIMES using factorial.*/
w=max(length(z), length('permute') ) /*maximum width of Z and also PERMUTE.*/
say center('permutations for ' x ' things taken ' y " at a time",60,'')
say
say pad 'permutation' center("permute", w, '') "sign"
say pad '' center("───────", w, '') "────"
say pad center(#, 11) center(z , w) right(s, 4-1)
say pad 'permutation' center("permute", w, '') "sign"
say pad '' center("───────", w, '') "────"
say pad center(#, 11) center(z , w) right(s, 4-1)
do $=1 until #==times /*perform permutation until # of times.*/
do k=1 for x-1 /*step thru things for things-1 times.*/
do m=k+1 to x; ?= /*this method doesn't use adjacency. */
do n=1 for x /*build the new permutation by swapping*/
if n\==k & n\==m then ? = ? || c(z, n)
else if n==k then ? = ? || c(z, m)
else ? = ? || c(z, k)
end /*n*/
z=? /*save this permutation for next swap. */
if !.? then iterate m /*if defined before, then try next one.*/
_=0 /* [↓] count number of swapped symbols*/
do d=1 for x while $\==1; _=_+(c(?,d)\==c(prev,d)); end /*d*/
if _>2 then do; _=z
a=$//x+1; q=q+_ /* [← ↓] this swapping tries adjacency*/
b=q//x+1; if b==a then b=a+1; if b>x then b=a-1
z=overlay(c(z, b), overlay(c(z, a), _, b), a)
iterate $ /*now, try this particular permutation.*/
end
#=#+1; s=-s; say pad center(#,11) center(?,w) right(s,4-1)
!.?=1; prev=?; iterate $ /*now, try another swapped permutation.*/
end /*m*/
end /*k*/
end /*$*/
do $=1 until #==times /*perform permutation until # of times.*/
do k=1 for x-1 /*step thru things for things-1 times.*/
do m=k+1 to x; ?= /*this method doesn't use adjacency. */
do n=1 for x /*build the new permutation by swapping*/
if n\==k & n\==m then ? = ? || substr(z, n, 1)
else if n==k then ? = ? || substr(z, m, 1)
else ? = ? || substr(z, k, 1)
end /*n*/
z=? /*save this permutation for next swap. */
if !.? then iterate m /*if defined before, then try next one.*/
_=0 /* [↓] count number of swapped symbols*/
do d=1 for x while $\==1; _= _ + (substr(?,d,1)\==substr(prev,d,1))
end /*d*/
if _>2 then do; _=z
a=$//x+1; q=q + _ /* [← ↓] this swapping tries adjacency*/
b=q//x+1; if b==a then b=a + 1; if b>x then b=a - 1
z=overlay( substr(z,b,1), overlay( substr(z,a,1), _, b), a)
iterate $ /*now, try this particular permutation.*/
end
#=#+1; s= -s; say pad center(#, 11) center(?, w) right(s, 4-1)
!.?=1; prev=?; iterate $ /*now, try another swapped permutation.*/
end /*m*/
end /*k*/
end /*$*/
return /*we're all finished with permutating. */

View file

@ -0,0 +1,36 @@
object JohnsonTrotter extends App {
private def perm(n: Int): Unit = {
val p = new Array[Int](n) // permutation
val pi = new Array[Int](n) // inverse permutation
val dir = new Array[Int](n) // direction = +1 or -1
def perm(n: Int, p: Array[Int], pi: Array[Int], dir: Array[Int]): Unit = {
if (n >= p.length) for (aP <- p) print(aP)
else {
perm(n + 1, p, pi, dir)
for (i <- 0 until n) { // swap
printf(" (%d %d)\n", pi(n), pi(n) + dir(n))
val z = p(pi(n) + dir(n))
p(pi(n)) = z
p(pi(n) + dir(n)) = n
pi(z) = pi(n)
pi(n) = pi(n) + dir(n)
perm(n + 1, p, pi, dir)
}
dir(n) = -dir(n)
}
}
for (i <- 0 until n) {
dir(i) = -1
p(i) = i
pi(i) = i
}
perm(0, p, pi, dir)
print(" (0 1)\n")
}
perm(4)
}