ANALYSIS of ALGORITHMS, Bulletin Board

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Permutation groups.




Greetings.

Consider the following problem. Choose a subset P of k permutations
from the set of n! permutations of n elements, where all n!-choose-k
subsets are equally likely. The set P generates a permutation group
G. (The program included with this message uses the term "closure" to
refer to G.) What is the expected number c(n, k) of elements of G?

Note that we can compute |G| when k=1 and P={p}. |G| is the logarithm
of the identity permutation with respect to p. This equals the lowest
common multiple of the lengths of the cycles that make up p. E.g. |G|
= 6 when p = [2 1 4 5 3].

Sample values of c(n, k) are difficult to compute because the
algorithms involved all have exponential or worse complexity. The Perl
program included with this message computes some sample values for k=1
and k=2. I do not have access to Maple. I chose Perl to keep it
cryptic, and to show off the different programming languages that I
have learned, or am in the process of learning! I am posting um mich
auf der AofA mailing liste zu verewigen, just as with my last post,
and the one before that!

Regards,

Marko Riedel


#! /usr/bin/perl -w
#

sub fact {
  my ($n) = @_;

  return 1 if $n==0 or $n==1;

  return $n*fact($n-1);
}

sub gcd {
    my ($a, $b) = @_;
    
    return gcd($b, $a) if $a < $b;

    my ($rem);
    do {
	$rem = $a - int($a / $b) * $b;
	$a = $b; $b = $rem;
    } while $rem > 0;

    return $a;
}

sub lcmlist {
    my ($lref) = @_;
    
    return $lref->[0] if scalar @$lref == 1;

    my ($m, $i) = 
	($lref->[0] * $lref->[1] / 
	 gcd($lref->[0], $lref->[1]), 2);
    while($i < scalar @$lref){
	$m = $m * $lref->[$i] / gcd($m, $lref->[$i]);
	$i++;
    }

    return $m;
}


sub permprod {
  my ($p1, $p2) = @_;
  my $p3 = [ scalar @$p1 x 0 ];

  for(my $i = 0; $i < scalar @$p1; $i++){
    $p3->[$i] = $p2->[$p1->[$i]-1];
  }

  return $p3;
}

sub permlogid {
    my ($perm) = @_;
    my ($identity, $l, $p) = 
	( "@{ [ 1 .. scalar @$perm ] }", 1, $perm);
    
    while("@$p" ne $identity){
	$p = permprod($p, $perm);
	$l++;
    }

    return $l;
}

sub perm2cycles {
    my ($perm) = @_;
    my (@marked) = (0) x scalar @$perm;
    my ($cycles) = ([]);
    
    for(my $i = 0; $i < scalar @$perm; $i++){
	next if $marked[$i];

	my ($j)=($i);
	my (@cycle) = ();

	while(not $marked[$j]){
	    push @cycle, $j + 1;
	    $marked[$j] = 1;
	    $j = $perm->[$j] - 1;
	}

	push @$cycles, [ @cycle ];
    }

    return $cycles;
}

sub lcmclens {
    my ($cycles) = @_;

    return lcmlist([ map { scalar @$_ } @$cycles ]);
}

sub pset2string {
  my ($pset) = @_;
  my $elstr = 
    join ', ', map { '[' . join(' ', @$_) . ']' } @$pset;

  return "[$elstr]";
	
}

sub square {
  my ($pset) = @_;
  my ($prod, %seen);

  %seen = ();
  for(my $i = 0; $i < scalar @$pset; $i++){
    for(my $j = 0; $j < scalar @$pset; $j++){
      $prod = permprod($pset->[$i], $pset->[$j]);
      $seen{"@$prod"} = $prod;
    }
  }

  return [ values %seen ];
}

sub union {
  my ($pset1, $pset2) = @_;
  my %seen = ();
  
  for(my $i = 0; $i < scalar @$pset1; $i++){
    $seen{"@{$pset1->[$i]}"} = $pset1->[$i];
  }
  for(my $i = 0; $i < scalar @$pset2; $i++){
    $seen{"@{$pset2->[$i]}"} = $pset2->[$i];
  }

  return [ values %seen ];
}

sub closure {
  my ($pset) = @_;
  my ($maxsize, $card, $next) = 
      (fact(scalar(@{ $pset->[0] })), 0, 0);

  while($card < ($next = scalar @$pset) &&
	$next < $maxsize){
    $card = $next;
    $pset = union($pset, square($pset));
  }

  return $pset;
}

sub allperms {
  my ($n) = @_;

  return [[1]] if $n==1;

  my $prev = allperms($n-1);
  my @cur  = ();
  for(my $i = 0; $i < scalar @$prev; $i++){
    push @cur,
      map { my $perm = $prev->[$i];
	    ($_==0 ?  [ $n, @$perm ] :
	     ($_==$n-1 ? [ @$perm, $n ] :
	      [ @$perm[0..($_-1)], 
		$n, 
		@$perm[$_..($n-2)] ]))
	  } 0..($n-1);
  }

  return \@cur;
}



