Median-of-three quickselect: inversions and distance. (III)

[Marko Riedel <mriedel@xxxxxxxxxxxxx>]

Greetings.

I am sending the initial conditions for the distance from the identity
permutation after a single median-of-three quickselect as asked for by
H. Prodinger.

z^1 u^1: 1: 0/1
z^2 u^1: 2: 0/2
z^2 u^2: 2: 0/2
z^3 u^1: 6: 0/6
z^3 u^2: 6: 0/6
z^3 u^3: 6: 0/6
z^4 u^1: 18 + 6v^2: 12/24
z^4 u^2: 18 + 6v^2: 12/24
z^4 u^3: 18 + 6v^2: 12/24
z^4 u^4: 18 + 6v^2: 12/24
z^5 u^1: 66 + 36v^2 + 12v^6 + 6v^8: 192/120
z^5 u^2: 66 + 36v^2 + 12v^6 + 6v^8: 192/120
z^5 u^3: 84 + 24v^2 + 12v^4: 96/120
z^5 u^4: 66 + 36v^2 + 12v^6 + 6v^8: 192/120
z^5 u^5: 66 + 36v^2 + 12v^6 + 6v^8: 192/120
z^6 u^1: 258 + 234v^2 + 6v^4 + 96v^6 + 48v^8 + 12v^10 + 12v^12 + 24v^14 + 6v^16 + 18v^18 + 6v^20: 2592/720
z^6 u^2: 258 + 234v^2 + 6v^4 + 96v^6 + 48v^8 + 12v^10 + 12v^12 + 24v^14 + 6v^16 + 18v^18 + 6v^20: 2592/720
z^6 u^3: 342 + 234v^2 + 36v^4 + 36v^6 + 54v^8 + 18v^10: 1440/720
z^6 u^4: 342 + 234v^2 + 36v^4 + 36v^6 + 54v^8 + 18v^10: 1440/720
z^6 u^5: 258 + 234v^2 + 6v^4 + 96v^6 + 48v^8 + 12v^10 + 12v^12 + 24v^14 + 6v^16 + 18v^18 + 6v^20: 2592/720
z^6 u^6: 258 + 234v^2 + 6v^4 + 96v^6 + 48v^8 + 12v^10 + 12v^12 + 24v^14 + 6v^16 + 18v^18 + 6v^20: 2592/720
z^7 u^1: 1098 + 1392v^2 + 210v^4 + 732v^6 + 390v^8 + 132v^10 + 120v^12 + 252v^14 + 84v^16 + 204v^18 + 84v^20 + 60v^22 + 36v^24 + 60v^26 + 24v^28 + 36v^30 + 42v^32 + 36v^34 + 18v^36 + 24v^38 + 6v^40: 33984/5040
z^7 u^2: 1098 + 1392v^2 + 210v^4 + 732v^6 + 390v^8 + 132v^10 + 120v^12 + 252v^14 + 84v^16 + 204v^18 + 84v^20 + 60v^22 + 36v^24 + 60v^26 + 24v^28 + 36v^30 + 42v^32 + 36v^34 + 18v^36 + 24v^38 + 6v^40: 33984/5040
z^7 u^3: 1572 + 1464v^2 + 312v^4 + 624v^6 + 396v^8 + 96v^10 + 96v^12 + 144v^14 + 120v^16 + 96v^18 + 96v^20 + 24v^22: 21312/5040
z^7 u^4: 1692 + 1728v^2 + 432v^4 + 288v^6 + 432v^8 + 144v^10 + 144v^12 + 144v^14 + 36v^16: 16128/5040
z^7 u^5: 1572 + 1464v^2 + 312v^4 + 624v^6 + 396v^8 + 96v^10 + 96v^12 + 144v^14 + 120v^16 + 96v^18 + 96v^20 + 24v^22: 21312/5040
z^7 u^6: 1098 + 1392v^2 + 210v^4 + 732v^6 + 390v^8 + 132v^10 + 120v^12 + 252v^14 + 84v^16 + 204v^18 + 84v^20 + 60v^22 + 36v^24 + 60v^26 + 24v^28 + 36v^30 + 42v^32 + 36v^34 + 18v^36 + 24v^38 + 6v^40: 33984/5040
z^7 u^7: 1098 + 1392v^2 + 210v^4 + 732v^6 + 390v^8 + 132v^10 + 120v^12 + 252v^14 + 84v^16 + 204v^18 + 84v^20 + 60v^22 + 36v^24 + 60v^26 + 24v^28 + 36v^30 + 42v^32 + 36v^34 + 18v^36 + 24v^38 + 6v^40: 33984/5040


How to read this table: multiply the first, second and third column to 
obtain the Taylor series for F(z, u, v). Multiply the first, second
and fourth column to obtain the Taylor series for d/dv F(z, u, v)_{v = 
1}. Differentiate the latter wrt. to z to obtain the Taylor series for 
Phi(z, u) = d/dz d/dv F(z, u, v)_{v = 1}. Differentiate again for d/dz 
Phi(z, u) = Phi'(z, u).

You get

d/dv F(z, u, v)_{v = 1} =
(1/2 u + 1/2 u^2 + 1/2 u^3 + 1/2 u^4) z^4 +
(8/5 u + 8/5 u^2 + 4/5 u^3 + 8/5 u^4 + 8/5 u^5) z^5 +
(18/5 u + 18/5 u^2 + 2 u^3 + 2 u^4 + 18/5 u^5 + 18/5 u^6) z^6 + ...

