laurent_r

These are some answers to the Week 49 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days (March 1, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

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.

An attempt to mathematically analyze the problem might start as follows. The multiple has to end with 0 or 1. So, if our given number ends with 5 (as in the case of the 55 example above), the multiplicator has to end with 0, 2, 4, 6, or 8. That may not look very interesting, but looking at other final digits is sometimes interesting. First, 0 will always produce 0 as a final digit, but this is a trivial solution that will never be the smallest one: for example if a given number multiplied by 1350 is composed only of 0 and 1, then the same number multiplied by 135 will also be composed of 0 and 1, and will be a better (smaller) solution. Given the final digit of the input number, the multiplicator has to end with the following digits:

0 -> any digit
1 -> 1
2 -> 5
3 -> 7
4 -> 5 
5 -> any even digit
6 -> 5
7 -> 3
8 -> 5
9 -> 9

But from there, it seems quite difficult to analyze further. I don’t have time right now to do that, and will therefore use a brute force approach.

Smallest Multiple in Perl

We just try every possible muliplicator and check whether the result of the multiplication is composed of digits 0 and 1:

use strict;
use warnings;
use feature "say";

my $num = shift;
my $i = 1;
while (1) {
    my $result = $num * $i;
    if ($result =~ /^[01]*$/) {
        say "$num * $i = $result";
        last;
    }
    $i++;
}

Running the program with some numbers seems to quickly yield proper results:

$ perl multiples.pl 651
651 * 15361 = 10000011

$ perl multiples.pl 743
743 * 13607 = 10110001

$ perl multiples.pl 812
812 * 1355925 = 1101011100

But for some input numbers, it starts to take quite a bit of time, for example about 15 seconds for 1243:

$ time perl multiples.pl 1243
1243 * 80539107 = 100110110001

real    0m15,412s
user    0m15,405s
sys     0m0,000s

For some numbers, the program seems to hang indefinitely, but I have no idea how to figure out whether it is because the solution is just extremely large, or because there is simply no solution.

For example, with input number 12437, the program ran for more than 13 minutes before I got tired and killed it.

$ time perl multiples.pl 12437


real    13m46,762s
user    13m46,296s
sys     0m0,077s

I don’t know whether it would have found the solution just a few seconds or some minutes later, or whether finding the solution would require ages, or even whether there is no solution.

Obviously, our above program would need an upper limit above which we stop looking for a multiple, but I frankly don’t know how large that limit should be. Just pick the one you prefer.

Smallest Multiple in Raku

We’ll also use the brute force approach in Raku, but with a slightly different approach: we first build a lazy infinite list of multiples of the input number, and then look for the first one that contains only digits 0 and 1:

use v6;

my $num = @*ARGS[0] // 743;
my @multiples = map { $num * $_ }, 1..*;
say @multiples.first: /^<[01]>+$/; # default 743: -> 10110001

This produces the following output:

$ ./perl6 multiples.p6
10110001

$ ./perl6 multiples.p6 421
100110011

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

A LRU cache discards first the least recent used data item. A LRU algorithm usually requires two data structures: one to keep the data elements and one to keep track of their age, although the two types of information may also be packed into a single data structure. In Perl or in Raku, the most obvious candidates would be to use a hash to store the data elements and an array to keep track of their relative ages. But you could also use an ordered hash (see for example the Perl Hash::Ordered module on the CPAN or the Raku Array::Hash module) to record both types of information in a single data structure.

LRU Cache in Perl: Objects in Functional Programming

Wanting to implement one or several data structure along with some specific built-in behavior clearly appears to be an ideal case for object-oriented programming. I would bet that many of the challengers will take this path, which is a sufficient reason for me to take another route: I’ll implement my LRU cache object using functional programming. There is, however, another reason: to me, this is much more fun. In the program below, the create_lru subroutine acts as a function factory and an object constructor. It keeps track of the three LRU object attributes ($capacity, %cache, and @order) and returns two code references that can be considered to be the LRU object public methods. The $setter and $getter anonymous subroutines are closures and close over the three object attributes.

use strict;
use warnings;
use feature "say";
use Data::Dumper;

sub create_lru {
    my $capacity = shift;
    my (%cache, @order);
    sub display { say "Order: @{$_[0]} \n", "Cache: ", Dumper $_[1];}
    my $setter = sub {
        my ($key, $val) = @_;
        $cache{$key} = $val;
        push @order, $key;
        if (@order > $capacity) {
            my $invalid = shift @order;
            delete $cache{$invalid};
        }
        display \@order, \%cache;
    };
    my $getter = sub {
        my $key = shift;
        return -1 unless exists $cache{$key};
        @order = grep { $_ != $key } @order;
        push @order, $key;
        display \@order, \%cache;
        return $cache{$key}
    };
    return $setter, $getter;
}

my ($set, $get) = create_lru(3);
$set->(1, 3);
$set->(2, 5);
$set->(3, 7);
say "should print  5: ", $get->(2);
say "should print  3: ", $get->(1);
say "should print -1: ", $get->(4);
$set->(4, 9);
say "should print -1: ", $get->(3);

Note that the display subroutine isn’t necessary, it is used just to show that various data structures evolve in accordance with the task requirements. Also note that, although this wasn’t needed here, it would be perfectly possible to create several distinct LRU objects with this technique (provided you use different names or lexical scopes for the code references storing the values returned by the create_lru subroutine).

Running this program displays the following output:

$ perl lru.pl
Order: 1
Cache: $VAR1 = {
          '1' => 3
        };

Order: 1 2
Cache: $VAR1 = {
          '1' => 3,
          '2' => 5
        };

Order: 1 2 3
Cache: $VAR1 = {
          '3' => 7,
          '2' => 5,
          '1' => 3
        };

Order: 1 3 2
Cache: $VAR1 = {
          '3' => 7,
          '2' => 5,
          '1' => 3
        };

should print  5: 5
Order: 3 2 1
Cache: $VAR1 = {
          '3' => 7,
          '2' => 5,
          '1' => 3
        };

should print  3: 3
should print -1: -1
Order: 2 1 4
Cache: $VAR1 = {
          '4' => 9,
          '1' => 3,
          '2' => 5
        };

should print -1: -1

LRU Cache in Raku

We could use the same functional programming techniques as before in Raku, but, since the Raku OO system is so nice, I’ll create a LRU-cache class and instantiate an object of this class:

use v6;
class LRU-cache {
    has %!cache;
    has @!order;
    has UInt $.capacity;

    method set (Int $key, Int $val) {
        %!cache{$key} = $val;
        push @!order, $key;
        if (@!order > $.capacity) {
            my $invalid = shift @!order;
            %!cache{$invalid}:delete;
        }
        self.display;
    };  
    method get (Int $key) {
        return -1 unless %!cache{$key}:exists;
        @!order = grep { $_ != $key }, @!order;
        push @!order, $key;
        self.display;
        return %!cache{$key}
    };
    method display { .say for "Order: @!order[]", "Cache:\n{%!cache}" };
}

my $cache = LRU-cache.new(capacity => 3);
$cache.set(1, 3);
$cache.set(2, 5);
$cache.set(3, 7);
say "should print  5: ", $cache.get(2);
say "should print  3: ", $cache.get(1);
say "should print -1: ", $cache.get(4);
$cache.set(4, 9);
say "should print -1: ", $cache.get(3);

Running this program displays more or less the same input as before:

Order: 1
Cache:
1   3
Order: 1 2
Cache:
1   3
2   5
Order: 1 2 3
Cache:
1   3
2   5
3   7
Order: 1 3 2
Cache:
1   3
2   5
3   7
should print  5: 5
Order: 3 2 1
Cache:
1   3
2   5
3   7
should print  3: 3
should print -1: -1
Order: 2 1 4
Cache:
1   3
2   5
4   9
should print -1: -1

Wrapping up

The next week Perl Weekly Challenge is due to start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, March 9, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.