sub expected {
  my ($n) = @_;
  my $total = 0;

  foreach my $perm (@{ allperms($n) }){
    $total += scalar @{ closure([$perm]) };
  }

  return [$total, fact($n)];
}

sub expectedVerify1 {
  my ($n) = @_;
  my $total = 0;

  foreach my $perm (@{ allperms($n) }){
    $total += permlogid($perm);
  }

  return [$total, fact($n)];
}


sub expectedVerify2 {
  my ($n) = @_;
  my $total = 0;

  foreach my $perm (@{ allperms($n) }){
    $total += lcmclens(perm2cycles($perm));
  }

  return [$total, fact($n)];
}


sub expected2 {
  my ($n) = @_;
  my ($perms) = (allperms($n));
  my ($total, $f) = (0, fact($n));

  for(my $i = 0; $i < scalar @$perms; $i++){
      for(my $j = $i+1; $j < scalar @$perms; $j++){
	  $total += 
	      scalar @{ closure([$perms->[$i], 
				 $perms->[$j]]) };
      }
  }

  return [$total, $f * ($f - 1) / 2];
}


MAIN: {
  my ($p1, $p2) = 
    ([ 2, 5, 6, 1, 3, 4 ], [6, 1, 5, 4, 2, 3]);

  my $p3 = permprod($p1, $p2);
  print "[@$p1] * [@$p2] = [@$p3]\n";

  my $id6 = [1..6];
  print "[@$p1] ^ " . permlogid($p1) . " = [@{ $id6 }]\n";
  print "[@$p2] ^ " . permlogid($p2) . " = [@{ $id6 }]\n";
  print "[@$p3] ^ " . permlogid($p3) . " = [@{ $id6 }]\n";

  *cycles2string = *pset2string;

  print "[@$p1] = " . cycles2string($c1 = perm2cycles($p1)) . 
      " " . lcmclens($c1) . "\n";
  print "[@$p2] = " . cycles2string($c2 = perm2cycles($p2)) .
      " " . lcmclens($c2) . "\n";
  print "[@$p3] = " . cycles2string($c3 = perm2cycles($p3)) .
      " " . lcmclens($c3) . "\n";

  my $pset1 = [$p1, $p2];
  print pset2string($pset1) . "\n";
  
  my $pset2 = square($pset1);
  print pset2string($pset2) . "\n";
  
  my $pset3 = square($pset2);
  print pset2string($pset3) . "\n";

  my $pset4 = [[2, 3, 4, 1]];
  my $pcl1 = closure($pset4);
  print "closure of " . pset2string($pset4) .  " is " . 
    pset2string($pcl1) . "\n";

  my $pset5 = [[2, 3, 4, 1], [2, 1, 3, 4]];
  my $pcl2 = closure($pset5);
  print "closure of " . pset2string($pset5) .  " is " . 
    pset2string($pcl2) . "\n";

  my $pset6 = allperms(2);
  print "2 perms of 2 elements: " .
    pset2string($pset6) . "\n";

  my $pset7 = allperms(3);
  print "6 perms of 3 elements: " .
    pset2string($pset7) . "\n";

  for(my $i = 0; $i < scalar @$pset7; $i++){
      my ($perm1, $crep) = ($pset7->[$i]);

      print "closure([[@$perm1]]) = " .
	  pset2string(closure([$perm1])) . "\n";
      print "[@$perm1] = " .
	  cycles2string($crep=perm2cycles($perm1)) . 
	      " " . lcmclens($crep) .  "\n";

      for(my $j = $i+1; $j < scalar @$pset7; $j++){
	  my ($perm2) = ($pset7->[$j]);

	  print "closure([[@$perm1], [@$perm2]]) = " .
	      pset2string(closure([$perm1, $perm2])) . "\n";
      }
  }

  my $pset8 = allperms(4);
  print "24 perms of 4 elements: " .
    pset2string($pset8) . "\n";

  foreach my $perm (@$pset8){
    print "closure([[@$perm]]) = " .
      pset2string(closure([$perm])) . "\n";
  }

  print "k=1\n";
  for(my $n=1; $n < 7; $n++){
    my $res = expected($n);

    print "$n: $res->[0]/$res->[1]: " . 
      $res->[0]/$res->[1] . "\n";
  }

  print "k=1; verify by log\n";
  for(my $n=1; $n < 8; $n++){
    my $res = expectedVerify1($n);

    print "$n: $res->[0]/$res->[1]: " . 
      $res->[0]/$res->[1] . "\n";
  }

  print "k=1; verify by lcm\n";
  for(my $n=1; $n < 8; $n++){
    my $res = expectedVerify2($n);

    print "$n: $res->[0]/$res->[1]: " . 
      $res->[0]/$res->[1] . "\n";
  }

  print "k=2\n";
  for(my $n=2; $n < 5; $n++){
    my $res = expected2($n);

    print "$n: $res->[0]/$res->[1]: " . 
      $res->[0]/$res->[1] . "\n";
  }
}


Date Prev | Date Next | Date Index | Thread Index