PERL WEEKLY CHALLENGE – 058

This is my 28th week participating into the weekly challenge.


TASK #1 › Compare Version

Reviewed by Ryan Thompson


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.


For this task I just split the version numbers and compared each number iteratively return a 1 or -1 if either the first or second version number is greater.

If the version numbers match, then the alpha number is compared if it exists. If the numbers match a 0 is returned.

The way I did this was a bit messy, because I was honestly more interested in the 2nd task.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-1.pl
use strict;
use warnings;
use feature qw /say/;
use version;
use Data::Dumper;

say '   v1   v2    Result';
say '------ ------ ------';
say '0.1   < 1.1   ' .  compare('0.1','1.1');
say '2.0   > 1.2   ' .  compare('2.0','1.2');
say '1.2   < 1.2_5 ' .  compare('1.2','1.2_5');
say '1.2.1 > 1.2_1 ' .  compare('1.2.1','1.2_1');
say '1.2.1 = 1.2.1 ' .  compare('1.2.1','1.2.1');
say '1_0   > 1     ' .  compare('1_0','1');
say '10    > 1.0   ' .  compare('10','1.0');
say '1.1.1 < 1.2.1 ' .  compare('1.1.1','1.2.1');

sub compare {
	my ($v1, $v2) = @_;

	# Split into digits or alpha
	my ($v1_d, $v1_a) = parse($v1);
	my ($v2_d, $v2_a) = parse($v2);

	while (scalar(@$v1_d) || scalar(@$v2_d) ) {
		my $d1 = shift(@$v1_d);
		my $d2 = shift(@$v2_d);
		return 0  if (!defined($d1) && !defined($d2));
		return 1  if (defined($d1)  && !defined($d2));
		return -1 if (!defined($d1) && defined($d2));
		return 1 if ($d1 > $d2);
		return -1 if ($d1 < $d2);
	}

	return  0 if (!defined($v1_a) && !defined($v2_a));
	return  1 if (defined($v1_a)  && !defined($v2_a));
	return -1 if (!defined($v1_a) && defined($v2_a));

	return ($v1_a > $v2_a) ?  1 :
	       ($v1_a < $v2_a) ? -1 : 0;
}

sub parse {
	my $version = shift;

	my @digits = split('\.', $version);
	my ($last_digit, $alpha) = split('_', pop(@digits));
	push @digits, $last_digit;

	return \@digits, $alpha;
}

Output

   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
1_0   > 1     1
10    > 1.0   1
1.1.1 < 1.2.1 -1

Raku solution

# Test: perl6 ch-1.p6
sub MAIN() {
	say '   v1   v2    Result';
	say '------ ------ ------';
	say '0.1   < 1.1   ' ~  compare('0.1','1.1');
	say '2.0   > 1.2   ' ~  compare('2.0','1.2');
	say '1.2   < 1.2_5 ' ~  compare('1.2','1.2_5');
	say '1.2.1 > 1.2_1 ' ~  compare('1.2.1','1.2_1');
	say '1.2.1 = 1.2.1 ' ~  compare('1.2.1','1.2.1');
	say '1_0   > 1     ' ~  compare('1_0','1');
	say '10    > 1.0   ' ~  compare('10','1.0');
	say '1.1.1 < 1.2.1 ' ~  compare('1.1.1','1.2.1');

	sub compare(Str $v1, Str $v2) {
		my ($v1_d, $v1_a) = parse($v1);
		my ($v2_d, $v2_a) = parse($v2);

		 while ($v1_d.elems || $v2_d.elems ) {
			my $d1 = $v1_d.shift;
			my $d2 = $v2_d.shift;

			return 0  if (!defined($d1) && !defined($d2));
			return 1  if (defined($d1)  && !defined($d2));
			return -1 if (!defined($d1) && defined($d2));
			return 1 if ($d1 > $d2);
			return -1 if ($d1 < $d2);
		}

		return  0 if (!defined($v1_a) && !defined($v2_a));
		return  1 if (defined($v1_a)  && !defined($v2_a));
		return -1 if (!defined($v1_a) && defined($v2_a));

		return ($v1_a > $v2_a)  ??  1 !!
		        ($v1_a < $v2_a) ?? -1 !! 0;
	}

	sub parse(Str $version) {
		my @digits = $version.split('.');
		my ($last_digit, $alpha) = @digits.pop.split('_');
		@digits.push($last_digit);

		return @digits, $alpha;
	}
}

Output

   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
1_0   > 1     1
10    > 1.0   1
1.1.1 < 1.2.1 -1

