Zero-Sum Basket Weaving

Wherein we stare into nothingness, finger the fibers and weave the connections that bind us forward into the future…

THE WEEKLY CHALLENGE – PERL & RAKU #68

TASK #1 › Zero Matrix

Submitted by: Mohammad S Anwar

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]

Method

This was a fun one. The problem here is to null out both the row and column data for every zero encountered when going through the matrix. We could systematically traverse the matrix, and change out the rows and columns as we find each occurrence, but that causes a problem when we change out the data for points we haven’t yet observed. It’s a problem of causality; our observation, you might say, is changing the future.

Time travel paradoxes aside, the way to avoid this is to not do it. Remarkably, I have found many of life’s problems respond well to this simple treatment. What we need to do instead is systematically go through the matrix and somehow record which rows and columns are affected whilst leaving the original matrix untouched. Then, only when we are completely finished, we can then go through the matrix a second time and resolve the changes required.

To do this recording we will need two arrays, one representing the rows, the other the columns. We consider the 0s to be ‘opaque’ – that is, that a single 0 is enough to occlude the whole row or column. Two 0s won’t have any further effect. Whenever a 0 is encountered, we will know that point’s indices, so on each of the two arrays if the value isn’t already true, we make it so.

There is no special data type to hold a matrix in either Perl nor Raku, but both can manipulate multidimensional arrays just fine. As such we will hold our matrix in an array of arrays; an array of rows with each element holding an array of the columns for that row. For all intents and purposes, from the 0’s point of view rows and columns are interchangeable. They null out the data orthogonally around themselves without regard to up and down or left and right. But from the data structure’s POV, it’s a little different, allowing us to make a slight optimization when we get about to doing the transform.

To traverse the matrix, we set up two loops, an outer one to process row indices, and an inter one to iterate through columns. For the observation part of the method, we need to examine every single point. There’s no getting around that. But for the transformation step, if the row record says there is an occlusion, we can immediately replace that entire row with a new row of 0s and jump to the next iteration, never even bothering to examine the individual points.

Because wiping a whole row is so easy, I briefly contemplated turning the whole matrix 90° after making a pass over the rows to do the columns, but decided with the rotation (and counterrotation), although pretty easy, it wasn’t worth the overhead for effort saved. Although it still sounds like a fun, if not practical nor efficient, way to go about things.

Raku Solution

In Raku we have a native Boolean type to record the occlusion data, which makes the process very clear, so we’ll start there. The logic to record the arrays is based around the ?|= operator cluster, or Boolean-Or-Equals. I like the fact that although there’s nothing in the documentation specific to this construction, we can assume it exists, try it, and sure enough it works just like you’d think it would. Thus if the row or column array element at the index is True, it will remain true and short-circuit, but if it’s False the right hand side is evaluated and if True, the element is changed. For rows, the right-hand side sums the row and compares that to the number of elements; if any element is zero those values will differ. For columns, we need to look at the individual point and use the ! Boolean Negation operator, a 0 will be coerced to True, a 1, False.

Further down in the transformation section, we can use another short circuit when looking at rows:

        next if @row_zeros[$row] and @matrix[$row] = (0) xx $cols;

Note that single = is not a mistake, but in fact an assignment. The expression first looks at the element in the record array and if that is True, only then evaluates the assignment on the right which replaces the row with a new array of 0s.

Having explicit Boolean types makes the logic much easier to follow and debug here. I have included an output of the intermediate arrays to show how things work:

[colincrain:~/PWC]$  raku 68-1-zip-zilch-zero.raku 11011 11010 11111 11111
Input:
	1 1 0 1 1
	1 1 0 1 0
	1 1 1 1 1
	1 1 1 1 1

Zero Occlusions:
   cols: [False False True False True]
   rows: [True True False False]

Output:
	0 0 0 0 0
	0 0 0 0 0
	1 1 0 1 0
	1 1 0 1 0

multi MAIN ( ) {
    say q:to/END/; 
    Usage: ./zip-zilch-zero.raku row1 row2 row3 
        rows are values 1 and 0 concactenated into strings
        ex: ./zip-zilch-zero.raku 1001 1111 1011 1111
    END
}

