RogerBW's Blog

Perl Weekly Challenge 58: version comparison and ordered line 08 May 2020

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";
  }
}

Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.

Search
Archive
Tags 1920s 1930s 1940s 1950s 1960s 1970s 1980s 1990s 2000s 2010s 3d printing action aeronautics aikakirja anecdote animation anime army astronomy audio audio tech base commerce battletech beer boardgaming book of the week bookmonth chain of command children chronicle church of no redeeming virtues cold war comedy computing contemporary cornish smuggler cosmic encounter coup covid-19 cycling dead of winter doctor who documentary drama driving drone ecchi economics espionage essen 2015 essen 2016 essen 2017 essen 2018 essen 2019 existential risk falklands war fandom fanfic fantasy feminism film firefly first world war flash point flight simulation food garmin drive gazebo geodata gin gurps gurps 101 harpoon historical history horror hugo 2014 hugo 2015 hugo 2016 hugo 2017 hugo 2018 hugo 2019 hugo 2020 hugo-nebula reread humour in brief avoid instrumented life kickstarter learn to play leaving earth linux lovecraftiana mecha men with beards museum mystery naval non-fiction one for the brow opera perl perl weekly challenge photography podcast politics powers prediction privacy project woolsack pyracantha python quantum rail raku ranting raspberry pi reading reading boardgames social real life restaurant reviews romance rpg a day rpgs science fiction scythe second world war security shipwreck simutrans smartphone south atlantic war squaddies stationery steampunk stuarts suburbia superheroes suspense television the resistance thirsty meeples thriller tin soldier torg toys trailers travel type 26 type 31 type 45 vietnam war war wargaming weather wives and sweethearts writing about writing x-wing young adult
Special All book reviews, All film reviews
Produced by aikakirja v0.1