PERL WEEKLY CHALLENGE – 059

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

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
use Mouse;

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

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

__PACKAGE__->meta->make_immutable();

use Mouse;
use feature qw /say/;

has 'first'  => (
is  => 'rw',
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;

\$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
has Int \$.value 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() {
\$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``````

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 \$combinations = combinations(\@ARGV, 2);
while (my \$v = \$combinations->next) {
}

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;

for @combos -> \$combo {
}

}

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. Markus Holzer says:

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