Quickselect and inversions.

[Marko Riedel <mriedel@neuearbeit.de>]

Greetings.

The following question should be answerable by setting up a recurrence 
for the generating functions that are involved and solving the
recurrence. I have tried this myself but I haven't yet been able to
find the right recurrence.

Question. What amount of disorder is left in a permutation after one
of its elements has been selected with quickselect?

This can be rephrased as follows. Compute the "grand average" for the
expected number of inversions left in a permutation after one of its
elements has been selected with quickselect.

Here are the first few generating functions.

1
0/1
4
0/4
16 + 2z
2/18
70 + 20z + 4z^2 + 2z^3
34/96
335 + 159z + 56z^2 + 32z^3 + 10z^4 + 6z^5 + 2z^6
449/600
1767 + 1180z + 574z^2 + 381z^3 + 180z^4 + 116z^5 + 64z^6 + 30z^7 + 18z^8 + 8z^9 + 2z^10
5601/4320
10099 + 8906z + 5408z^2 + 3967z^3 + 2378z^4 + 1678z^5 + 1080z^6 + 652z^7 + 454z^8 + 292z^9 + 170z^10 + 98z^11 + 58z^12 + 28z^13 + 10z^14 + 2z^15
70837/35280

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 ($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-$i) 
    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 inversions {
  my ($perm) = @_;
  my ($n, $count, $i, $j) = (scalar @$perm, 0);

  for($i=0; $i<$n; $i++){
    for($j=$i+1; $j<$n; $j++){
      $count++ if $perm->[$i]>$perm->[$j];
    }
  }

  return $count;
}

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

  foreach my $i ($poly->[0] .. $poly->[1]){
    if(defined $poly->[2][$i]){
      $term=($i == 0 ? '' : ($i == 1 ? 'z' : "z^$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, $n) = @ARGV;

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

  for($n=1; $n<=$max; $n++){
    my ($gf, $i, $j, $perm, $pcopy, $invs) =
      ([undef, undef, []]);
    for($i=0; $i<fact($n); $i++){
      $perm=nextperm($n, $i);
      
      for($j=0; $j<$n; $j++){
	$pcopy=[@$perm];
	qsel($pcopy, 0, $n-1, $j);
	$invs=inversions($pcopy);
      
	$gf->[0]=$invs 
	  if not defined $gf->[0] or $gf->[0]>$invs;
	$gf->[1]=$invs 
	  if not defined $gf->[1] or $gf->[1]<$invs;
	$gf->[2][$invs]=0 
	  if not defined $gf->[2][$invs];
	$gf->[2][$invs]++;
      }
    }
    
    print gf2string($gf) . "\n";
    my ($at1) = gfat1($gf);
    print "$at1->[0]/$at1->[1]\n";
  }
}