Simple thread safe caching in Raku

Tags:

So I posted yesterday about the weekyl challenge and mentioned caching and how I'd not done it because I liked the mathematical simplicity. Still Markus Holzer who's been known to tweet complete solutions to the challenges, suggested it and I thought I'd take a look.

The first thought is to use the is cached trait the problem is it's experimental and when I just added it to the square function it crashed. This is possibly because I only cached the function part that does a check and not the other part of the multi or possibly due to threading. Still it got me thinking about how I would want to do a thread safe cache implementation (without pulling in an external module like OO::Monitors ).

I took a look at the Lock class and for what I was thinking about (a cache hash that gets updated in a thread safe fashion) it should work. The updated square function now looks like this :

# Not caching, not need a no calculations involved.
multi sub square(Int $ where * <= 0) returns Bool { False }

# Note these are generated outside the sub routine so shared across threads.
my %square-cache;
my $lock = Lock.new;

multi sub square(Int \i) returns Bool {
  return %square-cache{i} if defined %square-cache{i};
  my \r = i.sqrt.narrow ~~ Int;
  $lock.protect( { %square-cache{i} = r } );
  return r;
}

Note I've updated the test using the narrow method again as per Markus's thoughts. But the code is pretty simple. Return the value from %square-cache if it exists, this isn't locked as it's a read and the worst comes to the worst you may have two threads try reading it at once, as they always write the same values it's not the worst. We do wrap the cache setting in a protect call to ensure we don't have multiple threads trying to update the cache at once.

I did try the code without the Lock and sometimes it works, sometimes it seg faults. Threading is hard y'all. Still I found with this in place there was a small but noticable speed increase for the 6 digit run. If I wasn't currently using a VM I'd try the 9 digit run again. On the bright side it doesn't seem to use a huge amount of memory. The 6 digite run making roughly 6000 cache keys.

Anyway, possibly more soon but I hope this was interesting.

Update

