rjt's Week 049 solutions and blogs

7 files changed, 357 insertions, 5 deletions

diff --git a/challenge-049/ryan-thompson/README.md b/challenge-049/ryan-thompson/README.md
index 9d5c2b26a1..aba0117346 100644
--- a/challenge-049/ryan-thompson/README.md
+++ b/challenge-049/ryan-thompson/README.md
@@ -1,18 +1,18 @@
 # Ryan Thompson
 
-## Week 048 Solutions
+## Week 049 Solutions
 
-### Task 1 › Survivor
+### Task 1 › Smallest Multiple 1s and 0s
 
  * [Perl](perl/ch-1.pl)
  * [Raku](raku/ch-1.p6)
 
-### Task 2 › Palindrome Dates
+### Task 2 › LRU Cache
 
  * [Perl](perl/ch-2.pl)
  * [Raku](raku/ch-2.p6)
 
 ## Blogs
 
- * [Task 1 › Survivor](http://www.ry.ca/2020/02/survivor-josepheus-problem/)
- * [Task 2 › Palindrome Dates](http://www.ry.ca/2020/02/palindrome-dates/)
+ * [Task 1 › Smallest Multiple](http://www.ry.ca/2020/03/smallest-multiple/)
+ * [Task 2 › LRU Cache](http://www.ry.ca/2020/03/lru-cache/)
diff --git a/challenge-049/ryan-thompson/blog.txt b/challenge-049/ryan-thompson/blog.txt
new file mode 100644
index 0000000000..9c59d46492
--- /dev/null
+++ b/challenge-049/ryan-thompson/blog.txt
@@ -0,0 +1 @@
+http://www.ry.ca/2020/03/smallest-multiple/
diff --git a/challenge-049/ryan-thompson/blog1.txt b/challenge-049/ryan-thompson/blog1.txt
new file mode 100644
index 0000000000..0801d4ecb5
--- /dev/null
+++ b/challenge-049/ryan-thompson/blog1.txt
@@ -0,0 +1 @@
+http://www.ry.ca/2020/03/lru-cache/
diff --git a/challenge-049/ryan-thompson/perl/ch-1.pl b/challenge-049/ryan-thompson/perl/ch-1.pl
new file mode 100644
index 0000000000..2c0857f7e6
--- /dev/null
+++ b/challenge-049/ryan-thompson/perl/ch-1.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/env perl
+#
+# ch-1.pl - Smallest base-10 multiple of $n using only 1 and 0
+#
+# Ryan Thompson <rjt@cpan.org>
+
+use warnings;
+use strict;
+
+# For... illustrative purposes only
+sub mult_brute {
+    local ($_) = @_;
+    $_ += $_[0] while /[^10]/;
+    $_;
+}
+
+# 1,478,988% faster than mult_brute
+sub mult_bfs {
+    my $n = shift;
+
+    my $cur;
+    for (my (@r) = $cur = 1; $cur % $n; $cur = shift @r) {
+        push @r, $cur . 0, $cur . 1;
+    }
+    $cur;
+}
+
+# 20-30% faster than mult_bfs
+sub mult_sprintf {
+    my $n = shift;
+
+    for (my $i = 1; ; $i++) {
+        my $cur = sprintf '%b', $i;
+        return $cur if 0 == $cur % $n;
+    }
+}
+
+for (1..100) {
+    my $mult = mult_bfs($_);
+    my $div  = $mult / $_;
+
+    printf "%3d x %16d = %18d\n", $_, $div, $mult;
+}
diff --git a/challenge-049/ryan-thompson/perl/ch-2.pl b/challenge-049/ryan-thompson/perl/ch-2.pl
new file mode 100644
index 0000000000..f84de9428f
--- /dev/null
+++ b/challenge-049/ryan-thompson/perl/ch-2.pl
@@ -0,0 +1,162 @@
+#!/usr/bin/env perl
+#
+# ch-2.pl - LRU Cache
+#
+# Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+no warnings 'uninitialized';
+
+package Local::LRU {
+    use Carp;
+
+    sub new {
+        my $class = shift;
+        bless {
+            capacity=> 10,
+            @_,
+
+            _length => 0,     # Current size
+
+            # Doubly-linked list
+            _cache  => { },
+            _head   => undef,
+            _tail   => undef,
+        }, $class;
+    }
+
+    # Sets or gets the maximum length (capacity) of the cache
+    sub capacity {
+        my ($s, $capacity) = @_;
+    
+        if ($capacity) {
+            $s->{capacity} = $capacity;
+            $s->_expire;
+        }
+
+        $s->{capacity};
+    }
+
+    # Return the current length
+    sub length { $_[0]->{_length} }
+
+    # Set item named $key to $val, and promote it to the head of the list
+    sub set {
+        my ($s, $key, $val) = @_;
+        $s->evict($key) if $s->exists($key);
+
+        my $elem = { key => $key, val => $val, next => $s->{_head} };
+        $s->{_cache}{$key} = $elem;
+
+        $s->{_head} and $s->{_head}{prev} = $elem;
+        $s->{_tail} //= $elem;
+        $s->{_head} = $elem;
+        $s->{_length}++;
+        $s->_expire;
+
+        $val;
+    }
+
+    # Get an item named $key, or croak
+    sub get {
+        my ($s, $key) = @_;
+        croak "$key does not exist" unless $s->exists($key);
+        my $val = $s->{_cache}{$key}{val};
+        $s->set($key, $val);
+    }
+
+    # Return true if $key exists
+    sub exists {
+        my ($s, $key) = @_;
+        exists $s->{_cache}{$key};
+    }
+
+    # Evict a specific $key from the cache
+    sub evict {
+        my ($s, $key) = @_;
+        croak "$key does not exist" unless $s->exists($key);
+        my $elem = $s->{_cache}{$key};
+
+        # Re-link next/prev elements in DLL
+        $elem->{next} and $elem->{next}{prev} = $elem->{prev};
+        $elem->{prev} and $elem->{prev}{next} = $elem->{next};
+        delete $s->{_cache}{$key};
+        $s->{_tail} = $elem->{prev} if $s->{_tail} == $elem;
+        $s->{_head} = $elem->{next} if $s->{_head} == $elem;
+
+       --$s->{_length};
+    }
+
+    # Returns a list of keys in queue order
+    sub keys {
+        my ($s) = @_;
+
+        my @r;
+        for ( my $cur = $s->{_head}; $cur; $cur = $cur->{next} ) {
+            push @r, $cur->{key};
+        }
+        @r;
+    }
+
+    # Expire elements off the tail until we are at or below target length
+    sub _expire {
+        my ($s) = @_;
+        $s->evict($s->{_tail}{key}) while $s->length > $s->capacity;
+    }
+
+}
+
+#
+# Test code
+#
+use Test::More;
+use Test::Exception;
+
+my $lru;
+lives_ok { $lru = Local::LRU->new(capacity => 3) };
+is $lru->capacity, 3;
+
+sub keys_str() { "[" . join(" ", $lru->keys) . "]" }
+
+is $lru->length, 0;
+is $lru->set(1,3), 3;
+is $lru->set(2,5), 5;
+is $lru->set(3,7), 7;
+is $lru->length, 3;
+is keys_str, '[3 2 1]';
+
+is $lru->get(2), 5;
+is keys_str, '[2 3 1]';
+
+is $lru->get(1), 3;
+is keys_str, '[1 2 3]';
+
+dies_ok { $lru->get(4) };
+is keys_str, '[1 2 3]';
+
+is $lru->set(4,9), 9;
+is $lru->length, 3;
+is keys_str, '[4 1 2]';
+
+dies_ok { $lru->get(3) };
+
+# Test variable capacity
+
+is $lru->capacity(5), 5;
+is $lru->length, 3;
+is keys_str, '[4 1 2]';
+is $lru->set(5, 11), 11;
+is keys_str, '[5 4 1 2]';
+is $lru->set(6, 13), 13;
+is keys_str, '[6 5 4 1 2]';
+is $lru->set(7, 15), 15;
+is keys_str, '[7 6 5 4 1]';
+is $lru->length, 5;
+
+is $lru->capacity(3), 3;
+is $lru->length, 3;
+is keys_str, '[7 6 5]';
+
+done_testing;
diff --git a/challenge-049/ryan-thompson/raku/ch-1.p6 b/challenge-049/ryan-thompson/raku/ch-1.p6
new file mode 100644
index 0000000000..9067071ee6
--- /dev/null
+++ b/challenge-049/ryan-thompson/raku/ch-1.p6
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl6
+#
+# ch-1.p6 - Smallest base-10 multiple of $n using only 1 and 0
+#
+# Ryan Thompson <rjt@cpan.org>
+
+sub mult_bfs( Int \N ) {
+    my $cur;
+    loop (my (@r) = $cur = 1; $cur % N; $cur = @r.shift) {
+        @r.push($cur ~ 0, $cur ~ 1)
+    }
+    $cur;
+}
+
+sub mult_fmt( Int \N ) { (1..∞).map( *.base(2) ).first( * %% N ) }
+
+say mult_fmt($_) for 1..100;
diff --git a/challenge-049/ryan-thompson/raku/ch-2.p6 b/challenge-049/ryan-thompson/raku/ch-2.p6
new file mode 100644
index 0000000000..59ef558ae2
--- /dev/null
+++ b/challenge-049/ryan-thompson/raku/ch-2.p6
@@ -0,0 +1,128 @@
+#!/usr/bin/env perl6
+
+# ch-2.p6 - LRU Cache
+#
+# Ryan Thompson <rjt@cpan.org>
+
+class LRU {
+    has UInt $.capacity is required is rw;
+    has      %!cache;
+    has      $!head;
+    has      $!tail;
+    has UInt $!length = 0;
+
+    method length() { $!length }
+
+    #| Set item named $key to $val and promote it to head of the list
+    method set( $key, $val ) {
+        $.evict($key) if $.exists($key);
+        
+        my $elem = { key => $key, val => $val, next => $!head };
+        %!cache{$key} = $elem;
+        $!head and $!head<prev> = $elem;
+        $!tail //= $elem;
+        $!head = $elem;
+        $!length++;
+        self!expire;
+
+        $val;
+    }
+
+    #| Get an item named $key, and promote it.
+    method get( $key ) {
+        die "$key does not exist" unless $.exists($key);
+        my $val = %!cache{$key}<val>;
+
+        $.set($key, $val);
+    }
+
+    #| Return true if $key exists
+    method exists( $key ) {
+        %!cache{$key}:exists;
+    }
+
+    #| Evict a specific $key from the cache
+    method evict( $key ) {
+        die "$key does not exist" unless $.exists($key);
+        my $elem = %!cache{$key};
+
+        # Re-link next/prev elements in DLL
+        $elem<next> and $elem<next><prev> = $elem<prev>;
+        $elem<prev> and $elem<prev><next> = $elem<next>;
+        %!cache{$key}:delete;
+        $!tail = $elem<prev> if $!tail<key> eq $elem<key>;
+        $!head = $elem<next> if $!head<key> eq $elem<key>;
+
+        --$!length;
+    }
+
+    #| Returns a list of keys in queue order
+    method keys() {
+        my @r;
+        loop ( my $cur = $!head; $cur; $cur = $cur<next> ) {
+            @r.push: $cur<key>;
+        }
+
+        @r;
+    }
+
+    #| Expire elements off the tail until we are at or below target length
+    method !expire() {
+        my $len = $.length;
+        $.evict( $!tail<key> ) while $.length > $.capacity;
+    }
+
+
+}
+
+use Test;
+
+my LRU $lru;
+lives-ok { $lru = LRU.new( :capacity<3> ) };
+
+sub keys_str() { "[" ~ $lru.keys.join(' ') ~ "]" }
+
+is $lru.capacity, 3;
+
+
+is $lru.length, 0;
+is $lru.set(1,3), 3;
+is $lru.set(2,5), 5;
+is $lru.set(3,7), 7;
+is $lru.length, 3;
+is keys_str, '[3 2 1]';
+
+is $lru.get(2), 5;
+is keys_str, '[2 3 1]';
+
+is $lru.get(1), 3;
+is keys_str, '[1 2 3]';
+
+dies-ok { $lru.get(4) };
+is keys_str, '[1 2 3]';
+
+is $lru.set(4,9), 9;
+is $lru.length, 3;
+is keys_str, '[4 1 2]';
+
+dies-ok { $lru.get(3) };
+
+# Test variable capacity
+
+$lru.capacity = 5;
+is $lru.length, 3;
+is keys_str, '[4 1 2]';
+is $lru.set(5, 11), 11;
+is keys_str, '[5 4 1 2]';
+is $lru.set(6, 13), 13;
+is keys_str, '[6 5 4 1 2]';
+is $lru.set(7, 15), 15;
+is keys_str, '[7 6 5 4 1]';
+is $lru.length, 5;
+
+$lru.capacity = 3;
+is $lru.length, 5;
+is $lru.set(7, 15), 15;
+is keys_str, '[7 6 5]';
+
+done-testing;