PERL WEEKLY CHALLENGE – 056

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


TASK #1

Diff-K

You are given an array @N of positive integers (sorted) and another non negative integer k.

Write a script to find if there exists 2 indices i and j such that A[i] – A[j] = k and i != j.

It should print the pairs of indices, if any such pairs exist.

Example:

    @N = (2, 7, 9)
    $k = 2

Output : 2,1


I just brute forced this by looping through the array twice. So it has a computational complexity of O(n**2)

Nothing too complicated.

I’m sure there us some nifty Raku 1 liner, but I am honestly more keen on the next challenge.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-1.pl
use strict;
use warnings;
use feature qw /say/;

my @N = (2, 7, 9);
my $k = 2;

for (my $i = 0; $i < scalar(@N); $i++) {
	for (my $j = 0; $j < scalar(@N); $j++) {
		next if $i == $j;
		say "$i, $j" if ($N[$i] - $N[$j] == $k);
	}
}

Output

2, 1

Raku solution

# Test: perl6 ch-1.p6 
multi MAIN() {
	my @N = (2, 7, 9);
	my $k = 2;

	loop (my $i = 0; $i < @N.elems; $i++) {
		loop (my $j = 0; $j < @N.elems; $j++) {
			next if $i == $j;
			say "$i, $j" if (@N[$i] - @N[$j] == $k);
		}
	}
}

Output

2, 1

TASK #2



Path Sum


You are given a binary tree and a sum, write a script to find if the tree has a path such that adding up all the values along the path equals the given sum. Only complete paths (from root to leaf node) may be considered for a sum.

Example

Given the below binary tree and sum = 22,

          5
         / \
        4   8
       /   / \
      11  13  9
     /  \      \
    7    2      1

For the given binary tree, the partial path sum 5 → 8 → 9 = 22 is not valid.

The script should return the path 5 → 4 → 11 → 2 whose sum is 22.


For this challenge I used perl 5’s object oriented framework https://metacpan.org/pod/Mouse to create the nodes of the Binary Tree.

For Raku I used the Native Class Class

After constructing the Binary tree it was just a matter of traversing it. I used a recursive algorithm to check both the left and right branches.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-1.pl 4
package BTree::Node; # Binary Tree
use Mouse;

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

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

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

__PACKAGE__->meta->make_immutable();

package main;

use strict;
use warnings;
use feature qw /say/;

# Create the tree
my $root =
	BTree::Node->new(
		value => 5,
		left => BTree::Node->new(
				value => 4,
				left => BTree::Node->new(
					value => 11,
					left => BTree::Node->new(
						value => 7
					),
					right => BTree::Node->new(
						value => 2,
					)
				)
			),
		right => BTree::Node->new(
			value => 8,
			left => BTree::Node->new(
				value => 13
			),
			right => BTree::Node->new(
				value => 9,
				right => BTree::Node->new(
					value => 1,
				)
			)
		)
	);

my $k = 22;
path_sum($root, $k, 0, '');

sub path_sum {
	my ($node, $k, $total, $path_string) = @_;
	$total += $node->value;
	$path_string .= $node->value;

	# Branch left
	path_sum( $node->left,
	          $k,
	          $total,
	          $path_string . ' → ' )
	if ($node->left);

	# Branch right
	path_sum($node->right,
	         $k,
	         $total,
	         $path_string . ' → ' )
		if ($node->right);

	# Calculate total if we can't branch
	if ( !$node->left &&
	     !$node->right &&
	     $total == $k ) {
		say $path_string;
	}
}

Output

5 → 4 → 11 → 2

Raku solution

# Test: perl6 ch-2.p6 4
class BTree::Node {
	has Int $.value is rw;
	has BTree::Node $.left is rw;
	has BTree::Node $.right is rw;
}

sub MAIN() {
	my $root =
		BTree::Node.new(
			value => 5,
			left => BTree::Node.new(
					value => 4,
					left => BTree::Node.new(
						value => 11,
						left => BTree::Node.new(
							value => 7
						),
						right => BTree::Node.new(
							value => 2,
						)
					)
				),
			right => BTree::Node.new(
				value => 8,
				left => BTree::Node.new(
					value => 13
				),
				right => BTree::Node.new(
					value => 9,
					right => BTree::Node.new(
						value => 1,
					)
				)
			)
		);

	my $k = 22;
	path-sum($root, $k, 0, '');
}

sub path-sum(BTree::Node $node, Int $k, Int $total is copy, Str $path_string is copy) {
	$total += $node.value;
	$path_string ~= $node.value;

	# Branch left
	path-sum( $node.left,
	          $k,
	          $total,
	          $path_string ~ ' → ' )
	if ($node.left);

	# Branch right
	path-sum($node.right,
	         $k,
	         $total,
	         $path_string ~ ' → ' )
		if ($node.right);

	# Calculate total if we can't branch
	if ( !$node.left &&
	     !$node.right &&
	     $total == $k ) {
		say $path_string;
	}
}

Output

5 → 4 → 11 → 2

2 thoughts on “PERL WEEKLY CHALLENGE – 056

  1. I’m not a fan of c-style for loops.

    loop (my $i = 0; $i $i {}

    This can be shortened.

    for ^@n.elems -> $i {}

    And shortened.

    for ^@n -> $i {}

    Like

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