multi MAIN ( *@matrix ) {
    ## as by challenge definition we only use 1s and 0s,
    ## concatenate individual rows into strings
    ## example: 101 111 111 001
    @matrix .= map({.comb.Array});       ## comb makes Seq not a Array
    my $rows = @matrix.elems;
    my $cols = @matrix[0].elems;
    print_matrix(@matrix,  "Input:");
        
    ## 0s are considered 'opaque' -- a single 0 occludes the entire
    ## row or column We pass once through the matrix, row by row,
    ## recording the 0 occurence data to two arrays, one for rows, 
    ## the other columns
    my @row_zeros;
    my @col_zeros;
    
    for ^$rows -> $row {
        @row_zeros[$row] ?|= (@matrix[$row].sum != $cols);
        for ^$cols -> $col {
            @col_zeros[$col] ?|= ! @matrix[$row][$col].Int;
        }
    }
    
    ## report midway through
    say "Zero Occlusions:";
    say "   cols: ",  @col_zeros;
    say "   rows: ",  @row_zeros, "\n";
    
    ## now we can pass through the matrix again, transferring the
    ## occurence data back to the rows and columns, zeroing them out
    ## as specified
    for ^$rows -> $row {
        next if @row_zeros[$row] and @matrix[$row] = (0) xx $cols;
        for ^$cols -> $col {
            @matrix[$row][$col] = (! @col_zeros[$col]).Int;
        }
    }

    print_matrix(@matrix,  "Output:");

}

sub print_matrix ( @matrix, $heading? ) {
    $heading.say if $heading;
    ("\t" ~ $_.join(' ')).say for @matrix;
    "".say;
}

Perl Solution

In Perl we have to settle for 1s as truth¹ and 0s as false, which, because we’re using 0s as the objects we are looking for, allows a little more room for confusion. But it’s not a disaster or anything. We lack having a sum() function out of the box, so rather than import one we can just add up the rows as we traverse them and do it that way. We could still use the short-circuit on transformation trick for the rows, as the assignment resolves to a reference like ARRAY(0x7ff69c0184e8) and hence is logically true, but I think it sacrifices clarity for cleverness without a real Boolean type, so we’ll use an if block instead and be done with it.

¹ Or any defined non-zero value, to be sure. But we’re using 1s here.

[colincrain:~/PWC]$  perl 68_1_zip-zilch-zero.pl 11011 11010 11111 11111
Input:
	[ 1, 1, 0, 1, 1 ]
	[ 1, 1, 0, 1, 0 ]
	[ 1, 1, 1, 1, 1 ]
	[ 1, 1, 1, 1, 1 ]

Zero Occlusions:
    cols: 0 0 1 0 1
    rows: 1 1 0 0

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

use warnings;
use strict;
use feature ":5.26";

## ## ## ## ## MAIN:

