RogerBW's Blog

I’ve been doing the Perl Weekly Challenges. The latest involved comparing version numbers and generating an arbitrary order.

Compare two given version number strings v1 and v2 such that:

• If v1 > v2 return 1
• If v1 < v2 return -1
• Otherwise, return 0

The version numbers are non-empty strings containing only digits, and the dot (“.”) and underscore (“_”) characters. (“_” denotes an alpha/development version, and has a lower precedence than a dot, “.”). Here are some examples:

   v1   v2    Result
 ------ ------ ------
   0.1 < 1.1     -1
   2.0 > 1.2      1
   1.2 < 1.2_5   -1
 1.2.1 > 1.2_1    1
 1.2.1 = 1.2.1    0

Version numbers may also contain leading zeros. You may handle these how you wish, as long as it’s consistent.

This is quite a standard problem that I might solve by merely using one of the existing modules… except for that underscore/full stop distinction. (Which is conveniently out of ASCII order, too.)

sub compare {
  my @v=@_;
  my @s;

Here's my mapping table for the punctuation, so that I can compare it in the defined order.

  my %l=('_' => 1, '.' => 2);
  foreach my $i (0,1) {

First, validate. We must have a series of digit-strings separated by allowed punctuation.

    unless ($v[$i] =~ /^[0-9]+([._][0-9]+)*$/) {
      die "$v[$i] is not a valid version\n";
    }

Then, split it into an array, capturing the punctuation too.

    $s[$i]= [split /([._])/,$v[$i]];

For the punctuation only, which will always be the odd-numbered fields in the array, replace it with the mapping values.

    for (my $j=1;$j<=$#{$s[$i]};$j+=2) {
      $s[$i][$j]=$l{$s[$i][$j]};
    }
  }

So now "1.4_8" is represented as [1,1,4,2,8]. At which point I can just do a hierarchical comparison: for each term in order, compare the particular term, defaulting to zero if it's not present. (Which is why I used 1 and 2 for the punctuation mapping values: (nothing) comes before "_", which comes before ".".) If I get a difference, that's the answer so we return that; otherwise go on to the next term, ending up with a zero if they're identical.

  my $k=0;
  foreach my $j (0..max(map {$#{$_}} @s)) {
    $k=(($s[0][$j] || 0) <=> ($s[1][$j] || 0));
    if ($k != 0) {
      last;
    }
  }
  return $k;
}

Write a script to arrange people in a lineup according to how many taller people are in front of each person in line. You are given two arrays. @H is a list of unique heights, in any order. @T is a list of how many taller people are to be put in front of the corresponding person in @H. The output is the final ordering of people’s heights, or an error if there is no solution.

Here is a small example:

• @H = (2, 6, 4, 5, 1, 3) # Heights
• @T = (1, 0, 2, 0, 1, 2) # Number of taller people in front

The ordering of both arrays lines up, so H[i] and T[i] refer to the same person. For example, there are 2 taller people in front of the person with height 4, and there is 1 person in front of the person with height 1.

[For one possible solution], your script would then output the ordering (5, 1, 2, 6, 3, 4) in this case. (The leftmost element is the “front” of the array.)

Well, yeah. Why you'd want to do that is another matter. But this turns out not to be any sort of combinatorial search…

my @H = (2, 6, 4, 5, 1, 3); # Heights
my @T = (1, 0, 2, 0, 1, 2); # Number of taller people in front

So first of all I want my people sorted into decreasing height order, and start with an empty queue.

my @i=sort {$H[$b] <=> $H[$a]} (0..$#H);
my @n;

Now for each one, the number of taller people in front of them is the place they should have in the queue as it currently exists (because everyone already in it is taller than they are).

Anyone who's added to the queue later than them won't affect this, because they're by definition not taller than the person being added now.

So we just rattle through the list, assigning each person their right place. I don't know what sort of solution was expected, but this is basically as fast as whatever sort algorithm Perl is using.

(All the +1 and -1 is because I thought the desired answers were the index numbers, and didn't bother to change it when I noticed.)

foreach my $p (@i) {
  if ($T[$p]==0) {
    unshift @n,$p+1;
  } elsif ($T[$p] == scalar @n) {
    push @n,$p+1;
  } else {
    splice @n,$T[$p],0,$p+1;
  }
}

print join(', ',map {$H[$_-1]} @n),"\n";

Just to check, I wrote a validator too: for each place in the queue, count the taller people in front and make sure it matches the desired number.

foreach my $ti (0..$#n) {
  my $tx=$n[$ti]-1;
  my $mh=$H[$tx];
  my $hi=0;
  foreach my $tj (0..$ti-1) {
    if ($H[$n[$tj]-1] > $mh) {
      $hi++;
    }
  }
  unless ($hi == $T[$tx]) {
    die "index $ti failed\n";
  }
}