After I posted this Elizabeth Mattijsen shared it on Reddit with a note that accessing a Hash can cause a race condition (I figured it would be safe but I defer to Liz in such things as she's really smart).

Her updated code is even simpler, I'd put it here but my blogging platform is being weird, go checkout the link. The protect returns the value inside the block and we use //= to set the cache value, and as she also mentioned the return is superfluous and in these kind of cases I generally leave it out. So that's even cleaner and works fine. Awesome.

Thanks again Liz.

Weekly Challenge in Raku Week 102

Tags:

This weeks challenges are quite fun and simple enough (after a bit of thought). I'll quickly run through my results and some thoughts on doing it in Raku.

Challenge 1

So I learn lots of fun maths stuff doing the weekly challenge. Rare numbers are weird and there's not many of them. The code I came up with goes like this :

sub rares(UInt \l) {
  ((10**(l - 1))..((10**l)-1)).race.grep( -> \i { rare(i) } );
}

So lets break that down : ((10**(l - 1))..((10**l)-1)) give us the range of all l digit long numbers. Then we put in a race to get threading easily then we grep with our rare function... And here it is :

sub rare(Int \r) returns Bool {
  my \f = r.flip;
  square(r - f) && square( r + f );    
}

So here we flip the value to be tested (note we're using Raku's dynamic typing here. r is an Int, flip is a String method so f is a string but then we treat it as an Int straight after. Nice and simple. Of course now we've got another function, square.

multi sub square(Int $ where * <= 0) returns Bool { False }

multi sub square(Int \i) returns Bool { my \s = i.sqrt; s == s.Int; }

Our square function tests if our value is a perfect square. Firstly if it's a negative number then it's never going to work (I learned that the hard way testing if 12 is a rare number). Then if not we calculate the square root and see if it matches the Integer casting of itself.

Of course here be some dragons, calcualating square roots is horrible and slow for larger numbers. (The 9 digit run of this code takes... well I've got bored waiting for it on my VM that I'm currently using). I thought about adding caching but then there's the fun of that and threading so I decided to stick with the functional purity of the code.

It's pretty and I like that, if you want it to be fast get some more cores ;) My full solution includes a test suite and a main wrapper but they are pretty simple.

Challenge 2

At first glance this seemed quite complicated. Then I had a little thought about it and the word recursion popped up in my brain. It does that quite a lot, but this time it seemed to be right. Seriously you can't use recursion to solve every problem, I mean how to you recurse chosing what you want for dinner? (Answers on a postcard please).

Anyway. Lets have a think. We want a function hash-count that takes and integer and returns a string. If the integer is 1 you return a "#" and if it's 0 you return ""...

multi sub hash-count(1) { "#" }
multi sub hash-count(0) { "" }

So those definitely look like ending conditions of a recusrsive function. For any other positive integer the string ends with the number (call it $x) and a "#". This is put after the result of calling our function with $x less then the length of our string. So if $x is 5 then we have 5# which is length 2 so we call hash-count(5-2) and bingo... recursion.

multi sub hash-count(UInt $x) {
  hash-count($x - ($x.chars + 1) ) ~ $x ~ '#';
}

And there we go, nice and simple. Again Raku's multi method calls make recursion a doddle, probably why I reach for it so often when doing challanges.

I hope this has been interesting. More later.

Weekly Challenge in Raku : Week 101 (Part 2)

Tags:

So for this task I found a neat little trick for calculating if a point is inside a triangle. If you calculate the area of the triangle it should equal the area of the three triangle made of connecting the point with each of the sides.

So I decided it was time to whip out some simple classes and write a mini DSL. Now I'd like to give a caveat with this, I'm using user defined operators which are awesome but also rather slow. Generally I would not advise using them directly in a script but instead putting them in a module that can be precompiled for faster loading.

With this in mind lets write a few tests. I'm creating three new operators p[], v[] and t[] these will create a point, a vector and a triangle object. Here's the tests which should hopefully make some sense :

#| Run tests
multi sub MAIN("test") {
  use Test;
  isa-ok( p[2,3], Point, "Point Creation OK" ); 
  isa-ok( v[p[0,0], p[2,2]], Vector, "Vector Creation OK" );
  isa-ok( t[p[0,0], p[0,3], p[4,0]], Triangle, "Triangle Creation OK" );
  is( v[p[0,0], p[3,4]].len, 5, "Vector Length works" );
  is( t[p[0,0], p[0,3], p[4,0]].area, 6, "Triangle Area works" );
}

Note I've also added a len and area method for the Vector and Triangle as I'm going to need these.

The Point method and operator are simple enough :

class Point {
  has Rat() $.x;
  has Rat() $.y;
}

sub circumfix:<p[ ]>( *@ (Rat() $x, Rat() $y) ) {
  Point.new( :$x, :$y );
}

The Vector object just takes two points and we include the len method (with use of ² which is great).

class Vector {
  has Point $.p1;
  has Point $.p2;

  method len() {
    ( ($.p1.x - $.p2.x)² + ($.p1.y - $.p2.y)² ).sqrt;
  }
}

sub circumfix:<v[ ]>( *@ (Point $p1, Point $p2) ) {
    Vector.new( :$p1, :$p2 );
}

And finally we add the Triangle object, this takes three points and uses Heron's Forumla to calculate the area.

class Triangle {
  has Point $.p1;
  has Point $.p2;
  has Point $.p3;

  method area() {
    my \a = v[$.p1,$.p2].len;
    my \b = v[$.p1,$.p3].len;
    my \c = v[$.p2,$.p3].len;
    my \s = (a + b + c) / 2;
    return ( s * (s - a) * (s - b) * (s - c) ).sqrt;
  }
}

sub circumfix:<t[ ]>( *@ (Point $p1, Point $p2, Point $p3 ) ) {
  Triangle.new( :$p1, :$p2, :$p3 )
}

Ok. So that's the basic tests done. Now I'll add a point-inside method to the Triangle object.

The tests for this (from the challenge).

is( t[p[0,1],p[1,0],p[2,2]].point-inside(p[0,0]), False, "Origin not in Triangle" );
is( t[p[1,1],p[-1,1],p[0,-3]].point-inside(p[0,0]), True, "Origin in Triangle" );
is( t[p[0,1],p[2,0],p[-6,0]].point-inside(p[0,0]), True, "Origin on edge test" );

The point-inside method is quite simple as I've got my DSL in place :

method point-inside( Point $pn ) {
    my $*TOLERANCE = .000001;
    return self.area =~=
    ( t[$pn, $.p1, $.p2].area +
      t[$pn, $.p1, $.p3].area +
      t[$pn, $.p2, $.p3].area );
}

One note in order to get this to work I needed to define a stub Triangle class using class Triangle {...} so I could define the t[] operator as otherwise the Triangle class doesn't know what it means.

Because I'm using Square Roots I'm having to deal with floating point number and approximate equality. I could use a different method with raycasting and vector crossing but I've done this and it works so that's cool.

Last bit make a nice MAIN sub that takes size numbers and runs the check.

#| Does the triangle made from the 6 gives points contain the origin?
multi sub MAIN( Rat() $p1x, Rat() $p1y,
                Rat() $p2x, Rat() $p2y,
                Rat() $p3x, Rat() $p3y ) {
  say t[p[$p1x,$p1y],
        p[$p2x,$p2y],
        p[$p3x,$p3y]].point-inside(p[0,0]) ?? 1 !! 0;   
}

One of the many things I love about Raku is it's ability to easily let you make a language to do what you want. Hopefully work that's being done at the moment will deal with some of the startup costs of user generated operators so we can really play about with them. But until then libraries work just fine. As it is this takes 43 seconds to run on my VM with Raku 2021.12.

If I change the p[], t[] and v[] operators to simple subroutines p(), t(), v() it takes 0.6 seconds... So I guess that's the version I'm going to submit. Anyway, I hope you found this interesting, more soon.

Weekly Challenge in Raku : Week 101 (Part 1)

Tags:

So one of the things I'm going to blog about with my daily blogging plan is the Weekly Challenge. As I've got some time on my hands I've also volunteered to review the Raku solutions which I'm going to do over the week with the plan being to get the review to done for Friday.

Anyway, lets look at this weeks challenge. Normally when I do these I write the code and then return back and write my thought processes out after the fact. This time I'm going to try something a little different and write here as I do the code.

Challenge 1

We're given an array of things and we want to display them as a sprial going counterclockwise, the spiral needs to be the tightest possible. As I see it there's three parts to this :

  1. Find the factors (M and N) of the length of the input array which have the smallest distance.
  2. Make a MxN array of the data from the input array spiralling counter clockwise.
  3. Print this out (in a pretty fashion so with added spaces).

I'm a fan of TDD so I'll be applying that here. Generally for the weekly challenges I like to write a command line script that can take a "test" input to run the tests like so.

#| Run the test suite
multi sub MAIN( "test" ) {
  use Test;
  done-testing;
}

Of course this doesn't do anything yet but because I've got a declarator block we get a nicely formatted usage out put with -? and ch-1.raku test runs without crashing.

So first up lets do some factorisation. Lets update the test code with some tests :

#| Run the test suite
multi sub MAIN( "test" ) {
  use Test;
  is( tight-factors(4), (2,2), "4 factors to 2 and 2" );
  done-testing;

}

Ok test the first, based on the first example in the challenge. If we run that the script fails because the sub doesn't exist yet. Now for the little dopamine hit you get from making the tests pass, I mean... that's why we do TDD right?

sub tight-factors(Int $len) {
  return (2,2);
}

And now when we run the tests the pass! Awesome job done! Of course it's not, but this is one of the core disciplines of TDD, as soon at the tests pass stop. So if we want to write an actual factoring algorithm we need another test.

is( tight-factors(12), (3,4), "12 factors to 3 and 4" );

I'm skipping the rest of the test sub for now. Or this post will get insane. Here we not only test the factorisation of 12 but also that we get our results in the order smallest then largest.

So the tests are failing lets work out the algorithm. Now I always tend to start with the application of brute force and work from there. My thought for this algorithm in it's simplest is something like this.

  1. For a value L loop through 1..L/2 assign to I
  2. If L is divisble by I put (I,L/I) into a list.
  3. Sort the list by the difference between the two values.
  4. Return the first item from the list.

This nice thing with that algorithm as opposed to one that tracks the smallest difference during the loop is that you can multithread it easily. I'm probably not going to but still, that's the way my mind goes. Basically if I can write it as a series of list operations I'm happy.

sub tight-factors(Int $len) {
  (1..$len div 2).grep( { $len %% $_ } ).map( { ($_, $len / $_ ) } ).sort( -> ($a,$b) { abs($a-$b) } ).first;
}

Ok so that works, next up making a spiral. So I'm going to skip a few steps for the blog, I'm adding a couple of tests and the code for them.

is( spiralize( [1,2,3,4] ), [[4,3],[1,2]], "4 long list" );
is( spiralize( [1,2,3,4,5,6] ), [[6,5,4],[1,2,3]], "6 Long list" );
is( spiralize( (1..12) ), [[9,8,7,6],[10,11,12,5],[1,2,3,4]], "12 Long list" );
...

sub spiralize( @list ) {
  my ( $height, $width ) = tight-factors( @list.elems );
  my @out = [[Any xx $width] xx $height];

  my @current = [0,$height-1];
  my @direction = [1,0];

  for @list -> $val {
    @out[@current[1]][@current[0]] = $val;
    my @next = [ @current[0]+@direction[0], @current[1]+@direction[1] ];
    if @next[0] < 0 || @next[1] < 0 ||
       (@out[@next[1]][@next[0]]:!exists) || (defined @out[@next[1]][@next[0]]) {
      given @direction {
        when [1,0]  { @direction = [0,-1] }
        when [0,-1] { @direction = [-1,0] }
        when [-1,0] { @direction = [0,1] }
        when [0,1]  { @direction = [1,0] }
      }
    }
    @current = [ @current[0]+@direction[0], @current[1]+@direction[1] ];
  }
  return @out;
}

So lets go over this. Firstly we get our height and width from our tight-factors function. Then prefill an array with Any objects (so it's effectively undefined. Then we make a note of the current point (starting in the bottom left corner). Then we fill the current point with the first number in the list.

We've got a note of the direction we're moving so we work out what the next point will be. If the next point isn't valid when change the direction. What counts as not valid?

  • It's out of bounds
  • There's a value already set at that point

We just go through this loop with each value from the list. So finally it's time for the last part. Pretty printing. I'm not going to write tests for this part instead I'm just going to add a second MAIN sub that takes a list, spiraliazes it and prints it out.

#| Given a list of items print them in a tight anti clockwise sprial
multi sub MAIN( *@items ) {
  my $width = @items.map( *.chars ).max;
  .say for spiralize( @items ).map( -> @l { @l.map( { sprintf("%{$width}s",$_ ) } ).join(" ") });
}

So we get our list of stuff. Find the length of the longest item. Then spiralize it, format it and join with spaces then print each line. And there we go, job done.

Still I've written a lot. I think I'll look at Part 2 later. I hope this has been interesting, do leave a comment with your thoughts.

Perl Weekly Challenge 13

Tags:

So I know I've fallen off the blogging about the weekly challenge. This is not because I've not been doing (I have) or I've not been enoying them (I also have). It's because my blogging platform (a neat little Perl based system called Statocles) kind of died while parsing the Markdown on a previous blog post and this got me wound up.

It also got me to restart my personal plan to make a similar system for building simple, fast to update, static sites using Perl6. The first part of which (that is mostly so I can learn Grammars) is a Pure Perl6 Markdown parser.

It's taking a while but I'm hoping in my upcoming week off I'll get a lot more of it done.

Anyway I just read Laurent Rosenfield's post about this week and I wanted to share one of my two solutions becuase I thought it was kind of neat.

Hofstadter Female and Male sequences

So the Hofstadter Female and Male sequences are defined by the following equation :

F(0) = 1 ; M(0) = 0
F(n) = n - M(F(n-1)), n > 0
M(n) = n - F(M(n-1)), n > 0

So it's a pair of recursive functions. Where to calculate the value for n in either sequnces you need to calulate the ones before in both sequences. The problem with doing it as a pair of recursive functions is that without some kind of caching you're going to be calculating the same values over and over again (especailly) the smaller values of n. Laurent covered some nice ways to cache the data but when I had a look the word sequence jumped out at me. Hence my final code looks like this :

sub MAIN ( UInt() $n ) {
    my @M;
    my @F = lazy gather {
        my $n = 0;
        take 1;
        loop {
            $n++;
            take $n - @M[@F[$n-1]];
        }
    }

    @M = lazy gather {
        my $n = 0;
        take 0;
        loop {
            $n++;
            take $n - @F[@M[$n-1]];
        }
    };

    say "F : {@F[0..$n].join(", ")}";
    say "M : {@M[0..$n].join(", ")}";
}

Here I define a couple of lazy sequences that refer to one another. Note I have to predefine @M before I do @F or it raises and error but it's fine with my updating what @M is after the fact. I added some notes in the code to note before a take happened and each value is only taken once.

Later today I may run some speed tests of this code against the code Laurent wrote to see how performant it is.

An aside

While doing the first challenge for this week I found a bug in Perl6 where is you create a Range or Sequence of date objects and you give the first a custom formatter after the 28th of the month the formatted drops off. This bug was fixed as soon as I raised it in the Perl6 IRC and will hopefully be resolved in the next release.

Which is pretty cool.

Anyway, more later. Hopefully.