2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,15 +1,21 @@
|
|||
;Task:
|
||||
Generate permutations of n items in which successive permutations differ from each other by the swapping of any two items.
|
||||
|
||||
Also generate the sign of the permutation which is +1 when the permutation is generated from an even number of swaps from the initial state, and -1 for odd.
|
||||
|
||||
Show the permutations and signs of three items, in order of generation ''here''.
|
||||
|
||||
Such data are of use in generating the [[Matrix arithmetic|determinant]] of a square matrix and any functions created should bear this in mind.
|
||||
|
||||
Note: The Steinhaus–Johnson–Trotter algorithm generates successive permutations where ''adjacent'' items are swapped, but from [[wp:Parity_of_a_permutation#Example|this]] discussion adjacency is not a requirement.
|
||||
|
||||
|
||||
;References:
|
||||
* [[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.
|
||||
|
||||
;Cf.:
|
||||
* [[Matrix arithmetic]]
|
||||
|
||||
;Related task:
|
||||
* [[Matrix arithmetic]]
|
||||
<br><br>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,62 @@
|
|||
(ns test-p.core)
|
||||
|
||||
(defn numbers-only [x]
|
||||
" Just shows the numbers only for the pairs (i.e. drops the direction --used for display purposes when printing the result"
|
||||
(mapv first x))
|
||||
|
||||
(defn next-permutation
|
||||
" Generates next permutation from the current (p) using the Johnson-Trotter technique
|
||||
The code below translates the Python version which has the following steps:
|
||||
p of form [...[n dir]...] such as [[0 1] [1 1] [2 -1]], where n is a number and dir = direction (=1=right, -1=left, 0=don't move)
|
||||
Step: 1 finds the pair [n dir] with the largest value of n (where dir is not equal to 0 (done if none)
|
||||
Step: 2: swap the max pair found with its neighbor in the direction of the pair (i.e. +1 means swap to right, -1 means swap left
|
||||
Step 3: if swapping places the pair a the beginning or end of the list, set the direction = 0 (i.e. becomes non-mobile)
|
||||
Step 4: Set the directions of all pairs whose numbers are greater to the right of where the pair was moved to -1 and to the left to +1 "
|
||||
[p]
|
||||
(if (every? zero? (map second p))
|
||||
nil ; no mobile elements (all directions are zero)
|
||||
(let [n (count p)
|
||||
; Step 1
|
||||
fn-find-max (fn [m]
|
||||
(first (apply max-key ; find the max mobile elment
|
||||
(fn [[i x]]
|
||||
(if (zero? (second x))
|
||||
-1
|
||||
(first x)))
|
||||
(map-indexed vector p))))
|
||||
i1 (fn-find-max p) ; index of max
|
||||
[n1 d1] (p i1) ; value and direction of max
|
||||
i2 (+ d1 i1)
|
||||
fn-swap (fn [m] (assoc m i2 (m i1) i1 (m i2))) ; function to swap with neighbor in our step direction
|
||||
fn-update-max (fn [m] (if (or (contains? #{0 (dec n)} i2) ; update direction of max (where max went)
|
||||
(> ((m (+ i2 d1)) 0) n1))
|
||||
(assoc-in m [i2 1] 0)
|
||||
m))
|
||||
fn-update-others (fn [[i3 [n3 d3]]] ; Updates directions of pairs to the left and right of max
|
||||
(cond ; direction reset to -1 if to right, +1 if to left
|
||||
(<= n3 n1) [n3 d3]
|
||||
(< i3 i2) [n3 1]
|
||||
:else [n3 -1]))]
|
||||
; apply steps 2, 3, 4(using functions that where created for these steps)
|
||||
(mapv fn-update-others (map-indexed vector (fn-update-max (fn-swap p)))))))
|
||||
|
||||
(defn spermutations
|
||||
" Lazy sequence of permutations of n digits"
|
||||
; Each element is two element vector (number direction)
|
||||
; Startup case - generates sequence 0...(n-1) with move direction (1 = move right, -1 = move left, 0 = don't move)
|
||||
([n] (spermutations 1
|
||||
(into [] (for [i (range n)] (if (zero? i)
|
||||
[i 0] ; 0th element is not mobile yet
|
||||
[i -1]))))) ; all others move left
|
||||
([sign p]
|
||||
(when-let [s (seq p)]
|
||||
(cons [(numbers-only p) sign]
|
||||
(spermutations (- sign) (next-permutation p)))))) ; recursively tag onto sequence
|
||||
|
||||
|
||||
;; Print results for 2, 3, and 4 items
|
||||
(doseq [n (range 2 5)]
|
||||
(do
|
||||
(println)
|
||||
(println (format "Permutations and sign of %d items " n))
|
||||
(doseq [q (spermutations n)] (println (format "Perm: %s Sign: %2d" (first q) (second q))))))
|
||||
|
|
@ -4,7 +4,7 @@ s_permutations = flip zip (cycle [1, -1]) . (foldl aux [[]])
|
|||
(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
|
||||
insertEv x l@(y:ys) = (x:l) : map (y:) (insertEv x ys)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
|
|
|||
|
|
@ -0,0 +1,41 @@
|
|||
_JT={}
|
||||
function JT(dim)
|
||||
local n={ values={}, positions={}, directions={}, sign=1 }
|
||||
setmetatable(n,{__index=_JT})
|
||||
for i=1,dim do
|
||||
n.values[i]=i
|
||||
n.positions[i]=i
|
||||
n.directions[i]=-1
|
||||
end
|
||||
return n
|
||||
end
|
||||
|
||||
function _JT:largestMobile()
|
||||
for i=#self.values,1,-1 do
|
||||
local loc=self.positions[i]+self.directions[i]
|
||||
if loc >= 1 and loc <= #self.values and self.values[loc] < i then
|
||||
return i
|
||||
end
|
||||
end
|
||||
return 0
|
||||
end
|
||||
|
||||
function _JT:next()
|
||||
local r=self:largestMobile()
|
||||
if r==0 then return false end
|
||||
local rloc=self.positions[r]
|
||||
local lloc=rloc+self.directions[r]
|
||||
local l=self.values[lloc]
|
||||
self.values[lloc],self.values[rloc] = self.values[rloc],self.values[lloc]
|
||||
self.positions[l],self.positions[r] = self.positions[r],self.positions[l]
|
||||
self.sign=-self.sign
|
||||
for i=r+1,#self.directions do self.directions[i]=-self.directions[i] end
|
||||
return true
|
||||
end
|
||||
|
||||
-- test
|
||||
|
||||
perm=JT(4)
|
||||
repeat
|
||||
print(unpack(perm.values))
|
||||
until not perm:next()
|
||||
|
|
@ -1,53 +1,52 @@
|
|||
/*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 ? */
|
||||
call permSets things, bunch /*invoke permutations by swapping sub. */
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────one─liner subroutines─────────────────────*/
|
||||
!: procedure; !=1; do j=2 to arg(1); !=!*j; end; 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*/
|
||||
/*──────────────────────────────────PERMSETS subroutine───────────────────────*/
|
||||
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 syms.*/
|
||||
@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*/
|
||||
#=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.*/
|
||||
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)
|
||||
/*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 ? */
|
||||
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*/
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
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*/
|
||||
#=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.*/
|
||||
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)
|
||||
|
||||
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. */
|
||||
?= /*begin this with a blank (null) slate.*/
|
||||
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 'un.*/
|
||||
_=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 /*$*/
|
||||
return /*we're all finished with permutating. */
|
||||
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 /*$*/
|
||||
return /*we're all finished with permutating. */
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue