RogerBW's Blog

I’ve been doing the Perl Weekly Challenges. The latest was about searching for particular multiples of a number, and implementing a fixed-size cache.

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.

The easy way to match multiples seemed to be repeated addition combined with a regexp filter.

foreach my $n (@ARGV) {
  my $t=$n;
  while (1) {
    if ($t =~ /^[01]+$/) {
      print "$t\n";
      last;
    } else {
      $t+=$n;
    }
  }
}

and much the same in Perl6. There might be a clever mathematical way to generate these but one didn't come to mind.

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 the LRU cache, the basic need is a hash to store the data and a way to determine which entry has been most recently used. There are various possibilities for that combination, but none of them reduces to a pure hash, so I ended up with a plain list, updated by grepping to remove the key of the most-recently-used item and sticking it on the end. Plus lots of the usual Perl5 object sugar packed round it.

One insight: it's easier to add the new item to the cache and then delete the oldest if necessary than to check before adding whether a deletion will be needed.

package Local::LRU;

sub new {
  my $class = shift;
  my $self={};
  $self->{size}=shift || 3;
  $self->{store}={};
  $self->{lru}=[];
  bless $self,$class;
  return $self;
}

sub set {
  my $self=shift;
  my $k=shift;
  my $v=shift;
  $self->{store}{$k}=$v;
  $self->update_lru($k);
  if (scalar @{$self->{lru}} > $self->{size}) {
    delete $self->{store}{$self->{lru}[0]};
    shift @{$self->{lru}};
  }
}

sub get {
  my $self=shift;
  my $k=shift;
  if (exists $self->{store}{$k}) {
    $self->update_lru($k);
    return $self->{store}{$k};
  } else {
    return -1;
  }
}

sub update_lru {
  my $self=shift;
  my $k=shift;
  my @l=grep {$_ != $k} @{$self->{lru}};
  push @l,$k;
  @{$self->{lru}}=@l;
}

Then a basic test harness:

my $q=Local::LRU->new($ARGV[0] || 3);
$q->set(1,3);
$q->set(2,5);
$q->set(3,7);
print $q->get(2)," = 5\n";
print $q->get(1)," = 3\n";
print $q->get(4)," = -1\n";
$q->set(4,9);
print $q->get(3)," = -1\n";

Perl6 has different object sugar, which I haven't used before. It's a bit odd, but on balance quite pleasant to use.

class LRU {
  has Int $.size;
  has %!store;
  has @!lru;

  method set(Int $k, Int $v) {
    %!store{$k}=$v;
    self.update_lru($k);
    if @!lru.elems > $.size {
      %!store{@!lru[0]}:delete;
      @!lru.shift;
    }
  }

  method get(Int $k) {
    if %!store{$k}:exists {
      self.update_lru($k);
      return %!store{$k};
    } else {
      return -1;
    }
  }

  method update_lru(Int $k) {
    my @l=grep {$_ != $k}, @!lru;
    @l.push($k);
    @!lru=@l;
  }
}

my $q=LRU.new(size => (@*ARGS[0] or 3));
$q.set(1,3);
$q.set(2,5);
$q.set(3,7);
print $q.get(2)," = 5\n";
print $q.get(1)," = 3\n";
print $q.get(4)," = -1\n";
$q.set(4,9);
print $q.get(3)," = -1\n";