PERL WEEKLY CHALLENGE – 049

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


Task 1

Smallest Multiple

Write a script to accept a positive number as command line argument and print the smallest multiple of the given number consists of digits 0 and 1.

For example:

For given number 55, the smallest multiple is 110 consisting of digits 0 and 1.


I didn’t want to try anything clever so I brute forced this problem. Basically checking each multiple with a regex.

I noticed that the regex checker in Raku is much slower than it is in Perl. You can see this by checking for the min multiple of 9.

Perl 5 solution

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

my $number = join '', @ARGV;

unless ($number =~ /^\d*$/) {
	say "Argument: $number needs to be a number";
	exit;
}

my $i = 1;
my $new_number = $number;
while (!($new_number =~ /^[01]+$/)) {
	$new_number = $number * $i++;
}

say "Smallest multiple of $number is $new_number";

Output

Smallest multiple of 55 is 110

Raku solution

# Test: perl6 ch-1.p6 55

sub MAIN(Int $number) {
	my $i = 1;

	my $new_number = $number;
	while (!($new_number ~~ /^^<[01]>+$$/)) {
		$new_number = $number * $i++;
	}

	say "Smallest multiple of $number is $new_number";

}

Output

Smallest multiple of 55 is 110

Task 2

LRU Cache

Write a script to demonstrate LRU Cache feature. It should support operations get and set. Accept the capacity of the LRU Cache as command line argument.

Definition of LRU: An access to an item is defined as a get or a set operation of the item. “Least recently used” item is the one with the oldest access time.

For example:

capacity = 3
set(1, 3)
set(2, 5)
set(3, 7)

Cache at this point:
[Least recently used] 1,2,3 [most recently used]

get(2)      # returns 5

Cache looks like now:
[Least recently used] 1,3,2 [most recently used]

get(1)      # returns 3

Cache looks like now:
[Least recently used] 3,2,1 [most recently used]

get(4)      # returns -1

Cache unchanged:
[Least recently used] 3,2,1 [most recently used]

set(4, 9)

Cache is full, so pushes out key = 3:
[Least recently used] 2,1,4 [most recently used]

get(3)      # returns -1

I found this amazing post talking about LRU Cache.


This one was a bit tricky, For perl 5 I used the object oriented framework https://metacpan.org/pod/Mouse to keep my sanity. I implemented the Linked List Node and the LRU Cache using Mouse.

The Node for the linked list stores a key, value and a reference to the next and previous node.

The LRU Cache stores a reference to the first and last node, has a has that references the node and has a max_capacity and capacity attributes.

The tricky part of this project was to make sure the references ended up in the correct place when we got a cache hit.

Raku has some nice Native Object oriented features so I used them.

Edit: Forgot the max_capacity as a command line argument so I just added it.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-2 3
package LL::Node; # Linked list

use Mouse;

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

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

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

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


__PACKAGE__->meta->make_immutable();

package Cache::LRU; # LRU Cache

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

has 'max_capacity' => (
	is  => 'rw',
	isa => 'Int',
	default => sub {
		return 3;
	}
);

has 'capacity' => (
	is  => 'rw',
	isa => 'Int',
	default => sub {
		return 0;
	}
);

has 'positions' => (
	is  => 'rw',
	isa => 'HashRef',
	default => sub {
		return {}
	}
);

has 'last'  => (
	is  => 'rw',
	isa => 'Ref',
);


has 'first'  => (
	is  => 'rw',
	isa => 'Ref',
);



sub set {
	my ($self, $key, $value) = @_;

	# New node
	my $new_node = LL::Node->new(
		key => $key, value => $value
	);

	# Push out 1 if at capacity
	if ($self->capacity >= $self->max_capacity) {
		my $node_to_kill = $self->first;
		$self->first($self->first->next);
		delete $self->positions->{$node_to_kill->key};
		$self->capacity($self->capacity - 1);
	}

	# Set the first and last reference to the new node
	if ( $self->first ) {
		$self->last->next($new_node);
		$new_node->prev($self->last);
	} else {
		$self->first($new_node);
	}

	# Last node
	$self->last($new_node);

	# Store the position
	$self->positions->{$key} = $new_node;

	# Increment capacity
	$self->capacity($self->capacity + 1);

	say "Setting: ($key, $value)" . $self->show_nodes;
}


sub get {
	my ($self, $key) = @_;

	my $node = $self->positions->{$key};

	# Cache miss
	unless ($node) {
		say "Getting: ($key) - cache miss" .
		    $self->show_nodes;

		# Return the cache miss -1
		return -1;
	}

	# This might be the first node
	if ($node->prev) {
		$node->prev->next($node->next)
	} else {
		$self->first($node->next);
	}

	# Change this node previous to last
	$node->prev($self->last);

	# Set the last's next to this node
	$self->last->next($node);

	# clear the node's next as it will be last
	$node->next(undef);

	# Set to LRU last pointer to this
	$self->last($node);

	# Get the value
	my $value = $node->value;

	say "Getting: ($key) Value: $value)" . $self->show_nodes;
	return $node->value;
}



