# RabbitFarm

### 2020-11-29

#### Perl Weekly Challenge 088

## Part 1

*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].*

### Solution

```
use strict;
use warnings;
##
# 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].
##
sub list_product{
my @numbers = @_;
my $product = 1;
map {$product *= $_ } @numbers;
return $product;
}
MAIN:{
my(@N, @M);
@N = (5, 2, 1, 4, 3);
for my $i (0 .. (@N - 1)){
my @numbers = @N[0 .. $i - 1, $i+1 .. (@N - 1)];
push @M, list_product(@numbers);
}
print "(" . join(", ", @M) . ")\n";
@M = ();
@N = (2, 1, 4, 3);
for my $i (0 .. (@N - 1)){
my @numbers = @N[0 .. $i - 1, $i+1 .. (@N - 1)];
push @M, list_product(@numbers);
}
print "(" . join(", ", @M) . ")\n";
}
```

### Sample Run

```
$ perl perl/ch-1.pl
(24, 60, 120, 30, 40)
(12, 24, 6, 8)
```

### Notes

Taking the product of a list of numbers is a well known perl idiom using map. To keep the code somewhat cleaner I placed the list_product computation in it’s own subroutine. The trickiest part, then, is to make sure the list has the right element removed. This is done using array slices. as we loop over the array of numbers we construct a list of indices which do not include the current element.

Another possible approach would be to use a `map`

inside the loop to identify the elements we want to retain. I decided against that approach since it would be a second complete full iteration over the list. To be fair, I don’t necessarily try to always make these challenge solutions all that efficient, but this just happened to strike me as particularly egregious at the time!

## Part 2

*You are given m x n matrix of positive integers. Write a script to print spiral matrix as a list.*

### Solution

```
use strict;
use warnings;
##
# You are given m x n matrix of positive integers.
# Write a script to print spiral matrix as a list.
##
sub print_remove_top{
my(@matrix) = @_;
print join(", ", @{$matrix[0]}) . ", ";
splice(@matrix, 0, 1);
return @matrix;
}
sub print_remove_right{
my(@matrix) = @_;
my @right;
for my $row (@matrix){
push @right, $row->[-1];
my @a = @{$row}[0 .. (@{$row} - 2)];
$row = \@a;
}
print join(", ", @right) . ", ";
return @matrix;
}
sub print_remove_bottom{
my(@matrix) = @_;
print join(", ", reverse(@{$matrix[-1]})) . ", ";
splice(@matrix, -1);
return @matrix;
}
sub print_remove_left{
my(@matrix) = @_;
my @left;
for my $row (@matrix){
push @left, $row->[0];
my @a = @{$row}[1 .. (@{$row} - 1)];
$row = \@a;
}
print join(", ", reverse(@left)) . ", ";
return @matrix;
}
sub spiral_print{
my(@matrix) = @_;
print "[";
{
@matrix = print_remove_top(@matrix) if @matrix;
@matrix = print_remove_right(@matrix) if @matrix;
@matrix = print_remove_bottom(@matrix) if @matrix;
@matrix = print_remove_left(@matrix) if @matrix;
redo if @matrix;
}
print "\b\b]\n";
}
MAIN:{
spiral_print(
[1, 2, 3],
[4, 5, 6],
[7, 8, 9]
);
spiral_print(
[ 1, 2, 3, 4],
[ 5, 6, 7, 8],
[ 9, 10, 11, 12],
[13, 14, 15, 16]
);
}
```

### Sample Run

```
$ perl perl/ch-2.pl
[1, 2, 3, 6, 9, 8, 7, 4, 5]
[1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10]
```

### Notes

The spiral print works in a repeated pattern from the outside in: top row, right column, bottom row, left column. My solution put each print/remove step of this pattern in their own subroutines. A few things worth pointing out

- The matrix is a 2d array: a perl array with inner array references.
- In some cases I use splice to remove from the matrix.
`splice`

doesn’t work on array references (since perl v5.24) so when needing to remove from the matrice’s inner array references I just use the slicing syntax. - redo looked better to me than the equivalent
`while`

loop although obviously either one would work fine. - for the spiral effect we need to print bottom up and right to left. In those cases I first use reverse on the elements being printed.

posted at: 13:56 by: Adam Russell | path: /perl | permanent link to this entry