TASK #2 › Ordered Lineup

Reviewed by Ryan Thompson


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.

Here is a diagram of the input arrays @H and @T:

Finally, here is one possible solution that satisfies @H and @T:

As per the last diagram, 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.)


Here’s a 64-person example, with answer provided:

# Heights
@H = (27, 21, 37,  4, 19, 52, 23, 64,  1,  7, 51, 17, 24, 50,  3,  2,
      34, 40, 47, 20,  8, 56, 14, 16, 42, 38, 62, 53, 31, 41, 55, 59,
      48, 12, 32, 61,  9, 60, 46, 26, 58, 25, 15, 36, 11, 44, 63, 28,
       5, 54, 10, 49, 57, 30, 29, 22, 35, 39, 45, 43, 18,  6, 13, 33);

# Number taller people in front
@T = ( 6, 41,  1, 49, 38, 12,  1,  0, 58, 47,  4, 17, 26,  1, 61, 12,
      29,  3,  4, 11, 45,  1, 32,  5,  9, 19,  1,  4, 28, 12,  2,  2,
      13, 18, 19,  3,  4,  1, 10, 16,  4,  3, 29,  5, 49,  1,  1, 24,
       2,  1, 38,  7,  7, 14, 35, 25,  0,  5,  4, 19, 10, 13,  4, 12);

# Expected answer
@A = (35, 23,  5, 64, 37,  9, 13, 25, 16, 44, 50, 40,  2, 27, 36,  6,
      18, 54, 20, 39, 56, 45, 12, 47, 17, 33, 55, 30, 26, 51, 42, 53,
      49, 41, 32, 15, 22, 60, 14, 46, 24, 59, 10, 28, 62, 38, 58, 63,
       8, 48,  4,  7, 31, 19, 61, 43, 57, 11,  1, 34, 21, 52, 29,  3);

You’re free to come up with your own inputs. Here is a 1000-person list, if you like!


This was an interesting challenge. First there will always only be one or no solution. Someone probably has written a proof somewhere, but that’s not too important. What’s important is the algorithm behind solving the problem,.

I decided to solve the problem by first ordering the height from shortest to tallest and placing each person in the appropriate slot.

But first I needed to keep the orders of the number of taller people by storing this information in a hash called data

so: $data{1} = 1 … $data{6} = 0;

This is just easy access to the number of taller people information.

Once the heights are ordered its just a matter of placing the people from shortest to tallest. Placing each person is easy because there is only one slot that they can be located at.

Here is the placing algorithm with the example of the array of 6 people

The shorted person of height 1 has 1 person in front of him. This means that no matter what happens there will be at most 1 person in front of him. Because he is the shortest person there is only one slot this can be possible so he goes to slot 1. (Slot 0 being reserved for the taller person)

so the answer looks like this:
– 1 – – – –

Then we place person 2 who also has one person in front of him. Person 2 gets placed in slot 1, but since it’s occupied. He is moved down. So now person 2 will still only have 1 person taller than him, the person at slot 0.

– 1 2 – – – –

Person 3 has 2 people in front of him. He gets placed in slot 2, but since persons 1 and 2 occupy these slots, person 3 is is placed in slot 2 + the number of people between him and his final resting slot

– 1 2 – 3 – –

Person 4 also has 2 people in front of him. He gets placed in slot 2, but since persons 1 and 2 occupy these slots, and person 3 also occupies a slot person 4 is is placed in slot 2 + the number of people between him and his final resting slot (so person 4 ends up in slot 5);

– 1 2 – 3 4

Person 5 has 0 people in front of him. He gets placed in slot 0. And since it’s free he goes right in.

5 1 2 – 3 4

Person 6 has 0 people in front of him. He gets placed in slot 0. But since it’s occupied he goes to the next available open slot.

5 1 2 6 3 4

That’s the answer.

Also this program runs slightly faster than O(n^2);

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-2.pl

use strict;
use warnings;
use feature qw /say/;

# Heights
my @H = (27, 21, 37,  4, 19, 52, 23, 64,
          1,  7, 51, 17, 24, 50,  3,  2,
         34, 40, 47, 20,  8, 56, 14, 16,
         42, 38, 62, 53, 31, 41, 55, 59,
         48, 12, 32, 61,  9, 60, 46, 26,
         58, 25, 15, 36, 11, 44, 63, 28,
          5, 54, 10, 49, 57, 30, 29, 22,
         35, 39, 45, 43, 18,  6, 13, 33);