Phi(z, u) = d/dz d/dv F(z, u, v)_{v = 1} =
(2 u + 2 u^2 + 2 u^3 + 2 u^4) z^3 +
(8 u + 8 u^2 + 4 u^3 + 8 u^4 + 8 u^5) z^4 +
(108/5 u + 108/5 u^2 + 12 u^3 + 12 u^4 + 108/5 u^5 + 108/5 u^6) z^5 + ...

Phi'(z, u) = d/dz Phi(z, u) =
(6 u + 6 u^2 + 6 u^3 + 6 u^4) z^2 +
(32 u + 32 u^2 + 16 u^3 + 32 u^4 + 32 u^5) z^3 +
(108 u + 108 u^2 + 60 u^3 + 60 u^4 + 108 u^5 + 108 u^6) z^4 + ...

Please check my algebra.

Best regards,

Marko Riedel

----------------------------------------------------------------------

#! /usr/bin/perl -w
#

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

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

  my ($p) = (1);
  $p*=$n-- while $n>1;

  return $p;
}

sub qsel {
  my ($perm, $lower, $upper, $index) = @_;
  my ($temp);

  return if $lower==$upper;

  if($lower+1==$upper){
    $temp=$perm->[$lower];

    if($temp>$perm->[$upper]){
      $perm->[$lower]=$perm->[$upper];
      $perm->[$upper]=$temp;
    }

    return;
  }

  my ($ab, $ac, $bc) =
    ($perm->[$lower]   <=> $perm->[$lower+1],
     $perm->[$lower]   <=> $perm->[$lower+2],
     $perm->[$lower+1] <=> $perm->[$lower+2]);
  if($ab==$bc){
    $temp=$perm->[$lower];
    $perm->[$lower]=$perm->[$lower+1];
    $perm->[$lower+1]=$temp;
  }
  elsif($ac==-$bc){
    $temp=$perm->[$lower];
    $perm->[$lower]=$perm->[$lower+2];
    $perm->[$lower+2]=$temp;
  }

  my ($pivot, $i, $j) = 
    ($perm->[$lower], $lower+1, $upper);
  while($i<=$j){
    while($i<=$j && $perm->[$i]<$pivot){
      $perm->[$i-1]=$perm->[$i];
      $i++;
    }
    while($j>=$i && $perm->[$j]>$pivot){
      $j--;
    }
    
    if($i<$j){
      $temp=$perm->[$i];
      $perm->[$i]=$perm->[$j];
      $perm->[$j]=$temp;
    }
  }
  $perm->[$i-1]=$pivot;

  qsel($perm, $lower, $i-2, $index) 
    if $i-2>$lower && $index<=$i-2;
  qsel($perm, $i, $upper, $index) 
    if $i<$upper && $index>=$i;
}

sub nextperm {
  my ($n, $i, $j) = @_;
  my (@crep, $rem, @source, @perm, $item);
 
  for($j=1; $j<=$n; $j++){
    $rem=$i%$j;
    unshift @crep, $rem;
    $i=($i-$rem)/$j;
  }

  @source=(0..$n-1);
  for($j=0; $j<$n; $j++){
    $item=splice @source, $crep[$j], 1;
    push @perm, $item;
  }

  return \@perm;
}

sub dist {
  my ($perm, $p) = @_;
  my ($sum) = (0);

  for(my ($k, $d)=0; 
      $k < scalar @$perm; $k++){
    $d = $k - $perm->[$k];
    $sum += $d**$p;
  }

  return $sum;
}


sub gf2string {
  my ($poly, @str, $term) = @_;

  foreach my $i ($poly->[0] .. $poly->[1]){
    if(defined $poly->[2][$i]){
      $term=($i == 0 ? '' : ($i == 1 ? 'v' : "v^$i"));
      push @str, 
      ($poly->[2][$i] == 1 ? 
       ($i==0 ? '1' : '') : "$poly->[2][$i]") .	$term;
    } 
  }

  return join ' + ', @str;
}

sub gfat1 {
  my ($poly, $total, $total1) = (@_, 0, 0);

  foreach my $i ($poly->[0] .. $poly->[1]){
    if(defined $poly->[2][$i]){
      $total  += $poly->[2][$i];
      $total1 += $i * $poly->[2][$i];
    }
  }

  return [$total1, $total];
}


MAIN: {
  my ($max, $p, $n) = @ARGV;

  die "$0 <n> <p>\n" 
    if not defined $max or not defined $p;

  for($n=1; $n<=$max; $n++){
    my ($f, $tgf, $i, $j, $perm, $dist, $at1) =
      (fact($n));
    for($j=1; $j<=$n; $j++){
      $tgf=[undef, undef, []];
      for($i=0; $i<$f; $i++){
	$perm=nextperm($n, $i);
	qsel($perm, 0, $n-1, $j-1);
	$dist=dist($perm, $p);
	
	$tgf->[0]=$dist 
	  if not defined $tgf->[0] or $tgf->[0]>$dist;
	$tgf->[1]=$dist 
	  if not defined $tgf->[1] or $tgf->[1]<$dist;
	$tgf->[2][$dist]=0 
	  if not defined $tgf->[2][$dist];
	$tgf->[2][$dist]++;
      }

      print "z^$n u^$j: " . gf2string($tgf) . ": ";
      $at1 = gfat1($tgf);
      print "$at1->[0]/$at1->[1]\n";
    }
  }
}