Perl Weekly Challenge - Week 49

So this weeks challenges are a bit of maths and a bit of computer science which is nice.

Challenge 1

Find the first multiple of a given number that is written using just 1's and 0's. This is one of these times where Raku's infinite lazy sequences just fit with the request.

First we make a sequence of the multiples of x :

($x,*+$x...*)

Then we get the first item in the list that fulfils our requirements :

($x,*+$x...*).first( { $_ ~~ m!^ <[10]>+ $! } )

(I started using ! as a regex delimiter years ago in Perl and carried on in Raku. It's really helpful when you're dealing with file paths and URL's as you don't need to escape the values.)

Finally we can wrap this in a MAIN sub, it's not needed but it's nice and can add some documentation which is always nice.

#| Find the first multiple of x made of only 1's and 0's
sub MAIN(
    UInt $x #= Number to look for multiple of
) {
    ( $x, * + $x...* ).hyper.first( { $_ ~~ m!^ <[10]>+ $! } ).say;
}

And there we go. Though... I would not advise running it for a multiple of 9. This is because if you add up all the digits in a multiple of 9 and keep doing so until you have 1 digit left you always get 9.

This would imply that the first multiple of 9 that has only 1's and 0's in it is 111111111 (which is 9 * 12345679). Working that out does take this code a while. another option is to use a lazy gather / take block like so :

my @seq = lazy gather {
    my $current = $x;
    loop {
        take $current;
        $current += $x;
    }
};

@seq.first( { $_ ~~ m!^ <[10]>+ $! } ).say;

This uses less memory but I still get bored waiting for it for calculate the first value for 9.

...

So writing this I had a brain spasm and realised I was approaching the problem in the wrong direction. Why not calculate the numbers made of 1's and 0's which can be easily done using binary and Raku's duck typing. This gives us the new code :

#| Find the first multiple of x made of only 1's and 0's
sub MAIN(
    UInt $x #= Number to look for multiple of
) {
    my @seq = lazy gather {
        my $current = 1;
        loop {
            take $current.base(2);
            $current++;
        }
    }

    @seq.first( * %% $x ).say;
}

This makes use of the fact that Int.base returns a Str but if you try and divide it then Raku auto casts it back to an Int in base 10. Job done and now you can get the value for 9 or 81 is super fast time. Awesome!

Challenge 2

So challenge 2 comes in two parts. Make an LRU Cache and demonstrate it's use. The "proper" Computer Science thing to do here would involve linked lists. But I generally find that trying to jam linked lists into high level languages (which under the hood use them) is generally more trouble than it's worth.

So I'm going with a simple idea, a hash and a list of keys. Each time I do something with the hash (getting or setting a value) I put key onto the list at the front :

[1,2,3] => [3,1,2,3]

reset it to the unique values :

[3,1,2]

then if it's too long pop the last value off the list.

Here's the class I made for that :

class Cache::LRU {

    has Int $!capacity where * > 0;
    has %!cache = {};
    has @!key-list = [];

    submethod BUILD ( :$capacity ) { $!capacity = $capacity }

    method !freshen ( $key ) {
        @!key-list.unshift($key).=unique;
        if @!key-list.elems > $!capacity {
            %!cache{@!key-list.pop}:delete;
        }
    }

    method current () {
        return @!key-list;
    }

    method get( $key ) {
        if %!cache{$key}:exists {
            self!freshen( $key );
            return %!cache{$key};
        }
        return Any;
    }

    method set( $key, $value ) {
        %!cache{$key} = $value;
        self!freshen( $key );
        return $value;
    }
}

Note that this code isn't thread safe. If you wanted to use it in the wild you probably want to pull in OO::Monitors to wrap the freshen, set and get methods. Also current only exists to demonstrate the cache.

Now to demonstrate it I decided to make a nice terminal interface like so :

#| Interactive LRU Cache example. Call with cache capacity
sub MAIN (
    Int $capacity where * > 0 #= Cache capacity (must be greater than zero)
) {
    my $cache = Cache::LRU.new( :$capacity );

    my $done = False;

    my multi sub action( "get", $key ) {
        say $cache.get($key) // "Not found";
    };
    my multi sub action( "set", $key, $value ) {
        $cache.set( $key, $value );
        say "Set $key to $value";
    };
    my multi sub action( "keys" ) {
        say "Current Keys : {$cache.current().join(",")}";
    };
    my multi sub action( "quit" ) {
        say "Bye";
        $done = True;
    };
    my multi sub action( *@ ) {
        say "I'm sorry Dave I don't know how to do that.";
        say "Valid options are :\n\tget \{key\}\n\tset \{key\} \{value\}\n\tkeys\n\tquit";
    };

    say "Welcome to the cache demo\nValid options are :\n\tget \{key\}\n\tset \{key\} \{value\}\n\tkeys\n\tquit";

    while ! $done {
        my @input = ( prompt "What would you like to do? " ).words;
        action( |@input );        
    }
}

So I setup a set of local multi dispatch sub's that have access to the Cache object and the loop flag then just loop round prompting for input.