Re: More help requested on permutation code.

Michael Press <jack@xxxxxxx> wrote in comp.lang.perl.misc:
Thank you all for the help. Would you guys look at
the rest of the code? First a disclaimer.
The sort assumes numerical permutation elements.
This is a limitation I can rectify.

________________CUT________________
#! /usr/bin/perl

use warnings;
use strict;

# Multiply permutation cycles, into a permutation map;
# then turn the map into a cycle representation, and print.
# Knuth ACP 1.3.3 Algorithm B.

sub permutation_multiply
{
my $t;
my $hold;
my $prev;

# Read in the cycles, and initialize the permutation array.
my %permutation_map = map { /\w/ ? ( $_ => $_ ) : () } my
@token_list = $_[0] =~ /\w+|[()]/g;

# Multiply the cycles generating the permutation as a map.
for (my $idx = $#token_list; $idx >= 0; --$idx)
{
my $it = $token_list[$idx];
if ($it eq ')' ) { $prev = $it }
elsif ($it eq '(' ) { $permutation_map{$hold} = $prev }
else
{
if ( $prev eq ')' ) { $hold = $it }
$t = $prev, $prev = $permutation_map{$it},
$permutation_map{$it} = $t;
}
}

# Generate the cycle representation from the permutation in
%permutation_map
my @cycles;
for my $key (sort { $a <=> $b } keys %permutation_map)
{
my @element_list;
next if $permutation_map{$key} =~ m/-$/ ;
do
{
push @element_list, $key;
$t = $permutation_map{$key};
$permutation_map{$key} .= '-';
$key = $t;
} while ($permutation_map{$key} !~ m/-$/ );
push @cycles, [@element_list];
}
for my $key (keys %permutation_map) {$permutation_map{$key} =~ tr/-//d }

# Print out the cycles:
# Sort the cycles by length.
# Put spaces between permutation elements.
# Put in cycle delimiter parentheses.
# Put spaces between permutation cycles.
# Print.
print join(' ', map { sprintf "(%s)", join ' ', @{$_}} sort {$#{$a}
<=> $#{$b}} @cycles ), "\n";
}

my $alpha = "(99)(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22)";
my $beta = "(99)(0)(3 6 12 1 2 4 8 16 9 18 13)(15 7 14 5 10 20 17 11 22
21 19)";
my $gamma = "(99 0)(1 22)(2 11)(3 15)(4 17)(5 9)(6 19)(7 13)(8 20)(10
16)(12 21)(14 18)";
my $delta = "(99)(0)(3)(15)(1 18 4 2 6)(5 21 20 10 7)(8 16 13 9 12)(11
19 22 14 17)";
my $x;

What are all the single-element cycles for? They map to the unit
permutation and have no effect.

print "beta = alpha^5 gamma alpha^5 gamma alpha^14 gamma alpha^18 \n";
$x = ($alpha x 5 . $gamma) x 2 . $alpha x 14 . $gamma . $alpha x 18;
permutation_multiply $x;
$x = $beta;
permutation_multiply $x;
print "\n";

print "(alpha^13 gamma delta^2)^3 has shape 4^6\n";
$x = (($alpha x 13) . $gamma . ($delta x 2)) x 3;
permutation_multiply $x;
print "\n";

________________END________________

One of my projects in the almost-done limbo is a permutation class. It
overloads permutation objects so that multiplication (x) and exponentiation
(**) can be applied directly. I had an hour of fun adapting it to the
problem at hand. The adaption is mainly in the stringification of
permutations and in the addition of a special creator (new_from_cyc_str)
to deal with the given formats.

The code (incompletely tested) is appended below. The printed results
are equivalent to those of the original code.

Anno


#!/usr/bin/perl
use strict; use warnings; $| = 1;

my $alpha = Permutation->new_from_cyc_str(
"(99)(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22)"
);

my $beta = Permutation->new_from_cyc_str(
"(99)(0)(3 6 12 1 2 4 8 16 9 18 13)(15 7 14 5 10 20 17 11 22 21 19)"
);

my $gamma = Permutation->new_from_cyc_str(
"(99 0)(1 22)(2 11)(3 15)(4 17)(5 9)(6 19)(7 13)(8 20)" .
"(10 16)(12 21)(14 18)"
);

my $delta = Permutation->new_from_cyc_str(
"(99)(0)(3)(15)(1 18 4 2 6)(5 21 20 10 7)(8 16 13 9 12)(11 19 22 14 17)"
);

my $x = ($alpha**5 x $gamma)**2 x $alpha**14 x $gamma x $alpha ** 18;

print "beta = alpha^5 gamma alpha^5 gamma alpha^14 gamma alpha^18\n";
print "$x\n";
print "$beta\n";

print "\n";
print "(alpha^13 gamma delta^2)^3 has shape 4^6\n";
$x = ($alpha**13 x $gamma x $delta**2)**3;
print "$x\n";

exit;

######################################################################

package Permutation;
use List::Util qw( max);

use overload(
# '""' => sub { "(@{ shift() })" },
'""' => 'to_cyc_str',
bool => sub { @{ $_[ 0]} > 1 },
x => 'multiply',
'/' => 'divide',
'**' => 'power',
);

sub new {
my $class = shift;
push @_, 0 unless @_;
defined $_[ $_] or $_[ $_] = $_ for 0 .. $#_;
pop while @_ > 1 and $_[ -1] == $#_;
bless [ @_], $class;
}

sub new_from_cycle {
my $class = shift;
my @p;
my @q = @_;
push @q, shift @q;
@p[ @_] = @q;
$class->new( @p);
}

sub new_from_cyc_str {
my ( $class, $str) = @_;
my $p = $class->new();
for ( $str =~ /\(([\d ]*)\)/g ) {
$p = $p->multiply( Permutation->new_from_cycle( split));
}
$p;
}

sub new_random {
my ( $class, $n) = @_;
my @perm = 0 .. $n - 1;
for ( reverse 0 .. $n - 1 ) {
my $pick = rand $_;
@perm[ -1, $pick] = @perm[ $pick, -1];
}
$class->new( @perm);
}

sub multiply {
my ( $p1, $p2) = @_;
ref( $p1)->new( (@$p2, @$p2 .. max( @$p1))[ @$p1, @$p1 .. $#$p2]);
}

sub invert {
my $p = shift;
my @inv;
@inv[ @$p] = 0 .. $#$p;
ref( $p)->new( @inv);
}

sub divide { $_[ 0]->multiply( $_[ 1]->invert) }

sub power {
my ( $p, $n) = @_;
if ( $n < 0 ) {
$n = -$n;
$p = $p->invert;
}
my $pow = Permutation->new();
while ( $n ) {
$pow = $pow->multiply( $p) if $n & 1;
$p = $p->multiply( $p);
$n >>= 1;
}
$pow;
}

sub _extract_cycle {
my $p = shift;
my ( @seen, @cyc);
my $i = $#$p;
until ( defined $seen[ $i] ) {
$seen[ $i] = 1;
push @cyc, $i;
$i = $p->[ $i];
}
@cyc;
}

sub to_cycles {
my $p = shift;
my @cycles;
while ( $p ) {
my @cyc = $p->_extract_cycle;
$p = $p->multiply( Permutation->new_from_cycle( @cyc)->invert);
push @cycles, \ @cyc;
}
sort { @$a <=> @$b } @cycles;
}

sub to_cyc_str {
my $p = shift;
join ' ', map "[@$_]", $p->to_cycles;
}
--
If you want to post a followup via groups.google.com, don't use
the broken "Reply" link at the bottom of the article. Click on
"show options" at the top of the article, then click on the
"Reply" at the bottom of the article headers.
.

Relevant Pages

  • Re: VMPC Stream Cipher - ideas on potential weaknesses?
    ... > terabytes of bytes and digraphs through our ... It would be interesting to know about the possible short cycles. ... My geuss is that the algorithm mixes the permutation well enough to avoid ...
    (sci.crypt)
  • Re: ANNOUNCE: New "Leopard6" CSPRNG !
    ... and it always reports s]. ... also a permutation of 0..255. ... same set of cycles, except any cycles of even length in the internal ... Voila, the internal state. ...
    (sci.crypt)
  • More help requested on permutation code.
    ... The sort assumes numerical permutation elements. ... # Read in the cycles, ...
    (comp.lang.perl.misc)
  • Re: More help requested on permutation code.
    ... The sort assumes numerical permutation elements. ... # Read in the cycles, ... In Perl that is usually written as: ...
    (comp.lang.perl.misc)
  • Re: Permutation of maximum cycle
    ... assume you have a permutation of maximal period k=k. ... Wlog assume that p was chosen among all permutations of maximal order ... Consider any two such distinct cycles of periods k1, ...
    (sci.math)