Time for an 2014 update…
This commit is contained in:
Ingy döt Net
parent
372c577f83
commit
09687c4926
2520 changed files with 34227 additions and 7318 deletions
|
|
@ -0,0 +1,50 @@
|
|||
package permute
|
||||
|
||||
// Iter takes a slice p and returns an iterator function. The iterator
|
||||
// permutes p in place and returns the sign. After all permutations have
|
||||
// been generated, the iterator returns 0 and p is left in its initial order.
|
||||
func Iter(p []int) func() int {
|
||||
f := pf(len(p))
|
||||
return func() int {
|
||||
return f(p)
|
||||
}
|
||||
}
|
||||
|
||||
// Recursive function used by perm, returns a chain of closures that
|
||||
// implement a loopless recursive SJT.
|
||||
func pf(n int) func([]int) int {
|
||||
sign := 1
|
||||
switch n {
|
||||
case 0, 1:
|
||||
return func([]int) (s int) {
|
||||
s = sign
|
||||
sign = 0
|
||||
return
|
||||
}
|
||||
default:
|
||||
p0 := pf(n - 1)
|
||||
i := n
|
||||
var d int
|
||||
return func(p []int) int {
|
||||
switch {
|
||||
case sign == 0:
|
||||
case i == n:
|
||||
i--
|
||||
sign = p0(p[:i])
|
||||
d = -1
|
||||
case i == 0:
|
||||
i++
|
||||
sign *= p0(p[1:])
|
||||
d = 1
|
||||
if sign == 0 {
|
||||
p[0], p[1] = p[1], p[0]
|
||||
}
|
||||
default:
|
||||
p[i], p[i-1] = p[i-1], p[i]
|
||||
sign = -sign
|
||||
i += d
|
||||
}
|
||||
return sign
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
package main
|
||||
|
||||
import (
|
||||
"fmt"
|
||||
"permute"
|
||||
)
|
||||
|
||||
func main() {
|
||||
p := []int{11, 22, 33}
|
||||
i := permute.Iter(p)
|
||||
for sign := i(); sign != 0; sign = i() {
|
||||
fmt.Println(p, sign)
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
#!perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
# This code uses "Even's Speedup," as described on
|
||||
# the Wikipedia page about the Steinhaus–Johnson–
|
||||
# Trotter algorithm.
|
||||
|
||||
# Any resemblance between this code and the Python
|
||||
# code elsewhere on the page is purely a coincidence,
|
||||
# caused by them both implementing the same algorithm.
|
||||
|
||||
# The code was written to be read relatively easily
|
||||
# while demonstrating some common perl idioms.
|
||||
|
||||
sub perms(&@) {
|
||||
my $callback = shift;
|
||||
my @perm = map [$_, -1], @_;
|
||||
$perm[0][1] = 0;
|
||||
|
||||
my $sign = 1;
|
||||
while( ) {
|
||||
$callback->($sign, map $_->[0], @perm);
|
||||
$sign *= -1;
|
||||
|
||||
my ($chosen, $index) = (-1, -1);
|
||||
for my $i ( 0 .. $#perm ) {
|
||||
($chosen, $index) = ($perm[$i][0], $i)
|
||||
if $perm[$i][1] and $perm[$i][0] > $chosen;
|
||||
}
|
||||
return if $index == -1;
|
||||
|
||||
my $direction = $perm[$index][1];
|
||||
my $next = $index + $direction;
|
||||
|
||||
@perm[ $index, $next ] = @perm[ $next, $index ];
|
||||
|
||||
if( $next <= 0 or $next >= $#perm ) {
|
||||
$perm[$next][1] = 0;
|
||||
} elsif( $perm[$next + $direction][0] > $chosen ) {
|
||||
$perm[$next][1] = 0;
|
||||
}
|
||||
|
||||
for my $i ( 0 .. $next - 1 ) {
|
||||
$perm[$i][1] = +1 if $perm[$i][0] > $chosen;
|
||||
}
|
||||
for my $i ( $next + 1 .. $#perm ) {
|
||||
$perm[$i][1] = -1 if $perm[$i][0] > $chosen;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $n = shift(@ARGV) || 4;
|
||||
|
||||
perms {
|
||||
my ($sign, @perm) = @_;
|
||||
print "[", join(", ", @perm), "]";
|
||||
print $sign < 0 ? " => -1\n" : " => +1\n";
|
||||
} 1 .. $n;
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
#!perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub perms {
|
||||
my ($xx) = (shift);
|
||||
my @perms = ([+1]);
|
||||
for my $x ( 1 .. $xx ) {
|
||||
my $sign = -1;
|
||||
@perms = map {
|
||||
my ($s, @p) = @$_;
|
||||
map [$sign *= -1, @p[0..$_-1], $x, @p[$_..$#p]],
|
||||
$s < 0 ? 0 .. @p : reverse 0 .. @p;
|
||||
} @perms;
|
||||
}
|
||||
@perms;
|
||||
}
|
||||
|
||||
my $n = shift() || 4;
|
||||
|
||||
for( perms($n) ) {
|
||||
my $s = shift @$_;
|
||||
$s = '+1' if $s > 0;
|
||||
print "[", join(", ", @$_), "] => $s\n";
|
||||
}
|
||||
|
|
@ -0,0 +1,60 @@
|
|||
/*REXX pgm generates all permutations of N different objects by swapping*/
|
||||
parse arg things bunch inbetween names /*get optional C.L. args*/
|
||||
if things=='' | things==',' then things=4 /*use the default? */
|
||||
if bunch =='' | bunch ==',' then bunch =things /* " " " */
|
||||
/* ┌────────────────────────────────────────────────────────────────┐
|
||||
│ 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.*/
|
||||
/*──────────────────────────────────! {factorial} subroutine────────────*/
|
||||
!: procedure; parse arg x; !=1; do j=2 to x; !=!*j; end; return !
|
||||
/*──────────────────────────────────GETONE subroutine───────────────────*/
|
||||
getOne: if length(z)==y then return substr(z,arg(1),1)
|
||||
else return sep||word(translate(z,,','),arg(1) )
|
||||
/*──────────────────────────────────P subroutine (Pick one)─────────────*/
|
||||
p: return word(arg(1),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=
|
||||
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. */
|
||||
end /*i*/
|
||||
|
||||
if sep\=='' then z=strip(z,'L', ",")
|
||||
!.z=1; #=1; times=!(x)%!(x-y); q=z; s=1; w=max(length(z),length('permute'))
|
||||
say center('permutations for ' x ' with ' y "at a time",60,'═')
|
||||
say
|
||||
say 'permutation' center("permute",w,'─') 'sign'
|
||||
say '───────────' center("───────",w,'─') '────'
|
||||
say center(#,11) center(z ,w) right(s,4)
|
||||
|
||||
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
|
||||
Loading…
Add table
Add a link
Reference in a new issue