Merge pull request #1329 from choroba/ech049d

Add blog post by E. Choroba about 049: Smallest Multiple + LRU Cache

3 files changed, 72 insertions, 75 deletions

diff --git a/challenge-049/e-choroba/blog.txt b/challenge-049/e-choroba/blog.txt
new file mode 100644
index 0000000000..a61b98d57e
--- /dev/null
+++ b/challenge-049/e-choroba/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/e_choroba/2020/03/perl-weekly-challenge-048-smallest-multiple-and-lru-cache.html
diff --git a/challenge-049/e-choroba/perl/ch-2.pl b/challenge-049/e-choroba/perl/ch-2.pl
index 662171e746..4a1b323934 100755
--- a/challenge-049/e-choroba/perl/ch-2.pl
+++ b/challenge-049/e-choroba/perl/ch-2.pl
@@ -25,7 +25,7 @@ use feature qw{ say };
         return undef unless exists $self->[HASH]{$key};
 
         $self->_move_to_start($key);
-        return $self->_value($key)
+        return \$self->_value($key)
     }
 
     sub set {
@@ -37,7 +37,7 @@ use feature qw{ say };
     }
 
     sub inspect {
-        reverse @{ $_[0][ARRAY] }
+        [reverse @{ $_[0][ARRAY] }]
     }
 }
 
@@ -48,23 +48,23 @@ $c->set(1, 3);
 $c->set(2, 5);
 $c->set(3, 7);
 
-is_deeply [$c->inspect], [1, 2, 3];
+is_deeply $c->inspect, [1, 2, 3];
 
-is $c->get(2), 5, 'get 2';
+is ${ $c->get(2) }, 5, 'get 2';
 
-is_deeply [$c->inspect], [1, 3, 2];
+is_deeply $c->inspect, [1, 3, 2];
 
-is $c->get(1), 3, 'get 1';
+is ${ $c->get(1) }, 3, 'get 1';
 
-is_deeply [$c->inspect], [3, 2, 1];
+is_deeply $c->inspect, [3, 2, 1];
 
 is $c->get(4), undef, 'get 4';
 
-is_deeply [$c->inspect], [3, 2, 1];
+is_deeply $c->inspect, [3, 2, 1];
 
 $c->set(4, 9);
 
-is_deeply [$c->inspect], [2, 1, 4];
+is_deeply $c->inspect, [2, 1, 4];
 
 is $c->get(3), undef, 'get 3';
 