## as by challenge definition we only use 1s and 0s,
## concatenate individual rows into strings
## example: 101 111 111 001
my @matrix;
push @matrix, map { [ split //, $_ ] } @ARGV;
my $rows = @matrix;
my $cols = $matrix[0]->@*;

print_matrix(\@matrix, "Input:");

## 0s are considered 'opaque' -- a single 0 occludes the entire row or column
## We pass once through the matrix, row by row, recording the 0 occurence data to 
## two arrays, one for rows, the other columns
my @row_zeros = (0) x $rows;
my @col_zeros = (0) x $cols;

for my $row_idx (0..$rows-1) {
    my $sum = 0;
    for my $col_idx ( 0..$cols-1) {
        $sum += $matrix[$row_idx]->[$col_idx];
        $col_zeros[$col_idx] |= ! $matrix[$row_idx]->[$col_idx];
    }
    $row_zeros[$row_idx] = 1 if $sum != $cols;
}

say<<__END__;

Zero Occlusions:
    cols: @col_zeros
    rows: @row_zeros
__END__

## now we can pass through the matrix again, transferring the occurence
## data back to the rows and columns, zeroing them out as specified
for my $row_idx (0..$rows-1) {
    if ($row_zeros[$row_idx] == 1) {
        $matrix[$row_idx] = [ (0) x $cols ];
        next;
    }
    for my $col_idx ( 0..$cols-1) {
        $matrix[$row_idx]->[$col_idx] = 0 if $col_zeros[$col_idx] == 1;
    }
}

print_matrix(\@matrix, "Output:");

## ## ## ## ## SUBS:

sub print_matrix {
    my ($matrix, $heading ) = @_;
    say "$heading";
    for ($matrix->@*) {
        say "\t[ ", (join ', ', $_->@*), " ]";
    }
}

TASK #2 › Reorder List

Submitted by: Mohammad S Anwar

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

Method

We last used a linked list back in PWC 59, so a good place to start is to look there; we can pull out some classes and objects to build the data structure and then worry about what exactly it is we wish to do with it

On an abstract level, the basic algorithm is simple:

1. start the splice node at the first node of the list
2. travel to the last node
3. take the last node and insert it following the splice node
4. jump forward past the inserted node and repeat from 2
5. continue until we cannot move any more nodes

To do this we just need two pointers. Oh, and yes we should remember the location of the starting node somewhere so we can look at our handiwork when we’re done. That would be nice.

Raku Solution

Playing around with Raku classes i came up with two: a Node type, with attributes to hold a value and the next Node in the chain, and a LinkedList type to take care of things pertaining to the data structure, such as the first node, and some handy methods for IO, to load in a list from an array and to print out a list using values connected by arrows. Also, from the needs of the challenge, I created a private !last attribute, which made the traversal logic much cleaner. The !last attribute gets a custom accessor as well, but I’ll get to that.

We name our pointers $splicepoint and $node. Because our list links only go one way, there is no way direct way to travel backwards and identify what Node links forward to a given node, so the nodes we will point to will be the nodes immediately before the ones we wish to act on. Hence the splice point will be immediately after that node, starting with the start node, and $node, the working node, will travel to the node immediately before the last node. The splicing operation itself can be done without an intermediate variable:

        $list.last.next   = $splicepoint.next;
        $splicepoint.next = $list.last;
        $list.last        = $node;

Because we have the last node in the list to refer to, the code is pretty clean:

• set the last node next link to the current splice point next link
• update the splice point next link to point to the last node
• assign the working node to be the last node in the list

An astute observer will have noticed that the working node, now assigned to be the last node, will still point to the newly reordered previously last node. This is a problem that we could easily solve be setting the next node to Nil, but there’s another way. Remember that our list!last is a private attribute? Because of this it cannot be directly read or written to, but requires an accessor to do that job.¹ Why have we done this? Because then we can install a Proxy for that accessor, which allows us to execute arbitrary code on read and write to that container. In this case, on setting the $!last attribute (called STORE in the Proxy), we can automatically trigger setting the .next attribute of the new value to Nil. Sweet.

Once we do this we reset the node and splice point to $splicepoint.next.next, to hopscotch the node we just added, and jump ahead before restarting the loop, continuing until the last node is right before us.

There is one more thing though. Because we start at node 1, and jump ahead 2 on every pass, it follows that the splice point nodes will always fall on the odd numbered nodes. So if there are 8 nodes to the list, the splice point will eventually land on the seventh node, whatever that node may be at that point. (It’s the fourth node in the original list, for those counting.) The splice point isn’t the last node so the loop continues, but we can’t jump ahead two nodes at the end of our loop as there’s no there there. It’s a good thing that should this happen, we’re done rearranging anyway, so we hightail it out home free. This exit condition could easily be rolled in as

... and $splicepoint.next !=== $list.last

in the while(), but I felt that was putting too much logic on one line, so I kept it as a separate edge case. This only happens when the list length is even, and it does make that line awfully long.

[colincrain@boris:~/Code/PWC]$  raku 68-2-basket_weaving.raku 1 2 3 4 5 6 7 8 
1 → 2 → 3 → 4 → 5 → 6 → 7 → 8
1 → 8 → 2 → 3 → 4 → 5 → 6 → 7
1 → 8 → 2 → 7 → 3 → 4 → 5 → 6
1 → 8 → 2 → 7 → 3 → 6 → 4 → 5

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

class LinkedList {
    has Node $.first is rw;
    has Node $!last;                     
    
    ## custom accessor for list.last
    ## sets up a trigger on write to set node.next to Nil
    method last( Node $node? ) is rw {
        Proxy.new:
            FETCH => sub ($)         { $!last },
            STORE => sub ($, $node)  { $!last = $node;
                                       $node.next = Nil },             
    }  
    
    method populate_from_array ( @array ) {
        my $node;
        my $next;
        while @array.elems > 0 {
            $node = Node.new(value => @array.pop);
            $!last //= $node;
            $node.next = $next if $next.defined;
            $next = $node;
        }
        $.first = $node;
    }
    
    method arrow_print () {
        my @output;
        my $node = $.first;
        loop {
            @output.push: $node.value;
            last if $node === $!last;
            $node = $node.next;
        }
        @output.join(' → ').say;
    }  
}

multi MAIN () {
    say "Usage: ./basket-weaving.raku value1 value2 value3 ...";
}

multi MAIN ( *@input ) {

    ## convert the input commandline array into a linked list
    my $list = LinkedList.new();
    $list.populate_from_array( @input );
    $list.arrow_print();

    ## the moved node inserts after the splice point
    ## $node is a working container
    my $splicepoint = my $node = $list.first;
    
    while $splicepoint !=== $list.last {

        ## when the splice point is second to last before the splice,
        ## last node is to be spliced into the same location
        ## we are done so jump out
        ## This happens only when the node count is even.
        last if $splicepoint.next === $list.last;    

        ## temporarily go to the 2nd to last node
        $node = $node.next while $node.next !=== $list.last;

        ## relink the last node:
        ##   set the last node .next to the splice point .next
        ##   update the splice point .next to the last node
        ##   update the last node to the working node
        $list.last.next   = $splicepoint.next;
        $splicepoint.next = $list.last;
        $list.last        = $node;
    
        ## reset the splice point and working node to 
        ## jump forward 2 nodes and splice again
        $node = $splicepoint = $splicepoint.next.next;
 
        $list.arrow_print();

    }
}

[colincrain:~/PWC]$  perl 68_2_basket-weaving.pl 1 2 3 4 5 6 7 8 9
1 → 2 → 3 → 4 → 5 → 6 → 7 → 8 → 9
1 → 9 → 2 → 3 → 4 → 5 → 6 → 7 → 8
1 → 9 → 2 → 8 → 3 → 4 → 5 → 6 → 7
1 → 9 → 2 → 8 → 3 → 7 → 4 → 5 → 6
1 → 9 → 2 → 8 → 3 → 7 → 4 → 6 → 5

use warnings;
use strict;
use feature ":5.26";

## ## ## ## ## MAIN:

my @input = @ARGV;

## convert the input commandline array into a linked list
## $node points to beginning of the list
my ($node, $next);
while (scalar @input > 0) {
    my $value =  pop @input;
    $node = new Node($value, $next);
    $next = $node;
}

print_list($node);

## the moved node is inserted after the splice point 
## $node is a working container
my ($start_node, $splicepoint);
$splicepoint = $start_node = $node;

while (defined $splicepoint->next) {

    ## when the splice point is second to last before the splice,
    ## last node is to be spliced into the same location
    ## we are done so jump out
    ## This happens only when the node count is even.
    last if not defined $splicepoint->next->next;  

    ## temporarily go to the 2nd to last node
    while (defined $node->next->next) {
        $node = $node->next;
    }

    ## relink the last node:
    ##   set the last node next to the node after the splice point
    ##   update the splice point next to the last node
    ##   update the working node next to undef,
    ##     as it is now the last node
    $node->next->next($splicepoint->next);
    $splicepoint->next($node->next);
    $node->end;
    
    ## jump ahead 2 nodes and go again
    $node = $splicepoint = $splicepoint->next->next;

    print_list($start_node);
}

## ## ## ## ## SUBS:

sub print_list {
## given a linked list starting node, follows that list until the end,
## transferring the values to an array.
## the array is then printed
    my $node = shift;
    my @output;
    while (defined $node) {
        push @output, $node->value;
        $node = $node->next;
    }
    say join ' → ' , @output;
}

## ## ## ## ## PACKAGES:

package Node;

sub new {
    my ($class, $value, $next)  = @_;
    my $self     = { "value"    => $value,
                     "next"     => $next    };
    bless $self, $class;    
    return $self;    
}

sub value {
## removed ability to reset value for challenge
    return $_[0]->{value}
}

sub next {
    my ($self, $next ) = @_;
    $self->{next} = $next if defined $next;
    return $self->{next}
}

sub end {
    $_[0]->{next} = undef;
}