If you’ve never worked with MooX::Role::Parameterized or MooseX::Role::Parameterized, you might wonder what is a parameterized role at all?
Roles are used when you need to share behaviour among several classes that don’t have to be related by inheritance. Normally, a role just adds a bunch of methods to the class that consumes it (there’s more, you can for example specify which other methods the role expects to already exist).
A parameterized role makes it possible to provide parameters for the consumed role. This way, you can adjust the behaviour for each consuming class.
]]> The old syntaxThe standard syntax to apply a role to a class before version 0.100 of the module was to use the apply
class method:
# My/Role.pm
package My::Role;
use Moo::Role;
use MooX::Role::Parameterized;
role {
my ($params, $mop) = @_;
$mop->has($params->{name} => is => $params->{is});
}
# My/Obj.pm
package My::Obj;
use Moo;
use My::Role;
'My::Role'->apply({
name => 'size',
is => 'ro',
});
If we now created an object $o
using my $o = 'My::Obj'->new(size => 2)
, we could get the value of the attribute size
using the $o->size
getter: the role created a new read-only attribute size
for us.
What I didn’t like about applying a role to a class the old standard way was it wasn’t declarative. You could easily overlook it as a block of code happening at runtime, while the meaning of the code was This is how a role is consumed. Therefore, I used the alternative experimental syntax:
package My::Obj;
use Moo;
use MooX::Role::Parameterized::With 'My::Role' => {
name => 'size',
is => 'ro',
};
It's part of a use
clause, so it’s clear that it’s happening at compile time.
I promoted one of my side-jobs to a full-time job recently. They gave me a new computer where I had to install all my code base to start working on it 8 hours a day instead of a couple a month.
Imagine my surprise when the code stopped with an error:
Can't locate object method "size" via package "My::Obj" at ./run.pl line 37.
Line 37 was where I called $o->size
!
When installing the dependencies for my code, the most recent version of MooX::Role::Parameterized
was installed from CPAN (0.501). The experimental syntax is no longer documented and as I found out, doesn’t work anymore.
The old non-experimental syntax still works, but there’s a new syntax, too. It uses the with
keyword that looks like the one that can be used to consume a Moo::Role, but if we first use MooX::Role::Parameterized::With
, it can also accept parameters for the role application.
package My::Obj;
use Moo;
use MooX::Role::Parameterized::With 0.501;
with 'My::Role' => {
name => 'size',
is => 'ro',
};
Moreover, we should change the definition of the role, too. Parameters should be predeclared using the parameter
keyword (similarly to MooseX::Role::Parameterized), and they can be then accessed via getters instead of peeking inside a parameter hash reference.
package My::Role;
use Moo::Role;
use MooX::Role::Parameterized 0.501;
parameter name => (is => 'ro');
parameter is => (is => 'ro');
role {
my ($params, $mop) = @_;
$mop->has($params->name => is => $params->is);
}
]]>
We’re given a grid with obstacles, we’re supposed to count all the reachable plots in the grid in a given number of steps (we can only move one plot at a time horizontally or vertically).
The sample input looks like this:
........... .....###.#. .###.##..#. ..#.#...#.. ....#.#.... .##..S####. .##..#...#. .......##.. .##.#.####. .##..##.##. ...........
where S is the starting position.
]]> Part 1In the first part, we should count the plots reachable in 64 steps. I went with a non-recursive solution using a stack of positions to visit.
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
my ($sy, $sx);
my @garden;
while (<>) {
chomp;
push @garden, [split //];
($sy, $sx) = ($. - 1, pos($_) - 1) if /S/g;
}
$garden[$sy][$sx] = '.';
my @MOVES = ([0, 1], [0, -1], [1, 0], [-1, 0]);
my @agenda = ([$sy, $sx]);
my $reach = 0;
for (1 .. 64) {
my %next;
for my $pos (@agenda) {
my ($y, $x) = @$pos;
for my $move (@MOVES) {
my ($ny, $nx) = ($y + $move->[0], $x + $move->[1]);
undef $next{$ny}{$nx} if $ny >= 0 && $ny <= $#garden
&& $nx >= 0 && $nx <= $#{ $garden[0] }
&& $garden[$ny][$nx] eq '.';
}
}
@agenda = ();
for my $y (keys %next) {
for my $x (keys %{ $next{$y} }) {
push @agenda, [$y, $x];
}
}
}
say scalar @agenda;
The twist in the second part is subtle but it has colossal consequences. Whenever we try to go outside the grid, the grid is expanded with the exact copy of the original grid in the required direction. The number of steps we should take also changes: instead of 64, we’re supposed to take 26,501,365 steps.
We could modify the algorithm from the part 1 to expand the grid, but its performance would be horrible. We’d have to wait for years to get the answer, but to compete on the global leaderboard, we need seconds (or minutes for the local one).
I generated the output of such a modified algorithm for the first 500 steps to see whether I can detect anything that would help me with the optimisation. Plotting the graph with gnuplot yielded an increasing function for both the sample and real input data:
I don’t know why, but what I tried next was to plot the differences between neighbouring numbers, in a way making it possible to study the derivative of the function. The graphs are significantly different to the previous ones:
It seems there are repeated patterns, even if their amplitude is different. To see whether they’re regular, I measured the period of the repetition in the graph by hand and tried to extract each part of the pattern as a separate variable. The first element of the pattern is one line, the second element of the pattern is one line, etc.
To my delight, all the lines seemed to be straight, disregarding some curving at the very beginning before the system stabilised.
The rest of the work was routine, basically just implementing the same process. At first, I had no idea how to implement the measurement of the period, but in the end, it was straightforward: the program tries all the possible periods from 2, if the period is applicable to all the parts of the pattern, we’re done.
Once we know the period, we can easily generate the next element in the sequence. As generating 26 million elements still takes some time, we can calculate the result instead. The main trick is sum(1 .. x) = x * (x + 1) / 2
.
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
my $TARGET = 26501365;
my ($sy, $sx);
my @garden;
while (<>) {
chomp;
push @garden, [split //];
($sy, $sx) = ($. - 1, pos($_) - 1) if /S/g;
}
$garden[$sy][$sx] = '.';
my @MOVES = ([0, 1], [0, -1], [1, 0], [-1, 0]);
my %ACCESS;
for my $y (0 .. $#garden) {
for my $x (0 .. $#{ $garden[0] }) {
for my $move (@MOVES) {
my ($ny, $nx) = ($y + $move->[0], $x + $move->[1]);
push @{ $ACCESS{$y}{$x} }, $move
if '.' eq $garden[ $ny % @garden ][ $nx % @{ $garden[0] } ];
}
}
}
my @reach = (0);
my @diff;
my @agenda = ([$sy, $sx]);
my $period = 0;
my $i = 0;
EXPANSION:
while (! $period) {
++$i;
say "Expanding to $i";
my %next;
for my $pos (@agenda) {
my ($y, $x) = @$pos;
for my $move (@{ $ACCESS{ $y % @garden }{ $x % @{ $garden[0] } } }) {
my $ny = $y + $move->[0];
my $nx = $x + $move->[1];
undef $next{$ny}{$nx}
}
}
@agenda = ();
for my $y (keys %next) {
for my $x (keys %{ $next{$y} }) {
push @agenda, [$y, $x];
}
}
$reach[$i] = @agenda;
$diff[$i] = $reach[$i] - $reach[ $i - 1 ];
next if $i % 50 != 0; # Search for the period only sometimes.
PERIOD:
for my $p (2 .. $i / 3 - 1) {
say "Trying period $p at size $i.";
for my $from ($i - $p .. $i) {
next PERIOD
if $diff[$from] - $diff[ $from - $p ]
!= $diff[ $from - $p ] - $diff[ $from - 2 * $p ];
}
last PERIOD unless $p;
say "Found $p";
# Extend the data so we can calculate the result.
while ($i++ < 6 * $p) {
$diff[$i] = 2 * $diff[ $i - $p ] - $diff[ $i - 2 * $p ];
$reach[$i] = $reach[ $i - 1 ] + $diff[ $i ];
}
$period = $p;
last EXPANSION
}
}
my (@d, @d2);
for my $i (0 .. $period - 1) {
$d2[$i] = $diff[ $i + 5 * $period ] - $diff[ 4 * $period + $i ];
$d[$i] = $diff[4 * $period + $i] - 4 * $d2[$i];
}
my $m = $TARGET % $period;
my $d = 0;
my $d2 = 0;
for my $j (3 * $period + $m + 1 .. 4 * $period + $m) {
my $dd = $d[$j % $period] + $d2[$j % $period] * (1 + int($j / $period));
$d += $dd;
$d2 += $d2[$j % $period];
}
my $n = int(($TARGET - 4 * $period - $m - 1)/ $period) + 1;
my $s = $reach[ 4 * $period + $m ] + $d * $n + $d2 * ($n * ($n - 1) / 2);
say $s;