sub show_nodes {
	my $self = shift;
	my @keys;

	my $node = $self->first;

	while ($node) {
		push @keys, $node->key;
		$node = $node->next;
	}

	return " [LRU] - " . (join ',', @keys) . " - [MRU]";
}


__PACKAGE__->meta->make_immutable();

package main;

use strict;
use warnings;
use Cache::LRU;

my $max_capacity = join '', @ARGV;
my $cache = Cache::LRU->new(max_capacity => $max_capacity || 3);

$cache->set(1, 3);
$cache->set(2, 5);
$cache->set(3, 7);
$cache->get(2);      # returns 5
$cache->get(1);      # returns 3
$cache->get(4);      # returns -1
$cache->set(4, 9);
$cache->get(3);      # returns -1

Output

Setting: (1, 3) [LRU] - 1 - [MRU]
Setting: (2, 5) [LRU] - 1,2 - [MRU]
Setting: (3, 7) [LRU] - 1,2,3 - [MRU]
Getting: (2) Value: 5) [LRU] - 1,3,2 - [MRU]
Getting: (1) Value: 3) [LRU] - 3,2,1 - [MRU]
Getting: (4) - cache miss [LRU] - 3,2,1 - [MRU]
Setting: (4, 9) [LRU] - 2,1,4 - [MRU]
Getting: (3) - cache miss [LRU] - 2,1,4 - [MRU]

Raku solution

# Test: perl6 ch-2.p6 3
use v6.d;

class Node {
	has Int $.key is rw;
	has Int $.value is rw;
	has Node $.next is rw;
	has Node $.prev is rw;
}

class LRU {
	has Node $.first is rw;
	has Node $.last is rw;
	has %.positions is rw;
	has Int $.max_capacity is rw;
	has Int $.capacity is rw = 0;

	method set(Int $key, Int $value) {
		my $new_node = Node.new(
			key   => $key,
			value => $value,
			next  => Nil,
			prev  => Nil
		);

		# Push out 1 if at capacity
		if (self.capacity >= self.max_capacity) {
			my $node-to-kill = self.first;
			self.first = self.first.next;
			self.positions.{$node-to-kill.key}:delete;
			self.capacity = self.capacity - 1;
		}

		# Set the first and last reference to the new node
		if ( self.first ) {
			self.last.next = $new_node;
			$new_node.prev = self.last;
		} else {
			self.first = $new_node;
		}

		# Last node
		self.last = $new_node;

		# Store the position
		self.positions.{$key} = $new_node;

		# Increment capacity
		self.capacity = self.capacity + 1;

		say "Setting: ($key, $value)" ~ self.show_nodes;
	}

	method get(Int $key) {
		my $node = self.positions.{$key};

		# Cache miss
		unless ($node) {
			say "Getting: ($key) - cache miss" ~
			    self.show_nodes;

			# Return the cache miss -1
			return -1;
		}

		# This might be the first node
		if ($node.prev) {
			$node.prev.next = $node.next;
		} else {
			self.first = $node.next;
		}

		# Change this node previous to last
		$node.prev = self.last;

		# Set the last's next to this node
		self.last.next = $node;

		# clear the node's next as it will be last
		$node.next = Nil;

		# Set to LRU last pointer to this
		self.last = $node;

		# Get the value
		my $value = $node.value;

		say "Getting: ($key) Value: $value)" ~
		     self.show_nodes;
		return $node.value;
	}

	method show_nodes() {
		my @keys;
		my $node = self.first;

		while ($node) {
			push @keys, $node.key;
			$node = $node.next;
		}

		return " [LRU] - " ~ @keys.join(',') ~ " - [MRU]";
	}
}

sub MAIN (Int $max_capacity) {
	my $cache = LRU.new( max_capacity => $max_capacity );
	$cache.set(1, 3);
	$cache.set(2, 5);
	$cache.set(3, 7);
	$cache.get(2);      # returns 5
	$cache.get(1);      # returns 3
	$cache.get(4);      # returns -1
	$cache.set(4, 9);
	$cache.get(3);      # returns -1
}

Output

Setting: (1, 3) [LRU] - 1 - [MRU]
Setting: (2, 5) [LRU] - 1,2 - [MRU]
Setting: (3, 7) [LRU] - 1,2,3 - [MRU]
Getting: (2) Value: 5) [LRU] - 1,3,2 - [MRU]
Getting: (1) Value: 3) [LRU] - 3,2,1 - [MRU]
Getting: (4) - cache miss [LRU] - 3,2,1 - [MRU]
Setting: (4, 9) [LRU] - 2,1,4 - [MRU]
Getting: (3) - cache miss [LRU] - 2,1,4 - [MRU]

2 thoughts on “PERL WEEKLY CHALLENGE – 049

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