PERL WEEKLY CHALLENGE – 068

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


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]

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

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

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
package LinkedList::Node; # Linked list
use Mouse;

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

has 'next' => (
	is  => 'rw',
	isa => 'Maybe[LinkedList::Node]',
	default => sub {
		return undef
	}
);

__PACKAGE__->meta->make_immutable();

package LinkedList;

use Mouse;
use feature qw /say/;
use LinkedList::Node;

has 'first'  => (
	is  => 'rw',
	isa => 'Maybe[LinkedList::Node]',
	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;

		# Traverse Linked list
		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;
use LinkedList;

my $ll = LinkedList->new();
$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
class LinkedList::Node {
	has Int $.value is rw;
	has LinkedList::Node $.next is rw;
}

class LinkedList {
	has LinkedList::Node $.first 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;

			# Traverse Linked list
			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() {
	my $ll = LinkedList.new();
	$ll.create-list(1,2,3,4);
	say 'Before: ' ~ $ll.display-list;
	$ll.reorder-list(3);
	say 'After: ' ~ $ll.display-list;
}

Output perl6 ch-2.p6

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

One thought on “PERL WEEKLY CHALLENGE – 068

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s