Perl Weekly Challenge: Week 88

Challenge 1:

Array of Product

You are given an array of positive integers @N.

Write a script to return an array @M where $M[i] is the product of all elements of @N except the index $N[i].

Example 1:
Input:
    @N = (5, 2, 1, 4, 3)

Output:
    @M = (24, 60, 120, 30, 40)

    $M[0] = 2 x 1 x 4 x 3 = 24
    $M[1] = 5 x 1 x 4 x 3 = 60
    $M[2] = 5 x 2 x 4 x 3 = 120
    $M[3] = 5 x 2 x 1 x 3 = 30
    $M[4] = 5 x 2 x 1 x 4 = 40
Example 2:
Input:
    @N = (2, 1, 4, 3)

Output:
    @M = (12, 24, 6, 8)

    $M[0] = 1 x 4 x 3 = 12
    $M[1] = 2 x 4 x 3 = 24
    $M[2] = 2 x 1 x 3 = 6
    $M[3] = 2 x 1 x 4 = 8

Once again I initially overthought the problem, coming up with elaborate methods for removing $N[i] but then it occured to me that multiplying all the elements of @N and then dividing the total by `$N[i] would give exactly the same result. Now in Raku, the solution becomes a one-liner.

[*] multiplies all the arguments passed on the command-line (in @*ARGS.) This is saved as $sum because we will be using it repeatedly. Then .map() is used to transform @*ARGS by dividing $sum by each element. The resulting array is joined with commas and spaces and displayed.

my $sum = [*] @*ARGS; (0 ..^ @*ARGS.elems).map({ $sum / @*ARGS[$_]; }).join(q{, }).say;

(Full code on Github.)

Perl doesn't have the [*] hyperoperator so the solution becomes a little more wordy but it's still pretty concise.

my @N = @ARGV;

my $sum = 1;
for my $e (@N) {
    $sum *= $e;
}

my @M = map { $sum / $N[$_] } 0 .. scalar @N - 1;

say join q{, }, @M;

(Full code on Github.)

Challenge 2:

Spiral Matrix

You are given m x n matrix of positive integers.

Write a script to print spiral matrix as list.

Example 1:
Input:
    [ 1, 2, 3 ]
    [ 4, 5, 6 ]
    [ 7, 8, 9 ]

Ouput:
    [ 1, 2, 3, 6, 9, 8, 7, 4, 5 ]
Example 2:
Input:
    [  1,  2,  3,  4 ]
    [  5,  6,  7,  8 ]
    [  9, 10, 11, 12 ]
    [ 13, 14, 15, 16 ]

Output:
    [ 1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10 ]

I'll show the Raku solution first.

sub MAIN(
    Str $file #= a file describing a matrix of numbers where every line
              #= is a row in the matrix.
) {

A text file containing the matrix is read in first and converted into a 2d array of numbers.

    my @matrix;
    for $file.IO.lines -> $line {
        @matrix.push($line.match(/ (\d+) /, :g));
    }

Variables are set up. @spiral will hold the results. $top and $bottom are the first and last lines respectively. $right and $left are the rightmost and leftmost columns.

    my @spiral;
    my $top = 0;
    my $right = @matrix[0].elems - 1;
    my $bottom = @matrix.elems - 1;
    my $left = 0;

Because each turn of the spiral will traverse the top and bottom rows, at the most top will equal half the number of rows.

    while $top < @matrix.elems / 2 {

I originally didn't have this bit and my code worked for the example matrix given above. However, I wondered if it would work for other matrices. I found that for ones with an odd number of rows such as this one, the last iteration got repeated twice. This check does the right thing for the final row when there are an odd number of rows. Note there is only one element to be processed in this iteration so we could just as easily called it @matrix[$bottom][$right].

        if $top == $bottom {
            push @spiral, @matrix[$top][$left];
        } else {

Now each loop of the spiral can be added to @spiral. First the elements in the top row.

            for $left .. $right -> $i {
                push @spiral, @matrix[$top][$i];
            }

Then the elements in the rightmost column. The top right and bottom right corners are omitted because they will be included by the code for the top and bottom rows.

            for $top ^..^ $bottom -> $i {
                push @spiral, @matrix[$i][$right];
            }

Then the elements in the bottom row in reverse order.

            for reverse $left .. $right -> $i {
                push @spiral, @matrix[$bottom][$i];
            }

Then the elements in the leftmost column in reverse order. Once again, the corners are omitted.

            for reverse $top ^..^ $bottom -> $i {
                push @spiral, @matrix[$i][$left];
            }
        }

Then our positional variables are incremented or decremented as needed so we can do the next inward loop.

        $top++;
        $right--;
        $bottom--;
        $left++;
    }

Finally @spiral is printed with the elements joined with commas and spaces.

    @spiral.join(q{, }).say;
}

(Full code on Github.)

This is the Perl version. It's a straightforward port from Raku so nothing much to comment on.

my $file = shift // usage();

my @matrix;
open my $fn, '<', $file or die "$OS_ERROR\n";
while (my $line = <$fn>) {
    chomp $line;
    push @matrix, [ $line =~ /(\d+)/g ];
}
close $fn;

my @spiral;
my $top = 0;
my $right = scalar @{$matrix[0]} - 1;
my $bottom = scalar @matrix - 1;
my $left = 0;

while ($top < scalar @matrix) {
    if ($top == $bottom) {
        push @spiral, @{$matrix[$top]}[$left];
    } else {

        for my $i ($left .. $right) {
            push @spiral, @{$matrix[$top]}[$i];
        }

        for my $i ($top + 1 .. $bottom - 1) {
            push @spiral, @{$matrix[$i]}[$right];
        }

        for my $i (reverse ($left .. $right)) {
            push @spiral, @{$matrix[$bottom]}[$i];
        }

        for my $i (reverse ($top + 1 .. $bottom - 1)) {
            push @spiral, @{$matrix[$i]}[$left];
        }
    }

    $top++;
    $right--;
    $bottom--;
    $left++;
}

say join q{, }, @spiral;

(Full code on Github.)