# PERL WEEKLY CHALLENGE – 068

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

## TASK #1 › Zero Matrix

You are given a matrix of size `M x N` having only `0s` and `1s`.

Write a script to set the entire row and column to `0` if an element is `0`.

## Example 1

```Input: [1, 0, 1]
[1, 1, 1]
[1, 1, 1]

Output: [0, 0, 0]
[1, 0, 1]
[1, 0, 1]

```

## Example 2

```Input: [1, 0, 1]
[1, 1, 1]
[1, 0, 1]

Output: [0, 0, 0]
[1, 0, 1]
[0, 0, 0]
```

For this challenge, I just create a function `zero` that initialed a cloned matrix with values of 1 and just zero’s out the rows and columns by looping through each item of the original matrix, checking if it’s 0, then zeroing out the columns and rows.,

#### Perl 5 solution

``````#!/usr/bin/perl
# Test: ./ch-1.pl
use Modern::Perl;
use Algorithm::Combinatorics qw(combinations);

my \$m1 = [ [1, 0, 1],
[1, 1, 1],
[1, 1, 1], ];

my \$m2 = [ [1, 0, 1],
[1, 1, 1],
[1, 0, 1], ];

for my \$m (\$m1, \$m2) {
say "Input:";
print_matrix(\$m);

say "Output:";
print_matrix(zero(\$m));
}

# Zero our columns and rows
sub zero {
my \$m = shift;

# Lengths of the matrix
my \$l1 = scalar(@\$m);
my \$l2 = scalar(@{\$m->[0]});

# Initialize new matrix
my \$m2 = [];
for (my \$i = 0; \$i < \$l1; \$i++) {
\$m2->[\$i] = [];
for (my \$j = 0; \$j < \$l2; \$j++) {
\$m2->[\$i][\$j] = 1;
}
}

# Process each element of the matrix
for (my \$i = 0; \$i < \$l1; \$i++) {
for (my \$j = 0; \$j < \$l2; \$j++) {
if (\$m->[\$i][\$j] == 0) {
# zero our rows
\$m2->[\$i][\$_] = 0
for (0 .. \$l2- 1 );

# zero our cols
\$m2->[\$_][\$j] = 0 #
for (0 .. \$l1 - 1)
}
}
}

# Return new matrix
return \$m2;
}

# Print the matrix
sub print_matrix {
my \$m = shift;
my \$l1 = scalar(@\$m);
my \$l2 = scalar(@{\$m->[0]});

# Process each element of the matrix
for (my \$i = 0; \$i < \$l1; \$i++) {
print '[ ';
for (my \$j = 0; \$j < \$l2; \$j++) {
printf ('%3s', \$m->[\$i][\$j]);
}
say ' ]';
}

say '';
}
``````

Output: perl ./ch-1.pl

``````# Test: perl6 ch-1.p6
sub MAIN() {
my @m1 = [ [1, 0, 1],
[1, 1, 1],
[1, 1, 1], ];

my @m2 = [ [1, 0, 1],
[1, 1, 1],
[1, 0, 1], ];

for (@m1, @m2) -> \$m {
say "Input:";
print-matrix(\$m);

say "Output:";
print-matrix(zero(\$m));
}
}

# Zero our columns and rows
sub zero(@m) {
# Initialize new matrix
my \$m2 = [];
for (^@m) -> \$i {
\$m2.[\$i] = [];
for (^@m.[0]) -> \$j {
\$m2.[\$i][\$j] = 1;
}
}

# Process each element of the matrix
for (^@m) -> \$i {
for (^@m.[0]) -> \$j {
if (@m.[\$i][\$j] == 0) {
# zero our rows
for (^@m) -> \$k {
\$m2.[\$k][\$j] = 0;
}

# zero out cols
for (^@m.[0]) -> \$k {
\$m2.[\$i][\$k] = 0;
}
}
}
}

# Return new matrix
return \$m2;
}

# Print the matrix
sub print-matrix(@m) {
my \$l1 = @m.elems;
my \$l2 = @m.[0].elems;

# Process each element of the matrix
for (^@m) -> \$i {
print '[ ';
for (^@m.[0]) -> \$j  {
'%3s'.printf(@m.[\$i][\$j].perl);
}
say ' ]';
}

say '';
}
``````

#### Raku solution

``````# Test: perl6 ch-1.p6
sub MAIN() {
my @m1 = [ [1, 0, 1],
[1, 1, 1],
[1, 1, 1], ];

my @m2 = [ [1, 0, 1],
[1, 1, 1],
[1, 0, 1], ];

for (@m1, @m2) -> \$m {
say "Input:";
print-matrix(\$m);

say "Output:";
print-matrix(zero(\$m));
}
}

# Zero our columns and rows
sub zero(@m) {
# Initialize new matrix
my \$m2 = [];
for (^@m) -> \$i {
\$m2.[\$i] = [];
for (^@m.[0]) -> \$j {
\$m2.[\$i][\$j] = 1;
}
}

# Process each element of the matrix
for (^@m) -> \$i {
for (^@m.[0]) -> \$j {
if (@m.[\$i][\$j] == 0) {
# zero our rows
for (^@m) -> \$k {
\$m2.[\$k][\$j] = 0;
}

# zero out cols
for (^@m.[0]) -> \$k {
\$m2.[\$i][\$k] = 0;
}
}
}
}

# Return new matrix
return \$m2;
}

# Print the matrix
sub print-matrix(@m) {
my \$l1 = @m.elems;
my \$l2 = @m.[0].elems;

# Process each element of the matrix
for (^@m) -> \$i {
print '[ ';
for (^@m.[0]) -> \$j  {
'%3s'.printf(@m.[\$i][\$j].perl);
}
say ' ]';
}

say '';
}
``````

Output perl6 ch-1.p6

``````Input:
[   1  0  1 ]
[   1  1  1 ]
[   1  1  1 ]

Output:
[   0  0  0 ]
[   1  0  1 ]
[   1  0  1 ]

Input:
[   1  0  1 ]
[   1  1  1 ]
[   1  0  1 ]

Output:
[   0  0  0 ]
[   1  0  1 ]
[   0  0  0 ]``````

## TASK #2 › Reorder List

You are given a singly linked list `\$L` as below:

```L0 →  L1 →  … →  Ln-1 →  Ln

```

Write a script to reorder list as below:

```L0 →  Ln →  L1 →  Ln-1 →  L2 →  Ln-2 →

```

You are ONLY allowed to do this in-place without altering the nodes’ values.

## Example

```Input:  1 →  2 →  3 →  4
Output: 1 →  4 →  2 →  3
```

For this challenge I just created a linked list using, Perl’s Mouse OO framework and Raku’s built-in `Class` Object.

Reordering the list is just a matter off moving some references around. Look at the `reorder_list` for how it’s done. The tricky bit was handling the edge case of processing the final traversed node.

#### Perl 5 solution

``````#!/usr/bin/perl
# Test: ./ch-2.pl
use Mouse;

has 'value' => (
is  => 'rw',
isa => 'Maybe[Int]',
default => sub {
return undef;
}
);

has 'next' => (
is  => 'rw',
default => sub {
return undef
}
);

__PACKAGE__->meta->make_immutable();

use Mouse;
use feature qw /say/;

has 'first'  => (
is  => 'rw',
default => sub {
return undef
}
);

# Create the list
sub create_list {
my (\$self, @values) = @_;
my \$prev_node;

# Populate the list
for my \$value (@values) {
my \$node = LinkedList::Node->new(value => \$value);

# Populate first and next nodes
(\$prev_node) ?
\$prev_node->next(\$node) :
\$self->first(\$node);

# Next
\$prev_node = \$node;
}
}

sub reorder_list {
my (\$self, \$k) = @_;

# Loop through the nodes
my \$node = \$self->first;

# Process each node
while (\$node) {
my \$next_node = \$node->next;
my \$traverse_node = \$node;
my \$last_node = \$node;

while (\$traverse_node->next) {
\$last_node = \$traverse_node;
\$traverse_node = \$traverse_node->next;
}

\$node->next(\$traverse_node);

if (\$next_node && \$next_node->next) {
\$traverse_node->next(\$next_node);
\$last_node->next(undef);
} else {
\$traverse_node->next(undef);
}

\$node = \$next_node;
}
}

sub display_list {
my \$self = shift;

my \$node = \$self->first;
my @keys;

while (\$node) {
push @keys, \$node->value;
\$node = \$node->next;
}

return join ' → ', @keys;
}

__PACKAGE__->meta->make_immutable();

package main;

use Modern::Perl;

\$ll->create_list(1,2,3,4);
say 'Before: ' . \$ll->display_list;
\$ll->reorder_list();
say 'After: ' . \$ll->display_list;
``````

Output ./ch-2.pl

``````Before: 1 → 2 → 3 → 4
After: 1 → 4 → 2 → 3``````

#### Raku solution

``````# Test: perl6 ch-2.p6
has Int \$.value is rw;
}

# Create the list
method create-list(*@values) {
my \$prev_node;

# Populate the list
for @values -> \$value {
my \$node = LinkedList::Node.new(value => \$value);

# Populate first and next nodes
if (\$prev_node) {
\$prev_node.next = \$node
} else {
self.first = \$node;
}

# Next node
\$prev_node = \$node;
}
}

method reorder-list(Int \$k) {
# Loop through the nodes
my \$node = self.first;

# Process each node
while (\$node) {
my \$next_node = \$node.next;
my \$traverse_node = \$node;
my \$last_node = \$node;

while (\$traverse_node.next) {
\$last_node = \$traverse_node;
\$traverse_node = \$traverse_node.next;
}

# Move the nodes around
\$node.next = \$traverse_node;
if (\$next_node && \$next_node.next) {
\$traverse_node.next = \$next_node;
\$last_node.next = Nil;
} else {
\$traverse_node.next = Nil;
}

# Next node
\$node = \$next_node;
}
}

method display-list {
my \$node = self.first;
my @keys;

while (\$node) {
@keys.push(\$node.value);
\$node = \$node.next;
}

return @keys.join(" → ");
}
}

sub MAIN() {
``````Before: 1 → 2 → 3 → 4