# Number taller people in front
my @T = ( 6, 41,  1, 49, 38, 12,  1,  0,
         58, 47,  4, 17, 26,  1, 61, 12,
         29,  3,  4, 11, 45,  1, 32,  5,
          9, 19,  1,  4, 28, 12,  2,  2,
         13, 18, 19,  3,  4,  1, 10, 16,
          4,  3, 29,  5, 49,  1,  1, 24,
          2,  1, 38,  7,  7, 14, 35, 25,
          0,  5,  4, 19, 10, 13,  4, 12);

# Easier to access taller people in front;
my %data;
@data{@H} = @T;

# sort
@H = sort { $a <=> $b } @H;

# Process answers
my @answers;
for my $h (@H) {
	my $index = $data{$h};
	for (my $i = 0; $i <= $index; $i++) {
		$index++ if (defined($answers[$i]));
	}
	$answers[$index] = $h;
}

say '[' . (join ', ', @answers) . ']';

Output

[35, 23, 5, 64, 37, 9, 13, 25, 16, 44, 50, 40, 2, 27, 36, 6, 18, 54, 20, 39, 56, 45, 12, 47, 17, 33, 55, 30, 26, 51, 42, 53, 49, 41, 32, 15, 22, 60, 14, 46, 24, 59, 10, 28, 62, 38, 58, 63, 8, 48, 4, 7, 31, 19, 61, 43, 57, 11, 1, 34, 21, 52, 29, 3]

Raku solution

# Test: perl6 ch-2.p6
sub MAIN() {
	# Heights
	my @H = (27, 21, 37,  4, 19, 52, 23, 64,
	         1,  7, 51, 17, 24, 50,  3,  2,
	         34, 40, 47, 20,  8, 56, 14, 16,
	         42, 38, 62, 53, 31, 41, 55, 59,
	         48, 12, 32, 61,  9, 60, 46, 26,
	         58, 25, 15, 36, 11, 44, 63, 28,
	          5, 54, 10, 49, 57, 30, 29, 22,
	         35, 39, 45, 43, 18,  6, 13, 33);

	# Number taller people in front
	my @T = ( 6, 41,  1, 49, 38, 12,  1,  0,
	         58, 47,  4, 17, 26,  1, 61, 12,
	         29,  3,  4, 11, 45,  1, 32,  5,
	          9, 19,  1,  4, 28, 12,  2,  2,
	         13, 18, 19,  3,  4,  1, 10, 16,
	          4,  3, 29,  5, 49,  1,  1, 24,
	          2,  1, 38,  7,  7, 14, 35, 25,
	          0,  5,  4, 19, 10, 13,  4, 12);

	# Easier to index taller people in front;
	my %data;
	for ^@H.elems -> $i {
		%data{@H[$i]} = @T[$i];
	}

	# Sort the height
	@H = @H.sort;

	# Process answers
	my @answers;
	for (@H) -> $h {
		my $index = %data{$h};
		loop (my $i = 0; $i <= $index; $i++) {
			$index++ if (@answers[$i]);
		}
		@answers[$index] = $h;
	}

	say @answers.perl;
}

Output

[35, 23, 5, 64, 37, 9, 13, 25, 16, 44, 50, 40, 2, 27, 36, 6, 18, 54, 20, 39, 56, 45, 12, 47, 17, 33, 55, 30, 26, 51, 42, 53, 49, 41, 32, 15, 22, 60, 14, 46, 24, 59, 10, 28, 62, 38, 58, 63, 8, 48, 4, 7, 31, 19, 61, 43, 57, 11, 1, 34, 21, 52, 29, 3]