diff --git a/challenge-049/e-choroba/perl/ch-2b.pl b/challenge-049/e-choroba/perl/ch-2b.pl
index 6db8fbf4cb..2e6d2cc582 100755
--- a/challenge-049/e-choroba/perl/ch-2b.pl
+++ b/challenge-049/e-choroba/perl/ch-2b.pl
@@ -4,110 +4,106 @@ use strict;
 use feature qw{ say };
 
 {   package Linked::List;
-    use enum qw( PREV NEXT KEY VALUE );
+
+    use enum qw( KEY VALUE PREV NEXT );
 
     sub new {
-        my ($class, $args) = @_;
+        my ($class, $key, $value) = @_;
         my $self = [];
-
-        $self->[PREV] = $self->[NEXT] = $self;
-
-        $self->[KEY]   = $args->{key};
-        $self->[VALUE] = $args->{value};
-
+        @$self[KEY, VALUE, PREV, NEXT] = ($key, $value, $self, $self);
         bless $self, $class
     }
 
-    sub prepend {
+    sub extract {
+        my ($self) = @_;
+        my $prev = $self->[PREV];
+        my $next = $self->[NEXT];
+        $prev->[NEXT] = $next;
+        $next->[PREV] = $prev;
+        @$self[PREV, NEXT] = ($self, $self);
+    }
+
+    sub prepend_to {
         my ($self, $list) = @_;
-        $self->[NEXT][PREV] = $self->[PREV];
-        $self->[PREV][NEXT] = $self->[NEXT];
-        @$self[NEXT, PREV] = ($list, $list->[PREV]);
+        return unless $list;
+        $self->extract if $self->[PREV] != $self;
+        $self->[NEXT] = $list // $self;
+        $self->[PREV] = $list->[PREV] // $self;
         $list->[PREV][NEXT] = $self;
         $list->[PREV] = $self;
     }
 
-    sub remove_last {
-        my ($self) = @_;
-        my $last = $self->last;
-        $last->[PREV][NEXT] = $self;
-        $self->[PREV] = $last->[PREV];
-        undef $_ for @$last[PREV, NEXT], $last;
+    # Prevent memory leaks.
+    sub demolish {
+        $_[0][NEXT] = $_[0][PREV] = undef;
     }
 
-
+    sub key  { $_[0][KEY] }
+    sub prev { $_[0][PREV] }
     sub next { $_[0][NEXT] }
-    sub last { $_[0][PREV] }
-    sub key { $_[0][KEY] }
-    sub value { $_[0][VALUE] }
+    sub value :lvalue { $_[0][VALUE] }
 }
 
 {   package Cache::LRU;
-    use enum qw( CAPACITY HASH HEAD );
+
+    use enum qw( CAPACITY HASH FIRST );
 
     sub new {
         my ($class, $capacity) = @_;
-        bless [$capacity, {}, undef], $class
-    }
-
-    sub capacity { $_[0][CAPACITY] }
-
-    sub value { $_[0][HASH]{$_[1]}->value }
-
-    sub head { $_[0][HASH]{ $_[0][HEAD] } }
-
-    sub move_to_start {
-        my ($self, $key) = @_;
-
-        $self->[HEAD] = $key
-            unless defined $self->[HEAD];
-
-        my $head = $self->head;
-        my $moving = $self->[HASH]{$key};
-        return if $head == $moving;
-
-        $moving->prepend($head);
-        $self->[HEAD] = $key;
+        my $self = [];
+        @$self[CAPACITY, HASH, FIRST]
+            = ($capacity, {}, undef);
+        bless $self, $class
     }
 
     sub get {
         my ($self, $key) = @_;
-        return undef unless exists $self->[HASH]{$key};
+        return unless exists $self->[HASH]{$key};
 
-        $self->move_to_start($key);
-        return $self->value($key)
+        my $element = $self->[HASH]{$key};
+        if ($element != ($self->[FIRST] // -1)) {
+            $element->extract;
+            $element->prepend_to($self->[FIRST]);
+            $self->[FIRST] = $element;
+        }
+        return \$element->value
     }
 
     sub set {
         my ($self, $key, $value) = @_;
-        $self->[HASH]{$key}
-            //= 'Linked::List'->new({key => $key, value => $value});
-
-        $self->move_to_start($key);
 
-        if (keys %{ $self->[HASH] } > $self->capacity) {
-            my $last = $self->head->last;
-            my $last_key = $last->key;
-            $self->head->remove_last;
-            delete $self->[HASH]{ $last_key };
+        my $element;
+        if (exists $self->[HASH]{$key}) {
+            $element = $self->[HASH]{$key};
+        } else {
+            $element = 'Linked::List'->new($key, $value);
+            $self->[HASH]{$key} = $element;
+        }
+        $element->prepend_to($self->[FIRST])
+            unless $element == ($self->[FIRST] // -1);
+        $self->[HASH]{$key}->value = $value;
+        $self->[FIRST] = $element;
+        if (keys %{ $self->[HASH] } > $self->[CAPACITY]) {
+            my $last = $self->[FIRST]->prev;
+            $last->extract;
+            delete $self->[HASH]{ $last->key };
+            $last->demolish;
         }
     }
 
     sub inspect {
         my ($self) = @_;
-        my %refs_to_keys = reverse %{ $self->[HASH] };
-
-        my $element = $self->head;
-        my @ordered_keys;
-        while ($refs_to_keys{$element}) {
-            unshift @ordered_keys, $refs_to_keys{$element};
-            delete $refs_to_keys{$element};
+        my $element = $self->[FIRST];
+        my @keys;
+        for (keys %{ $self->[HASH] }) {
+            unshift @keys, $element->key;
             $element = $element->next;
         }
-        return \@ordered_keys
+        return [@keys]
     }
 }
 
+
 use Test::More;
 
 my $c = 'Cache::LRU'->new(3);
@@ -117,11 +113,11 @@ $c->set(3, 7);
 
 is_deeply $c->inspect, [1, 2, 3];
 
-is $c->get(2), 5, 'get 2';
+is ${ $c->get(2) }, 5, 'get 2';
 
 is_deeply $c->inspect, [1, 3, 2];
 
-is $c->get(1), 3, 'get 1';
+is ${ $c->get(1) }, 3, 'get 1';
 
 is_deeply $c->inspect, [3, 2, 1];