Perl Weekly Challenge: Week 251

Challenge 1:

Concatenation Value

You are given an array of integers, @ints.

Write a script to find the concatenation value of the given array.

The concatenation of two numbers is the number formed by concatenating their numerals.

For example, the concatenation of 10, 21 is 1021.
The concatenation value of @ints is initially equal to 0.
Perform this operation until @ints becomes empty:

If there exists more than one number in @ints, pick the first element
and last element in @ints respectively and add the value of their
concatenation to the concatenation value of @ints, then delete the
first and last element from @ints.

If one element exists, add its value to the concatenation value of
@ints, then delete it.
Example 1
Input: @ints = (6, 12, 25, 1)
Output: 1286

1st operation: concatenation of 6 and 1 is 61
2nd operation: concaternation of 12 and 25 is 1225

Concatenation Value => 61 + 1225 => 1286
Example 2
Input: @ints = (10, 7, 31, 5, 2, 2)
Output: 489

1st operation: concatenation of 10 and 2 is 102
2nd operation: concatenation of 7 and 2 is 72
3rd operation: concatenation of 31 and 5 is 315

Concatenation Value => 102 + 72 + 315 => 489
Example 3
Input: @ints = (1, 2, 10)
Output: 112

1st operation: concatenation of 1 and 10 is 110
2nd operation: only element left is 2

Concatenation Value => 110 + 2 => 112

My first attempt at a solution involved finding first and last indices of the @ints array and then splicing them off and so on but there is a much easier way.

First we define a variable to hold the total concatenation value.

my $total = 0;

Then while we have more than one element left...

while @ints.elems > 1 {

...we remove the first element with .shift() and the last element with .pop(). Both .shift() and .pop() return the element removed so we can concatenate those and add them to $total.

    $total += @ints.shift ~ @ints.pop;
}

If there were an even number of elements in @ints we are done. If there was an odd number, there will still be one element left so we just add that to $total.

if @ints.elems {
    $total += @ints[0];
}

Finally, we print the value of total.

say $total;

(Full code on Github.)

The same thing can be done in Perl.

my $total = 0;

while (scalar @ARGV > 1) {
    $total += shift . pop;
}

if (scalar @ARGV) {
    $total += $ARGV[0];
}

say $total;

(Full code on Github.)

Challenge 2:

Lucky Numbers

You are given a m x n matrix of distinct numbers.

Write a script to return the lucky number, if there is one, or -1 if not.

A lucky number is an element of the matrix such that it is
the minimum element in its row and maximum in its column.
Example 1
Input: $matrix = [ [ 3,  7,  8],
                   [ 9, 11, 13],
                   [15, 16, 17] ];
Output: 15

15 is the only lucky number since it is the minimum in its row
and the maximum in its column.
Example 2
Input: $matrix = [ [ 1, 10,  4,  2],
                   [ 9,  3,  8,  7],
                   [15, 16, 17, 12] ];
Output: 12
Example 3
Input: $matrix = [ [7 ,8],
                   [1 ,2] ];
Output: 7

The first job is to get the input from the command line into a form which can be used by Raku. I chose to use a series of strings each representing a row with elements seperated by by spaces. So example 1 would look like: "3 7 8" "9 11 13" "15 16 17"

This input can be turned into a 2d array with the following line:

my @matrix = @args.map({ [ $_.words.map({ .Int }) ] });

.map() takes each command-line argument and splits it into whitespace-delimited substrings with .word(). A further .map() converts these substring to integers with .Int() and the whole thing is packaged as an array and added to @matrix.

The .keys() method for Listss returns all the indices of elements in that list. We can use that with .map() to select each row of the matrix and get the minimum element with .min(). That value is appended to a list called @mins. In the event we can't find a minimum value (I can't think how,) -1 is added instead.

my @mins = @matrix.keys.map({ @matrix[$_].min || -1 });

The same technique is used to search through the columns of the matrix looking for maximum values with .max() and adding them to the @maxs list.

my @maxs  = @matrix[0].keys.map({ @matrix[*;$_].max || -1 });

The set operator gives us the intersection of @mins and @maxs. .keys() in this case gives us the elements in that set which are the numbers which are both the minimum in their rows and the maximum in their columns or in other words lucky numbers. They are printed, space-separated, with .join() and .say().

(@mins ∩ @maxs).keys.join(q{ }).say;

(Full code on Github.)

For Perl I had to code replacements for the intersection operator, .min() and .max(). Because I didn't have much time, these may not be the optimized, or indeed correct, implementations but they work for the task at hand.

intersection() takes two arrays by reference as parameters.

sub intersection {
    my ($arr1, $arr2) = @_;

The elements of both arrays are added as keys to a hash. The values of that hash are the number of times the key has occurred.

    my %intersection;
    for my $i (@{$arr1}, @{$arr2}) {
        $intersection{$i}++;
    }

With .grep() we find the keys that have occurred more than once. That should be the intersection of the two arrays.

    return grep { $intersection{$_} > 1 } keys %intersection;
}

max() takes an array as its' parameter.

sub max {
    my @arr = @_;

A variable $highest is declared and set to the lowest possible value.

    my $highest = '-inf';

Then we go through the elements of the array and if an element is higher than the current value of $highest it becomes the new value of $highest.

    for my $i (@arr) {
        if ($i > $highest) {
            $highest = $i;
        }
    }

The final value of $highest is returned.

    return $highest;
}

min() works the same way except $lowest is set to the highest value and we find the lowest value.

sub min {
    my @arr = @_;
    my $lowest = 'inf';
    for my $i (@arr) {
        if ($i < $lowest) {
            $lowest = $i;
        }
    }

    return $lowest;
}

Armed with these functions, we can easily translate the Raku solution.

my @matrix = map { [ map { 0 + $_} split /\s+/ ] } @ARGV;
my @mins;
my @maxs;

for my $i (0 .. scalar @matrix - 1) {
    push @mins, min(@{$matrix[$i]}) || -1;
}

Unfortunately Perl does not have a way of slicing a column from a 2d array as elegant as Raku so an extra map() is needed.

for my $i (0 .. scalar @{$matrix[0]} - 1) {
    push @maxs, max(map { $matrix[$_]->[$i] } 0 .. scalar @matrix - 1) || -1;
}

say join q{ }, intersection(\@mins, \@maxs);

(Full code on Github.)