PERL WEEKLY CHALLENGE – 059

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


TASK #1 › Linked List

Reviewed by Ryan Thompson


You are given a linked list and a value k. Write a script to partition the linked list such that all nodes less than k come before nodes greater than or equal to k. Make sure you preserve the original relative order of the nodes in each of the two partitions.

For example:

Linked List: 1 → 4 → 3 → 2 → 5 → 2

k = 3

Expected Output: 1 → 2 → 2 → 4 → 3 → 5.


For this challenge I just created a linked list using, Perl’s Mouse OO framework and Raku’s built-in Class Object.

No real magic in creating the linked list. The magic happens in the class method partion_list, that basically reorders the list travesing though the nodes and moving the node if two conditions are met:

– the value is lower than k
– we’ve passed k in the traversal process

This algorithm also takes into account multiple instances with nodes of value k and just groups them

Edit: I made a mistake understanding the problem, thinking that the linked list should be ordered. I’ve changed the algorithm since my first post.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-1.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 partition_list {
	my ($self, $k) = @_;

	# Loop through the nodes
	my $node = $self->first;
	my $passed_k = 0;
	my $prev_node;
	my $k_node;

	while ($node) {
		my $next_node = $node->next;
		my $moved_node = 0;

		if ($node->value < $k && $passed_k) {
			my $traverse_node = $self->first;
			while ($traverse_node->next->value < $node->value) {
				$traverse_node = $traverse_node->next;
			}
			$prev_node->next($node->next);
			$node->next($traverse_node->next);
			$traverse_node->next($node);
			$moved_node = 1;
		}

		# Other k's
		if ($node->value == $k && $passed_k) {
			my $temp = $k_node->next;
			$prev_node->next($node->next);
			$k_node->next($node);
			$node->next($temp);
			$moved_node = 1;
		};

		# First k encountered
		if ($node->value == $k && !$passed_k) {
			$passed_k = 1;
			$k_node = $node;
		};

		# The prev node pointer only changes if we
		# didn't move the node
		$prev_node = $node unless ($moved_node);

		# Next node
		$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 strict;
use warnings;
use LinkedList;

my $ll = LinkedList->new();
$ll->create_list(1,4,3,2,5,2);
say 'Before: ' . $ll->display_list;
$ll->partition_list(3);
say 'After: ' . $ll->display_list;

say "\nDuplicate k's";
$ll->create_list(1,4,3,2,5,2,3);
say 'Before: ' . $ll->display_list;
$ll->partition_list(3);
say 'After: ' . $ll->display_list;

Output

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

Duplicate k's
Before: 1 → 4 → 3 → 2 → 5 → 2 → 3

Raku solution

# Test: perl6 ch-1.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 partition-list(Int $k) {
		# Loop through the nodes
		my $node = self.first;
		my $passed_k = False;
		my $prev_node;
		my $k_node;

		while ($node) {
			my $next_node = $node.next;
			my $moved_node = False;

			if ($node.value < $k && $passed_k) {
				my $traverse_node = self.first;
				while ($traverse_node.next.value < $node.value) {
					$traverse_node = $traverse_node.next;
				}
				$prev_node.next = $node.next;
				$node.next = $traverse_node.next;
				$traverse_node.next = $node;
				$moved_node = True;
			}

			# Other k's
			if ($node.value == $k && $passed_k) {
				my $temp = $k_node.next;
				$prev_node.next = $node.next;
				$k_node.next = $node;
				$node.next = $temp;
				$moved_node = True;
			};

			# First k encountered
			if ($node.value == $k && !$passed_k) {
				$passed_k = 1;
				$k_node = $node;
			};

			# The prev node pointer only changes if we
			# didn't move the node
			$prev_node = $node unless ($moved_node);

			# 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,4,3,2,5,2);
	say 'Before: ' ~ $ll.display-list;
	$ll.partition-list(3);
	say 'After: ' ~ $ll.display-list;

	say "\nDuplicate k's";
	$ll.create-list(1,4,3,2,5,2,3);
	say 'Before: ' ~ $ll.display-list;
	$ll.partition-list(3);
	say 'After: ' ~ $ll.display-list;
}

Output

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

Duplicate k's
Before: 1 → 4 → 3 → 2 → 5 → 2 → 3
After: 1 → 2 → 2 → 4 → 3 → 3 → 5

TASK #2 › Bit Sum

Reviewed by Ryan Thompson


Helper Function

For this task, you will most likely need a function f(a,b) which returns the count of different bits of binary representation of a and b.

For example, f(1,3) = 1, since:

Binary representation of 1 = 01

Binary representation of 3 = 11

There is only 1 different bit. Therefore the subroutine should return 1. Note that if one number is longer than the other in binary, the most significant bits of the smaller number are padded (i.e., they are assumed to be zeroes).

Script Output

You script should accept n positive numbers. Your script should sum the result of f(a,b) for every pair of numbers given:

For example, given 2, 3, 4, the output would be 6, since f(2,3) + f(2,4) + f(3,4) = 1 + 2 + 3 = 6


This challenge wasn’t too complicated. I calculated the bit difference with the XOR bitwise operator and counted the number of true bits.

I didn’t bother with validation. So don’t pass empty ARGV’s 🙂

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-2.pl 2 3 4

use strict;
use warnings;
use feature qw /say/;
use Algorithm::Combinatorics qw /combinations/;

my $answer = 0;

my $combinations = combinations(\@ARGV, 2);
while (my $v = $combinations->next) {
	$answer += f(@$v);
}

say $answer;

sub f {
	return calculate_true_bits(int(shift) ^ int(shift));
}

# Calculate the number of true bits
sub calculate_true_bits {
	my $number = shift;
	my $count = 0;

	do {
		$count++ if ($number & 1);
	} while ($number = $number >> 1);

	return $count;
}

Output of ./ch-2.pl 2 3 4

6

Raku solution

# Test: perl6 ch-2.p6 2 3 4
sub MAIN(*@ARGV) {
	my @combos = @ARGV.combinations: 2;
	my $answer = 0;

	for @combos -> $combo {
		$answer += f($combo[0], $combo[1]);
	}

	say $answer;
}

sub f(Int $a, Int $b) {
	return calculate-true-bits($a +^ $b);
}

# Calculate the number of true bits
sub calculate-true-bits(Int $n is copy) {
	my $count = 0;

	repeat {
		$count++ if ($n +& 1);
	} while ($n = $n +> 1);

	return $count;
}

Output of perl6 ch-2.p6 2 3 4

6

3 thoughts on “PERL WEEKLY CHALLENGE – 059

  1. The output for #1 is wrong. The code produces 1 → 2 → 2 → 3 → 4 → 5 which is not correct. Should be 1 → 2 → 2 → 4 → 3 → 5.

    Liked by 1 person

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