Zero Order with Raku & Perl

This is my response to the Perl Weekly Challenge #068.

Challenge #068.1: Zero Matrix

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]

Let us start with the «Math::Matrix» module, last used in my Vowelled Matrix with Raku article, and see how that turns out.

See github.com/lichtkind/Raku-Math-Matrix for more information about the Math::Matrix module.

But before doing so, we should have a look at the input format, which isn't really doable as presented in the challenge (unless we read the input from a file - but that is definately not user friendly in comparison to a command line argument). But Math::Matrix.new is helpful, as it want space separated values, without commas or brackets. A newline character is used to separate the rows.

So this line of code will give us the matrix given in the first example:

use Math::Matrix;
my $matrix = Math::Matrix.new("1 0 1 \n 1 1 1 \n 1 1 1");

Note that this will not work on a command line, as \n will be taken as a \ followed by an n. But that is easy to fix:

use Math::Matrix;
unit sub MAIN (Str $pattern); 
my $matrix = Math::Matrix.new($pattern.subst("\\n", "\n", :g));

Let us have a look at the actual program. The first part takes care of the input and validating it:

#! /usr/bin/env raku

use Math::Matrix;

unit sub MAIN (Str $original = "1 0 1 | 1 1 1 | 1 1 1",   # [1]
               :$v, :$verbose = $v);                      # [2]

my $str = $original.subst("\\n", "\n", :g)                # [3]
                   .subst("|",   "\n", :g)                # [4]
                   .trans("," => ' ')                     # [5]
                   .subst(/ \] \s* \[ /,  "\n", :g)       # [6]
                   .trans("[]" => '');                    # [7]

die "Illegal field value $str (only '0' and '1')"         # [8]
  unless all($str.words) eq any("0"|"1");

[1] The default matrix, on my minimalistic format where I use | instead of newlines. It is newlinified in [4].

[2] IF you find yourself tired of typing «--verbose» all the time, this is how the program can support aliases - and the short form «--v», in this case.

[3] Fix the newlines, if we got them from the command line.

[4] Fix my minimalistic format.

[5] The challende specified commas as value separators, so we allow them. The Matrix::new call doesn&apso;t want commas, so we replace them by spaces. (So that e.g. 1,2 is turned into 1 2 (and not 12.)

[6] A closing bracket followed by zero or more spaces and an opening bracket marks a new row in the matrix. Replace the substring with a newline.

[7] Remove any remaining opening or closing brackets.

[8] Two junctions in one go. here we check if all the values (all($str.words) have the (string) value of 0 or 1 (with any("0"|"1")).

Then we can make the matrix, and change the rows and columns.

Let us say that we iterate over all the positions from the «0,0», «0,1», «0,2», «1,0» and so on until «2,2». We then change the current row and column to all zeroes if the cell is zero. If we just do this on one martrix, cell «0,1» has been changed to zero, before we come to it. Then we find that it is zero, and that leads to the entire colum being changed to zero. Oops.

So we must do the checks and the updates on different matrices. (Or we could do the check first, making a list of positions as we find the zeroes, and do the changes afterwards.)

my $old = Math::Matrix.new($str);            # [9]

my $new = $old.clone;                        # [10]

my ($rows, $columns) = $old.size;            # [11]

for ^$rows -> $row                           # [12]
{
  for ^$columns -> $column                   # [13]
  {
    if $old.element($row, $column) == 0      # [14]
    {
      say ": Found 0 at [row:$row, col:$column]" if $verbose;
      $new.=multiply(row    => $row,    0);  # [15]
      $new.=multiply(column => $column, 0);  # [16]
    }
  }
}

[9] We did not check that all the rows had the same length, but the constructor takes care of that for us.

[10] The copy, which we are going to change.

[11] Get the dimensions of the matrix with this method.

[12] Iterate over the rows first,

[13] then the columns.

[14] If the cell (accessed with the «element» method) has the value zero,

[15] Multiply the values in the row with zero (which will set them to zero). Note that the «multiply» method does not change the matrix, but returns a modified version. So we assign the new matrix back with the .= syntax.

[16] Ditto for the columns.

say $new;       # [16]

[16] Not quite on the form specified in the challenge, but we can fix that later. First we should ensure that the program does what it is supposed to do. By running it:

$ ./zero-matrix-simple
  0  0  0
  1  0  1
  1  0  1

$ ./zero-matrix-simple "1 0 1 | 1 1 1 | 1 1 1"
  0  0  0
  1  0  1
  1  0  1

$ ./zero-matrix-simple "1 0 1 \n 1 1 1 \n 1 1 1"
  0  0  0
  1  0  1
  1  0  1

Let us check that it copes with rows with different length;

$ ./zero-matrix-simple "1 0 1 | 1"
All rows must contains the same number of elements
...

Good. (Except the typo: «contains» should be «contain».)

And that it copes with the input format given in the challenge (and some sloppy variations):

./zero-matrix-simple "[1, 0, 1] [1, 1, 1] [1, 1, 1]"
  0  0  0
  1  0  1
  1  0  1

$ ./zero-matrix-simple "[1,0,1][1,1,1][1,1,1]"
  0  0  0
  1  0  1
  1  0  1
$ ./zero-matrix-simple "[1  0  1] [1  1  1] [1  1  1]"
  0  0  0
  1  0  1
  1  0  1

$ ./zero-matrix-simple "1  0  1] [1  1  1] [1  1  1"
  0  0  0
  1  0  1
  1  0  1

$ ./zero-matrix-simple "1  0  1] [1  1  1] [1  1  1]]]]]]"
  0  0  0
  1  0  1
  1  0  1

Let us fix the output:

say "[{ @($_).join(", ") }]" for $new.list-columns;

Running it:

$ ./zero-matrix
[0, 1, 1]
[0, 0, 0]
[0, 1, 1]

And another Oops! We mixed up the rows and columns, turning the matrix 90 degrees counterclockwise.

I didn't really read the documentation, so a closer look revealed that I had chosen the wrong method, «list-columns» instead of «list-rows».

say "[{ @($_).join(", ") }]" for $new.list-rows;

Running it:

$ ./zero-matrix
[0, 0, 0]
[1, 0, 1]
[1, 0, 1]

A Perl Version

Perl's Math::Matrix module does not support looking up of single values, nor multiplying a row or column with a number (I used zero in the Raku program), so it is not usable for this challenge.

Perl's Math::GSL::Matrix supports looking up of single values, but not row or column multiplication. But we can set individual values as a work around. The initialisation of the matrix is really strange, as we set up an empty matrix with a given size. Then we can set each row.

Here it is, without further comments:

#! /usr/bin/env perl

use strict;
use Math::GSL::Matrix;
use List::Util;
use feature 'say';

my $input = shift(@ARGV) || die "Please specify a matrix";

my @matrix;

my $col_count;
my $row_count = 0;

for my $row (split(/\[/, $input))
{
  next unless $row;
  $row =~ tr/\]//d;
  $row = $1 if $row =~ /^\s*(.*?)\s*$/;
  my @values = split(/\s+/, $row);

  die "Only '0' and '1' please"
    unless List::Util::all { $_ eq "0" || $_ eq "1" } @values;

  $col_count = List::Util::max($col_count, scalar @values);

  push(@matrix, \@values);
  $row_count++;
}

my $old = Math::GSL::Matrix->new($row_count, $col_count);

$old->set_row($_, $matrix[$_]) for 0 .. $row_count -1;

my $new  = $old->copy;
my $rows = $old->rows();

my $columns = $old->cols();

for my $row (0 .. $rows -1)
{
  for my $column (0 .. $columns -1)
  {
    if ($old->get_elem($row, $column) == 0)
    {
      for my $a (0 .. $rows-1)
      {
        $new->set_elem($row, $a, 0);
      }
      
      for my $b (0 .. $columns-1)
      {
        $new->set_elem($b, $column, 0);
      }
    }
  }
}

for my $row (0 .. $rows -1)
{
  my @values = ();
  for my $column (0 .. $columns -1)
  {
    push(@values, $new->get_elem($row, $column));
  }
  say "[", join(", ", @values), "]";
}

Running it:

$ ./zero-matrix-perl "[0 1 1 ][ 1 1 1 ][ 1 1 1]" 
[0, 0, 0]
[0, 1, 1]
[0, 1, 1]

$ ./zero-matrix-perl "[0 1 1 ][ 1 1 1 ][ 1 1 0]" 
[0, 0, 0]
[0, 1, 0]
[0, 0, 0]

Perl, Second Try

You may have noticed that I didn't really use the functionality of a matrix for anything besides assuring that all the rows have the same length. We could do away with the matrix code, and add a manual row length check.

So let us do just that.

#! /usr/bin/env perl

use strict;
use List::Util;
use feature 'say';

my $input = shift(@ARGV) || die "Please specify a matrix";

my @old;
my @new;

my $cols;
my $rows = 0;

for my $row (split(/\[/, $input))
{
  next unless $row;
  $row =~ tr/\]//d;
  $row = $1 if $row =~ /^\s*(.*?)\s*$/;
  my @values = split(/\s+/, $row);

  die "Only '0' and '1' please"
    unless List::Util::all { $_ eq "0" || $_ eq "1" } @values;

  if (defined $cols)
  {
    die "Not the same number of elements in all the rows"
      unless $cols == @values;
  }
  else
  {
    $cols = @values;
  }

  my @copy = @values;    # As we use a reference in the «push».
  
  push(@old, \@values);
  push(@new, \@copy);
  $rows++;
}

for my $row (0 .. $rows -1)
{
  for my $col (0 .. $cols -1)
  {      
    if ($old[$row][$col] == 0)
    {
      for my $a (0 .. $rows-1)
      {
        $new[$row][$a] = 0;
      }
      
      for my $b (0 .. $cols-1)
      {
	$new[$b][$col] = 0;
      }
    }
  }
}

for my $row (0 .. $rows -1)
{
  my @values = ();
  for my $col (0 .. $cols -1)
  {
    push(@values, $new[$row][$col]);
  }
  say "[", join(", ", @values), "]";
}

It produces the same ouput as the matrix version.

But wait.. The last block (doing the output) with two nested loops is silly. We have a list of list, and can iterate over it. Replace the entire block with this single line:

say "[", join(", ", @{$_}), "]" for @new;

We can get rid of the dependency of «List::Util» (the any function) while we are at it:

  for (@values) { die "Only '0' and '1' please" unless $_ eq "0" || $_ eq "1"; }

It is possible to replace the loop with grep.

Challenge #068.2: Reorder List

L0 →  L1 →  … →  Ln-1 →  Ln

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

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

This is simply (famous last words?) a matter of:

1. Splitting the list in two
2. Reversing the second half
3. Merging the two lists

Merging two lists with one value from each list (called zip merge) is easy in Raku, as it has a zip function (and a corresponding Z operator) built in. The problem is that it stops when the first list is empty, so the final value will be lost:

> zip <1 2 3 4 5 6 7 8>, <a b c d e f g>
((1 a) (2 b) (3 c) (4 d) (5 e) (6 f) (7 g))

> <1 2 3 4 5 6 7 8> Z <a b c d e f g>
((1 a) (2 b) (3 c) (4 d) (5 e) (6 f) (7 g))

The easisest solution is to use roundrobin instead - as it goes on until both lists are empty:

> roundrobin <1 2 3 4 5 6 7 8>, <a b c d e f g>
((1 a) (2 b) (3 c) (4 d) (5 e) (6 f) (7 g) (8))

Note that we get a list of Pair objects, and not really a flat list. But that is not a problem in practice.

See docs.raku.org/routine/roundrobin for more information about the roundrobin function.

See docs.raku.org/routine/zip for more information about the zip function.

See docs.raku.org/routine/Z for more information about the Z operator.

#! /usr/bin/env raku

unit sub MAIN (*@list, :$verbose);

my $half = (@list.elems / 2 -1).ceiling;  # [1]

if $verbose
{
  say ": Halfway point: Index: $half, value: @list[$half]";
  say ": From the start: ", @list[0..$half];
  say ": From the end:   ", @list[$half +1 .. *].reverse;
}

say (roundrobin @list[0..$half], @list[$half +1 .. *].reverse)
      .flat.join(" -> ");                 # [2]

[1] The index of the walfway point, i.e. the last element in the first half. Note the use of ceiling to round up to the nearest integer so that the middle value in a list with odd length are placed in the first half.

[2] Merge the two parts of the original lists, with the second half reversed. The result is a list of Pair objects, so we flatten it out with flat.

See docs.raku.org/routine/ceiling for more information about ceiling.

See docs.raku.org/routine/flat for more information about flat.

Running it:

$ ./reorder-list 1 2 3 4
1 -> 4 -> 2 -> 3

$ ./reorder-list -v 1 2 3 4
: Halfway point: Index: 1, value: 2
: From the start: (1 2)
: From the end:   (4 3)
1 -> 4 -> 2 -> 3

$ ./reorder-list 1 2 3 4 5
1 -> 5 -> 2 -> 4 -> 3

$ ./reorder-list -v 1 2 3 4 5
: Halfway point: Index: 2, value: 3
: From the start: (1 2 3)
: From the end:   (5 4)
1 -> 5 -> 2 -> 4 -> 3

A Perl Version

The program:

#! /usr/bin/env perl

use strict;
use List::SomeUtils qw/zip/;
use POSIX;
use feature 'say';

die "Please specify a list of values" unless @ARGV;

my $last   = $#ARGV;
my $half   = ceil($last / 2 -1);
my @first  = @ARGV[0 .. $half];
my @second = reverse(@ARGV[$half+1 .. $last]);

say join(" -> ", grep { defined $_ } zip(@first, @second)); # [1]

[1] Remember the issue with differenth length of the arrays to merge in Raku, that made us end up with roundrobin instead of zip? The List::SomeUtil version goes on until all the lists are finished, but inserts «undef» where values are missing. I have fixed that with «grep»; selecting defined values only.

Running it:

$ ./reorder-list-perl 1 2 3 4 
1 -> 4 -> 2 -> 3

/reorder-list-perl 1 2 3 4 5
1 -> 5 -> 2 -> 4 -> 3

And that's it.