Here is the solution for the 1000 array (where I’ve formatted the solution 10 to a row):

  204  926  704  543  760  691  795  303  136  650
  749  721  388   70  461  429  585  276  819  523
  160   92  134   40   46  440  989  394  374  566
  842  851  516  898  448  283   54  975  813  123
  342  142  797  613  163  982  392  529  300  240
  953  491  519  225  945   53  872  197  209  941
  298  884  955   48  930  788  967  494  664  130
  120  294  467  950   94  513  416  398  707  355
  890   68  559  869  640  266  183  158  711  179
  301  616   49  861  633  826  159  684  475  460
  151  498  998  680  147  540  496  720  807  412
  595  393  153  860  521  341  369   97  852  539
  700  712  318  140  546  446  895  669  246  268
  241  569  897  269  112  833  786  960  905  293
  772  682  331  894  117  676   62  940  156  256
  690  933  641  843   29  380  199  202  577  714
  634  274  185  203  570  133  571  173  964  497
  128  538  423  172  162  947  722  295  827   19
  436  345  552  723  822  477  109  695  790  150
  474  330  488  929  422  771   43  638  801  888
   85  665  618   33   72  603  226  277   56  237
  986  605  744   79  601  122  766  910  866  651
  841  486  908  692  949   98  384  366   84  194
  264  334  368   15   80  390  433  262  865  210
  899  994  732  408  806  702    9  913  649  972
  653   21  902  903  862  385  686  233  816  182
  471  406  784  344  435  364   50  104  858  572
   31  457  689  547  639  376  170  377  560  459
   45  810  137  103  285  464  324  124  818   59
  677   89  234  121  802  545  900  280  579  319
  132  327   93  877  954  466  354  779  458  916
  425  863  799  167  783  856  855   37  361  746
  484  582  758  437  317  288   32  767  447  554
  837  701  463  706  928  672  590  918  768  725
  542  169  352  753  189  593  245  596  254  281
  567   30  562  780  157  360  936  520  184  371
  668  859  272  883  759  193  804  396  817  983
  252   73  260  893  934  754  533    3  426  710
  365  937  693  814  315  896   28  154  333   36
  970  997  251   57  127  944  948   13  715  271
  637  961  504  643  164  472  996  836  847  602
  306  909  770  832  681  673  326  105   18  925
   51  106   99  148  977  755  155  907  200  485
  107  999  418  844    1  316  400  956  528  501
   77  957  583  389  309  166  798  703   81  320
  993  227  762  705  838  220  343  395  192  323
  800  679  867  708  699  743   25   20  946  217
   26  976  654  604  881  688  687  735  530  487
  482  991  110  839  215  391  135  175  258  278
  367  387  116  963  662  118  503  981  444  598
  438  424  505  628  912  773  661  141 1000  328
  451  265   63  228  500  531  629  171  581  959
  731  493  794  599  206  741  180  667  619  808
  777  966  647   44  229  405  532   24  275  421
  232  273  920  917  353   11  606   95  990  311
  249  781  636  718  551  875  402  592  787  230
  556  985  846  145  796  971  968  483  575  987
  174   75  239   23  250  549  372  216  563  789
  313   78  322  889  290  825   22  102  403  611
  829  729  178  499  386  716  428  454  553  657
  218  979  871  973  988   86  587   34  635   91
  757  751  674  775  880  510   61  404  821  873
   96   65  417   66  632  238   38  882   55  644
  541  739  555  879  778  738  823  769  524  235
  452  752  717  473  730  511  978  678   10  537
  685  188  951  621  495  212  321  359  287  350
  835  713  550  370   88  921   82  168  415  462
  443  492  573  146  763  608  407  198  236  698
  785  809  119  196  409  469  347  756    5  358
  126  381  149  943  165  803   90  340  887  939
  927  558  848  307  337   35  645  176  489   60
  812  995  201  114  522  312   69  952  526  820
  840  411  465   17    6  648  111  414  901  261
  815  514  764  696   41  397  655  652  728  600
  747  906  683  719  139  383  401  765  962  259
  219  617  129  734   14  612    8  214  958  291
  518  470   47  450  782  339  656   74  670  904
  431   39  399   16  517  224  694  857  279  507
  623  338  726  434  439  630  828  737  441  992
  589  886  248   27  853  115  591  479  923  624
  267  205  289  931  195  733  373  453  924  420
  432  282  642  329  697  805  969   52  811  480
  922  296  615  304  627  870  597  378  666  292
  663  325  242  506  442  515  143  101  544  849
  456  791  297  965   67  270  527  574  243  614
  253  379  356  190  594  346  742  430   87  413
  427  208    4  659  607  850  468  502  362  231
  375  774  626  793  223  125  919  308  620  255
  748   58  557  761  942  100  186  161   71  586
  727  580  892  314  878  509  584  914  490  177
  351  891  915  845  284  750  299  830  445  221
  336  824  588  864  536  310  736  211  876  247
  525   76  548  181  974  980  512  476  349  565
  625  709  658  263   83  191  478  535  609  508
  244  885  257  449  534  357  660  831  144  646
  935  305  776  740  671  631  419  302  481  410
  622  286  724  113  854  108   12  932  222  675
  874  382  578  868  332  911  561    7  207  610
  138  792  213  576  152  938   64  131  568  348
  363  745  984  187    2  564  335  834  455   42

One thought on “PERL WEEKLY CHALLENGE – 058

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s