Another update from ingydotnet^djgoku
This commit is contained in:
Ingy döt Net
parent
91df62d461
commit
948b86eafa
7604 changed files with 108452 additions and 22726 deletions
|
|
@ -1,4 +1,6 @@
|
|||
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''.
|
||||
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.
|
||||
|
||||
|
|
@ -7,6 +9,7 @@ Note: The Steinhaus–Johnson–Trotter algorithm generates successive permutati
|
|||
;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]]
|
||||
|
|
|
|||
|
|
@ -0,0 +1,10 @@
|
|||
Permutations_By_Swapping(str, list:=""){
|
||||
ch := SubStr(str, 1, 1) ; get left-most charachter of str
|
||||
for i, line in StrSplit(list, "`n") ; for each line in list
|
||||
loop % StrLen(line) + 1 ; loop each possible position
|
||||
Newlist .= RegExReplace(line, mod(i,2) ? "(?=.{" A_Index-1 "}$)" : "^.{" A_Index-1 "}\K", ch) "`n"
|
||||
list := Newlist ? Trim(Newlist, "`n") : ch ; recreate list
|
||||
if !str := SubStr(str, 2) ; remove charachter from left hand side
|
||||
return list ; done if str is empty
|
||||
return Permutations_By_Swapping(str, list) ; else recurse
|
||||
}
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
for each, line in StrSplit(Permutations_By_Swapping(1234), "`n")
|
||||
result .= line "`tSign: " (mod(A_Index,2)? 1 : -1) "`n"
|
||||
MsgBox, 262144, , % result
|
||||
return
|
||||
|
|
@ -1,121 +1,62 @@
|
|||
/*
|
||||
The following code generates the permutations of the first 4 natural numbers.
|
||||
The permutations are displayed in lexical order, smallest to largest, with appropriate signs
|
||||
*/
|
||||
|
||||
#include <iostream>
|
||||
#include <conio.h>
|
||||
#include <vector>
|
||||
|
||||
//factorial function
|
||||
long
|
||||
fact(int size)
|
||||
using namespace std;
|
||||
|
||||
vector<int> UpTo(int n, int offset = 0)
|
||||
{
|
||||
int i;
|
||||
long tmp = 1;
|
||||
|
||||
if(size<=1)
|
||||
return 1;
|
||||
else
|
||||
for(i = size;i > 0;i--)
|
||||
tmp *= i;
|
||||
return tmp;
|
||||
vector<int> retval(n);
|
||||
for (int ii = 0; ii < n; ++ii)
|
||||
retval[ii] = ii + offset;
|
||||
return retval;
|
||||
}
|
||||
|
||||
|
||||
//function to display the permutations.
|
||||
void
|
||||
Permutations(int N)
|
||||
struct JohnsonTrotterState_
|
||||
{
|
||||
//indicates sign
|
||||
short sign = 1;
|
||||
vector<int> values_;
|
||||
vector<int> positions_; // size is n+1, first element is not used
|
||||
vector<bool> directions_;
|
||||
int sign_;
|
||||
|
||||
//Tracks when to change sign.
|
||||
unsigned short change_sign = 0;
|
||||
JohnsonTrotterState_(int n) : values_(UpTo(n, 1)), positions_(UpTo(n + 1, -1)), directions_(n + 1, false), sign_(1) {}
|
||||
|
||||
//loop variables
|
||||
short i = 0,j = 0,k = 0;
|
||||
|
||||
//iterations
|
||||
long loops = fact(N);
|
||||
|
||||
//Array of pointers to hold the digits
|
||||
int **Index_Nos_ptr = new int*[N];
|
||||
|
||||
//Repetition of each digit (Master copy)
|
||||
int *Digit_Rep_Master = new int[N];
|
||||
|
||||
//Repetition of each digit (Local copy)
|
||||
int *Digit_Rep_Local = new int[N];
|
||||
|
||||
//Index for Index_Nos_ptr
|
||||
int *Element_Num = new int[N];
|
||||
|
||||
|
||||
//Initialization
|
||||
for(i = 0;i < N;i++){
|
||||
//Allocate memory to hold the subsequent digits in the form of a LUT
|
||||
//For N = N, memory required for LUT = N(N+1)/2
|
||||
Index_Nos_ptr[i] = new int[N-i];
|
||||
|
||||
//Initialise the repetition value of each digit (Master and Local)
|
||||
//Each digit repeats for (i-1)!, where 1 is the position of the digit
|
||||
Digit_Rep_Local[i] = Digit_Rep_Master[i] = fact(N-i-1);
|
||||
|
||||
//Initialise index values to access the arrays
|
||||
Element_Num[i] = N-i-1;
|
||||
|
||||
//Initialise the arrays with the required digits
|
||||
for(j = 0;j < N-i;j++)
|
||||
*(Index_Nos_ptr[i] +j) = N-j-1;
|
||||
int LargestMobile() const // returns 0 if no mobile integer exists
|
||||
{
|
||||
for (int r = values_.size(); r > 0; --r)
|
||||
{
|
||||
const int loc = positions_[r] + (directions_[r] ? 1 : -1);
|
||||
if (loc >= 0 && loc < values_.size() && values_[loc] < r)
|
||||
return r;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
while(loops-- > 0){
|
||||
std::cout << "Perm: [";
|
||||
for(i = 0;i < N;i++){
|
||||
//Print from MSD to LSD
|
||||
std::cout << " " << *(Index_Nos_ptr[i] + Element_Num[i]);
|
||||
|
||||
//Decrement the repetition count for each digit
|
||||
if(--Digit_Rep_Local[i] <= 0){
|
||||
//Refill the repitition factor
|
||||
Digit_Rep_Local[i] = Digit_Rep_Master[i];
|
||||
|
||||
//And the index to access the required digit is also 0...
|
||||
if(Element_Num[i] <= 0 && i != 0){
|
||||
//Reset the index
|
||||
Element_Num[i] = N-i-1;
|
||||
|
||||
//Update the numbers held in Index_Nos_ptr[]
|
||||
for(j = 0,k = 0;j <= N-i;j++){
|
||||
//Exclude the preceeding digit (from the previous array) already printed.
|
||||
if(j != Element_Num[i-1]){
|
||||
*(Index_Nos_ptr[i]+k)= *(Index_Nos_ptr[i-1]+j);
|
||||
k++;
|
||||
}
|
||||
}
|
||||
}else
|
||||
//Decrement the index value so as to print the appropriate digit
|
||||
//in the same array
|
||||
Element_Num[i]--;
|
||||
}
|
||||
}
|
||||
std::cout<<"] Sign: "<< sign <<"\n";
|
||||
|
||||
if(!(change_sign-- > 0)){
|
||||
//Update the sign value.
|
||||
sign = -sign;
|
||||
|
||||
change_sign = 1;
|
||||
}
|
||||
bool IsComplete() const { return LargestMobile() == 0; }
|
||||
|
||||
void operator++() // implement Johnson-Trotter algorithm
|
||||
{
|
||||
const int r = LargestMobile();
|
||||
const int rLoc = positions_[r];
|
||||
const int lLoc = rLoc + (directions_[r] ? 1 : -1);
|
||||
const int l = values_[lLoc];
|
||||
// do the swap
|
||||
swap(values_[lLoc], values_[rLoc]);
|
||||
swap(positions_[l], positions_[r]);
|
||||
sign_ = -sign_;
|
||||
// change directions
|
||||
for (auto pd = directions_.begin() + r + 1; pd != directions_.end(); ++pd)
|
||||
*pd = !*pd;
|
||||
}
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
int
|
||||
main()
|
||||
int main(void)
|
||||
{
|
||||
Permutations(4);
|
||||
getch();
|
||||
return 0;
|
||||
JohnsonTrotterState_ state(4);
|
||||
do
|
||||
{
|
||||
for (auto v : state.values_)
|
||||
cout << v << " ";
|
||||
cout << "\n";
|
||||
++state;
|
||||
} while (!state.IsComplete());
|
||||
}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,5 @@
|
|||
(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))))
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
defmodule Permutation do
|
||||
def by_swap(n) do
|
||||
p = Enum.to_list(0..-n) |> List.to_tuple
|
||||
by_swap(n, p, 1)
|
||||
end
|
||||
|
||||
defp by_swap(n, p, s) do
|
||||
IO.puts "Perm: #{inspect for i <- 1..n, do: abs(elem(p,i))} Sign: #{s}"
|
||||
k = 0 |> step_up(n, p) |> step_down(n, p)
|
||||
if k > 0 do
|
||||
pk = elem(p,k)
|
||||
i = if pk>0, do: k+1, else: k-1
|
||||
p = Enum.reduce(1..n, p, fn i,acc ->
|
||||
if abs(elem(p,i)) > abs(pk), do: put_elem(acc, i, -elem(acc,i)), else: acc
|
||||
end)
|
||||
pi = elem(p,i)
|
||||
p = put_elem(p,i,pk) |> put_elem(k,pi) # swap
|
||||
by_swap(n, p, -s)
|
||||
end
|
||||
end
|
||||
|
||||
defp step_up(k, n, p) do
|
||||
Enum.reduce(2..n, k, fn i,acc ->
|
||||
if elem(p,i)<0 and abs(elem(p,i))>abs(elem(p,i-1)) and abs(elem(p,i))>abs(elem(p,acc)),
|
||||
do: i, else: acc
|
||||
end)
|
||||
end
|
||||
|
||||
defp step_down(k, n, p) do
|
||||
Enum.reduce(1..n-1, k, fn i,acc ->
|
||||
if elem(p,i)>0 and abs(elem(p,i))>abs(elem(p,i+1)) and abs(elem(p,i))>abs(elem(p,acc)),
|
||||
do: i, else: acc
|
||||
end)
|
||||
end
|
||||
end
|
||||
|
||||
Enum.each(3..4, fn n ->
|
||||
Permutation.by_swap(n)
|
||||
IO.puts ""
|
||||
end)
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
sub insert($x, @xs) { [@xs[0..$_-1], $x, @xs[$_..*]] for 0..+@xs }
|
||||
sub insert($x, @xs) { ([flat @xs[0 ..^ $_], $x, @xs[$_ .. *]] for 0 .. +@xs) }
|
||||
sub order($sg, @xs) { $sg > 0 ?? @xs !! @xs.reverse }
|
||||
|
||||
multi perms([]) {
|
||||
|
|
@ -6,7 +6,7 @@ multi perms([]) {
|
|||
}
|
||||
|
||||
multi perms([$x, *@xs]) {
|
||||
perms(@xs).map({ order($_.value, insert($x, $_.key)) }) Z=> (+1,-1) xx *
|
||||
perms(@xs).map({ |order($_.value, insert($x, $_.key)) }) Z=> |(+1,-1) xx *
|
||||
}
|
||||
|
||||
.say for perms([0..2]);
|
||||
|
|
|
|||
|
|
@ -0,0 +1,42 @@
|
|||
function permutation ($array) {
|
||||
function sign($A) {
|
||||
$size = $A.Count
|
||||
$sign = 1
|
||||
for($i = 0; $i -lt $size; $i++) {
|
||||
for($j = $i+1; $j -lt $size ; $j++) {
|
||||
if($A[$j] -lt $A[$i]) { $sign *= -1}
|
||||
}
|
||||
}
|
||||
$sign
|
||||
}
|
||||
function generate($n, $A, $i1, $i2, $cnt) {
|
||||
if($n -eq 1) {
|
||||
if($cnt -gt 0) {
|
||||
"$A -- swapped positions: $i1 $i2 -- sign = $(sign $A)`n"
|
||||
} else {
|
||||
"$A -- sign = $(sign $A)`n"
|
||||
}
|
||||
}
|
||||
else{
|
||||
for( $i = 0; $i -lt ($n - 1); $i += 1) {
|
||||
generate ($n - 1) $A $i1 $i2 $cnt
|
||||
if($n % 2 -eq 0){
|
||||
$i1, $i2 = $i, ($n-1)
|
||||
$A[$i1], $A[$i2] = $A[$i2], $A[$i1]
|
||||
$cnt = 1
|
||||
}
|
||||
else{
|
||||
$i1, $i2 = 0, ($n-1)
|
||||
$A[$i1], $A[$i2] = $A[$i2], $A[$i1]
|
||||
$cnt = 1
|
||||
}
|
||||
}
|
||||
generate ($n - 1) $A $i1 $i2 $cnt
|
||||
}
|
||||
}
|
||||
$n = $array.Count
|
||||
if($n -gt 0) {
|
||||
(generate $n $array 0 ($n-1) 0)
|
||||
} else {$array}
|
||||
}
|
||||
permutation @(1,2,3,4)
|
||||
|
|
@ -1,60 +1,53 @@
|
|||
/*REXX pgm generates all permutations of N different objects by swapping*/
|
||||
parse arg things bunch inbetween names /*get optional arguments from CL.*/
|
||||
things=p(things 4) /*use the default for THINGS ? */
|
||||
bunch =p(bunch things) /* " " " " BUNCH ? */
|
||||
/*╔════════════════════════════════════════════════════════════════╗
|
||||
║ things (optional) defaults to 4. ║
|
||||
║ bunch (optional) defaults to THINGS. ║
|
||||
║ inbetween (optional) defaults to a [null]. ║
|
||||
║ names (optional) defaults to digits (and letters). ║
|
||||
╚════════════════════════════════════════════════════════════════╝*/
|
||||
upper inbetween; if inbetween=='NONE' | inbetween="NULL" then inbetween=
|
||||
call permSets things, bunch, inbetween, names
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
/*──────────────────────────────────one─liner subrlutines───────────────*/
|
||||
!: procedure; !=1; do j=2 to arg(1); !=!*j; end; return !
|
||||
p: return word(arg(1), 1) /*pick the first word from a list*/
|
||||
/*──────────────────────────────────GETONE subroutine───────────────────*/
|
||||
getOne: if length(z)==y then return substr(z,arg(1),1)
|
||||
else return sep||word(translate(z,,','), arg(1))
|
||||
/*──────────────────────────────────PERMSETS subroutine─────────────────*/
|
||||
permSets: procedure; parse arg x,y,between,uSyms /*X things Y at a time.*/
|
||||
sep=; !.=0 /*X can't be > length(@0abcs). */
|
||||
@abc = 'abcdefghijklmnopqrstuvwxyz'; parse upper var @abc @abcU
|
||||
@abcS= @abcU || @abc; @0abcS=123456789 || @abcS
|
||||
z= /*set Z to a null value. */
|
||||
do i=1 for x /*build a list of (perm) symbols.*/
|
||||
_=p(word(uSyms,i) p(substr(@0abcS,i,1) k)) /*get or gen a symbol.*/
|
||||
if length(_)\==1 then sep=',' /*if not 1st char, then use SEP. */
|
||||
z=z || sep || _ /*append it to the symbol list. */
|
||||
/*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
|
||||
if sep\=='' then z=strip(z, 'L', ",") /*strip leading commas from Z. */
|
||||
!.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 PERMUTE.*/
|
||||
say center('permutations for ' x ' with ' y "at a time",60,'═')
|
||||
#=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 'permutation' center("permute",w,'─') 'sign'
|
||||
say '───────────' center("───────",w,'─') '────'
|
||||
say center(#,11) center(z ,w) right(s,4)
|
||||
say pad 'permutation' center("permute",w,'─') 'sign'
|
||||
say pad '───────────' center("───────",w,'─') '────'
|
||||
say pad center(#,11) center(z ,w) right(s, 4-1)
|
||||
|
||||
do step=1 until #==times
|
||||
do k=1 for x-1
|
||||
do m=k+1 to x /*method doesn't use adjaceny. */
|
||||
?=
|
||||
do n=1 for x /*build a new permutation by swap*/
|
||||
if n\==k & n\==m then ?=? || getOne(n)
|
||||
else if n==k then ?=? || getOne(m)
|
||||
else ?=? || getOne(k)
|
||||
end /*n*/
|
||||
if sep\=='' then ?=strip(?,'L',sep)
|
||||
z=? /*save this permute for next swap*/
|
||||
if !.? then iterate m /*if defined before, try next one*/
|
||||
#=#+1; s=-s; say center(#,11) center(?,w) right(s,4)
|
||||
!.?=1
|
||||
iterate step
|
||||
end /*m*/
|
||||
end /*k*/
|
||||
end /*step*/
|
||||
|
||||
return
|
||||
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. */
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue