Perl Weekly Challenge: Week 68

Challenge 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]

I did the Raku version first.

I took the elements of the matrix from the command line arguments and converted them into a 2d-array like this.

my @input = (0 ..^ $M).map({ [@matrix.splice(0, $N)] });

Then I created an array to hold the results of the same dimensions. Each element is initialized to 1.

my @output = [1 xx $N] xx $M;

We can get each row in the input by using the notation [$m;*]. This is a really nice way of getting a slice of a 2d-array. If the row contains any 0's, the corresponding row in the output is set to all 0's.

for 0 ..^ $M -> $m {
    if @input[$m;*].any == 0 {
        @output[$m;*] = 0 xx $M;
    }
}

Similarly, we can get each column with [*;$n]. If the column contains any 0's, the corresponding columns in the output is set to all 0's.

for 0 ..^ $N -> $n {
    if @input[*;$n].any == 0 {
        @output[*;$n] = 0 xx $N;
    }
}

Then all that remains is to print out the output a row at a time.

for 0 ..^ $M -> $m {
    say @output[$m];
}

(Full code on Github.)

Unlike the Raku, version, @output in the Perl version, is an exact copy of @input.

 my @input = map {[ splice @matrix, 0, $N ]} (0 .. ($M - 1));
 my @output = map { [ map { $_ } @{$_} ] } @input;

Perl lacks .any() (as a builtin; there are CPAN modules that provide it.) but we can use grep() to emulate it for rows. Our 2d-array is actually an array of array references so we have to dereference each row to use it.

 for my $row (0 .. ($M - 1)) {
     if (grep { $_ == 0 } @{$input[$row]}) {
         for my $col (0 .. ($N - 1)) {
             $output[$row][$col] = 0;
         }
     }
 }

Unfortunately due to being an array of array references, we can't make a vertical slice. Actually I have a feeling there is a way, but I couldn't figure it out so I did it the long way round with for loops.

 for my $col (0 .. ($N - 1)) {
     for my $row (0 .. ($M - 1)) {
         if ($input[$row][$col] == 0) {
             for my $zrow (0 .. ($M - 1)) {
                 $output[$zrow][$col] = 0;
             }
             last;
         }
     }
 }

 for my $row (@output) {
     say q{[}, (join q{ }, @{$row}), q{]};
 }

(Full code on Github.)

Challenge 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

Strictly speaking you shouldn't ever need a linked list as Perl and Rakus' native data structures are more than adequate for most jobs. But the spec says to use a linked list so I made one. This is the Raku version.

A Linked list is simply a collection of nodes which have, in addition to whatever data they carry, a pointer to the next node. So my class is called Node and it has two members. One is called value which is a scalar. It will contain integers in this challenge but I don't do any validation so it could be anything really. The second is next which will point to the next Node in the list. I explicitly make is a Node so no other data type can be stored in it.

 class Node {
     has $.value is rw;
     has Node $.next is rw;

The BUILD value is the classes constructor. It has one required parameter which will set value. next by default will be undefined. I've just noticed I've left multi on the signature which is a remnant from previous attempts and is not necessary now.

     multi submethod BUILD( :$value) {
         $!value = $value;
         $!next = Nil;
     }

To add a Node to the linked list, we first traverse through all the next nodes until an undefined one is found and create the new Node there.

     method add($newval) {
         my $v = self;

         while $v.next {
             $v = $v.next;
         }

         $v.next = Node.new(value => $newval);
     }

Similarly, to print the values in the linked list, we traverse through all the next nodes until an undefined one is found, printing the values on the way.

     method print() {

         my $v = self;

         while $v.next {
             print $v.value // q{}, q{ };
             $v = $v.next;
         }

         print $v.value, "\n";
     }

Now we get to the most important method. The algorithm I used here was:

Start at the first node I call it $current.
Traverse the list upto the node before the one before the last node. I call it $second.
Make $seconds next Nil as it will be the new last node in the list now.
Make the last nodes next the $current nodes next thereby inserting it into the right place in the list.
Make the last node the next of $current.
If $current has a defined next (i.e. we are not at the end of the list,) skip forward two nodes else skip forward one Actually, in hindsight I can see that I could have left out the else clause with no ill effects.

Go back to step 1 and continue the cycle until we have reached the end of the list.

 method reorder() {


 my $current = self;


 while $current {
     my $last = $current;
     my $second = $current;
     while $last.next {
         $second = $last;
         $last = $last.next;
     }


     $second.next = Nil;
     $last.next = $current.next;
     $current.next = $last;


     if $current.next {
         $current = $current.next.next;
     } else {
         $current = $current.next;
     }
 }


 }

}

(Full code on Github.)

This is the Perl version of the Raku code above. Perls inbuilt OOP features are serviceable. I use Moo and that make's it a little better but still not nearly as nice as Raku or practically any other modern language. This is why IMO one of the most interesting and exciting proposals surrounding the whole "Perl 7" push is Cor which aims to make a powerful OOP system a standard part of the Perl library.

 package Node;
 use Moo;
 use namespace::autoclean;

 has _value => (
     is => 'rw',
 );

 has _next => (
     is => 'rw',
     isa => sub { return ref eq 'Node'; },
 );

 sub BUILDARGS {
     my ($orig, $class, @args) = @_;

     return { _value => $args[0], _next => undef };
 }

 sub add {
     my ($self, $newval) = @_;

     my $v = $self;
     while ($v->{_next}) {
         $v = $v->{_next};
     }
     $v->{_next} = Node->new(value => $newval);
 }

 sub print {
     my ($self) = @_;

     my $v = $self;

     while ($v) {
         print $v->{_value} // q{}, q{ };
         $v = $v->{_next};
     }

     print "\n";
 }

 sub reorder() {
     my ($self) = @_;

     my $current = $self;

     while ($current) {
         my $last = $current;
         my $second = $current;
         while ($last->{_next}) {
             $second = $last;
             $last = $last->{_next};
         }

         $second->{_next} = undef;
         $last->{_next} = $current->{_next};
         $current->{_next} = $last;

         if ($current->{_next}) {
             $current = $current->{_next}->{_next};
         } else {
             $current = $current->{_next};
         }
     }
 }

 1;

(Full code on Github.)