Related
I have this code:
class kg is Dimension {
method new() {
return self.bless(
:type('mass'),
:abbr('kg'),
:multiplier(Multiplier.new(
numerator => 1.0,
denominator => Quantity.new(1000.0, 'g')))),
}
}
class mg is Dimension {
method new() {
return self.bless(
:type('mass'),
:abbr('mg'),
:multiplier(Multiplier.new(
numerator => 1000.0,
denominator => Quantity.new(1.0, 'g')))),
}
}
I'll be adding many more similar classes. Rather than spell out all these classes separately, I'd like to learn how to create a factory that can create these classes from simple data structures.
How do I do this? I read the Metaobject Protocol doc but I couldn't figure out how to give my classes different names on the fly based on the examples at the top and middle of the doc page.
I tried:
constant A := Metamodel::ClassHOW.new_type( name => 'A' );
A.^add_method('x', my method x(A:) { say 42 });
A.^add_method('set', my method set(A: Mu \a) { A.^set_name(a) });
A.^compose;
my $bar = A;
$bar.set('Foo');
say $bar.^name; #
A.x; # works
Foo.x; # error
But the last line just throws an error:
Undeclared name:
Foo used at line 13
The first thing you should realize, that any kind of meta-programmming usually will need to be done at compile time, aka in a BEGIN block.
Secondly: at the moment, Raku has some meta-programming features for creating code, but not all features needed to make this as painless as possible. The work on RakuAST will change that, as it basically makes Raku itself being built from a public meta-programming API (rather than you could argue, the current bootstrap version using a lot of NQP).
I've rewritten your code to the following:
sub frobnicate(Str:D $name) {
my \A := Metamodel::ClassHOW.new_type(:$name);
A.^add_method('x', my method x() { say 42 });
A.^compose;
OUR::{$name} := A;
}
BEGIN frobnicate("Foo");
say Foo.^name; # Foo
Foo.x; # 42
So, this introduces a sub called frobnicate that creates a new type with the given name. Adds a method x to it, and composes the new type. And then makes sure it is known as an our in the current compilation unit.
Then the frobnicate sub is called at compile time by prefixing a BEGIN. This is important, because otherwise Foo won't be known when the next line is compiled, so you'd get errors.
There is currently a small catch:
dd Foo.^find_method("x").signature; # :(Mu: *%_)
The invocant constraint is not set. I haven't found a way (before RakuAST) to set that using an meta-programming interface. But I don't think that's going to be an issue for the example you've given. If it does become an issue, then let's cross that bridge when we get there.
Here is the entire code that I came up with for a solution:
#!/usr/bin/env raku
use v6.d;
class Dimension { }
sub dimension-attr-factory($name, Mu $type, Mu $package) {
return Attribute.new(
:name('$.' ~ $name),
:type($type),
:has_accessor(1),
#:is_required(1),
:package($package)
);
}
sub dimension-factory(Str:D $name, #attributes) {
my \A := Metamodel::ClassHOW.new_type(:$name);
A.^add_parent(Dimension);
for #attributes {
my $attr = dimension-attr-factory($_[0], $_[1], A);
A.^add_attribute($attr);
}
A.^compose;
OUR::{$name} := A;
}
class Multiplier {
has Rat $.numerator;
has Quantity $.denominator;
method factor() {
return $.numerator / $.denominator.value;
}
}
class Quantity {
has Rat() $.value is required;
has Dimension:D $.dimension is required;
multi submethod BUILD(Rat:D() :$!value, Dimension:D :$!dimension) {
}
multi submethod BUILD(Rat:D() :$value, Str:D :$dimension) {
$!dimension = ::($dimension).new;
}
multi method new(Rat:D() $value, Dimension:D $dimension) {
return self.bless(
:$value,
:$dimension,
)
}
multi method new(Rat:D() $value, Str:D $dimension) {
return self.bless(
:$value,
:$dimension,
)
}
method to(Str:D $dimension = '') {
my $from_value = $.value;
my $to = $dimension ?? ::($dimension).new !! ::(self.dimension.abbr).new;
# do types match?
if $to.type ne self.dimension.type {
die "Cannot convert a " ~ self.dimension.type ~ " to a " ~ $to.type;
};
my $divisor = $.dimension.multiplier ?? $.dimension.multiplier.factor !! 1.0;
my $dividend = $to.multiplier ?? $to.multiplier.factor !! 1;
my $result = $dividend / $divisor * $from_value;
return Quantity.new($result, $to);
}
method gist() {
$.value ~ ' ' ~ $.dimension.abbr;
}
}
BEGIN {
my %dimensions = 'mass' => {
base => {
abbr => 'g',
},
derived => {
kg => { num => 1000.0, den => 1.0, },
mg => { num => 1.0, den => 1000.0, },
ug => { num => 1.0, den => 1000000.0, },
}
};
for %dimensions.kv -> $key, $value {
# set up base class for dimension type
my $base = %dimensions{$key}<base><abbr>;
my #attributes = ['abbr', $base], ['type', $key];
dimension-factory( $base, #attributes);
my %derived = %dimensions{$key}<derived>;
for %derived.kv -> $abbr, $values {
my $numerator = %dimensions{$key}<derived>{$abbr}<num>;
my $denominator = %dimensions{$key}<derived>{$abbr}<den>;
my $multiplier = Multiplier.new(
numerator => 1.0,
denominator => Quantity.new(1000.0, 'g'),
);
#attributes = ['abbr', $abbr], ['type', $key], ['multiplier', $multiplier];
my $dim = dimension-factory( $abbr, #attributes );
#$dim.new(:$abbr, type => $key, :$multiplier );
}
}
}
my $kg = kg.new();
my $quant = Quantity.new(value => 5.0, dimension => $kg);
dd $quant;
I would probably create a dimension keyword with a custom metamodel, would probably also override * and / operators using undefined dimensions and then would create kg with something like:
dimension Gram {
has Dimension::Type $.type = mass;
has Str $.abbr = "g";
}
dimension KiloGram is Gram {
has Str $.abbr = "kg";
has Dimension::Multiplier $.multiplier = 1000 * g;
}
dimension MiliGram is Gram {
has Str $.abbr = "mg";
has Dimension::Multiplier $.multiplier = g / 1000;
}
but maybe that's too much...
This is problem36 from the Euler Project. Sum all of the numbers below a million that are palindromic in base 2 and base 10.
I'd originally tried solving it in a more functional style.
This runs in just under 6 seconds.
[1..1_000_000]
.grep( * !%% 2 )
.grep( -> $x { $x == $x.flip } )
.grep( -> $y { $y.base(2) == $y.base(2).flip } )
.sum.say
Surprisingly this took 12 seconds even though I'm only generating odd numbers and therefore
skipping the test for even.
(1,3 ... 1_000_000)
.grep( -> $x { $x == $x.flip } )
.grep( -> $y { $y.base(2) == $y.base(2).flip } )
.sum.say
This runs in about 3 seconds.
my #pals;
for (1,3 ... 1_000_000) -> $x {
next unless $x == $x.flip;
next unless $x.base(2) == $x.base(2).flip;
#pals.push($x);
}
say [+] #pals;
I also noted that there is a significant difference between using
for (1,3 ... 1_000_000) -> $x { ...
and
for [1,3 ... 1_000_000] -> $x { ...
Anyone know why the streaming versions are so much slower than the iterative one?
And, why would those two for loops be so different in performance?
The construct [...] is an array composer. It eagerly iterates the iterable found within it, and stores each value into the array. Only then do we proceed to do the iteration. That results in far more memory allocation and is less cache-friendly. By contrast, parentheses do nothing (aside from grouping, but they don't add any semantics beyond that). Thus:
[1..1_000_000]
.grep( * !%% 2 )
.grep( -> $x { $x == $x.flip } )
.grep( -> $y { $y.base(2) == $y.base(2).flip } )
.sum.say
Will allocate and set up a million element array and iterate it, while:
(1..1_000_000)
.grep( * !%% 2 )
.grep( -> $x { $x == $x.flip } )
.grep( -> $y { $y.base(2) == $y.base(2).flip } )
.sum.say
Runs rather faster, because it need not do that.
Further, the ... operator is currently far slower than the .. operator. It's not doomed to be that way forever, it's just received a lot less attention so far. Since .grep has also been decently well optimized, it turns out to be quicker to filter out the elements made by the range - for now, anyway.
Finally, using == to compare the (string) results of base and flip is not so efficient, since it parses them back into integers, when we could use eq and compare the strings:
(1 .. 1_000_000)
.grep(* !%% 2)
.grep( -> $x { $x eq $x.flip } )
.grep( -> $y { $y.base(2) eq $y.base(2).flip } )
.sum.say
If you want something that is faster, you can write your own sequence generator.
gather {
loop (my int $i = 1; $i < 1_000_000; $i += 2) {
take $i
}
}
.grep( -> $x { $x eq $x.flip } )
.grep( -> $y { $y.base(2) eq $y.base(2).flip } )
.sum.say
Which takes about 4 seconds.
Or to go even faster, you can create the Iterator object yourself.
class Odd does Iterator {
has uint $!count = 1;
method pull-one () {
if ($!count += 2) < 1_000_000 {
$!count
} else {
IterationEnd
}
}
}
Seq.new(Odd.new)
.grep( -> $x { $x == $x.flip } )
.grep( -> $y { $y.base(2) == $y.base(2).flip } )
.sum.say
Which only takes about 2 seconds.
Of course if you want to go as fast as possible, get rid of the sequence iteration entirely.
Also use native ints.
Also cache the base 10 string. (my $s = ~$x)
my int $acc = 0;
loop ( my int $x = 1; $x < 1_000_000; $x += 2) {
next unless (my $s = ~$x) eq $s.flip;
next unless $x.base(2) eq $x.base(2).flip;
$acc += $x
}
say $acc;
Which gets it down to about 0.45 seconds.
(Caching the .base(2) didn't seem to do anything.)
This is probably close to the minimum without resorting to using nqp ops directly.
I tried writing a native int bit flipper, but it made it slower. 0.5 seconds.
(I did not come up with this algorithm, I only adapted it to Raku. I also added the +> $in.msb to fit this problem.)
I would guess that spesh is leaving in operations that don't need to be there.
Or maybe it isn't JITting very well.
It might be more performant for values larger than 1_000_000.
(.base(2).flip is O(log n) whereas this is O(1).)
sub flip-bits ( int $in --> int ) {
my int $n =
((($in +& (my int $ = 0xaaaaaaaa)) +> 1) +| (($in +& (my int $ = 0x55555555)) +< 1));
$n = ((($n +& (my int $ = 0xcccccccc)) +> 2) +| (($n +& (my int $ = 0x33333333)) +< 2));
$n = ((($n +& (my int $ = 0xf0f0f0f0)) +> 4) +| (($n +& (my int $ = 0x0f0f0f0f)) +< 4));
$n = ((($n +& (my int $ = 0xff00ff00)) +> 8) +| (($n +& (my int $ = 0x00ff00ff)) +< 8));
((($n +> 16) +| ($n+< 16)) +> (32 - 1 - $in.msb)) +& (my int $ = 0xffffffff);
}
…
# next unless (my $s = ~$x) eq $s.flip;
next unless $x == flip-bits($x);
You can even try to use multiple threads.
Note that this workload is entirely too little for this to be effective.
The overhead of using threads swamps out any benefit.
my atomicint $total = 0;
sub process ( int $s, int $e ) {
# these are so the block lambda works properly
# (works around what I think is a bug)
my int $ = $s;
my int $ = $e;
start {
my int $acc = 0;
loop ( my int $x = $s; $x < $e; $x += 2) {
next unless (my $s = ~$x) eq $s.flip;
next unless $x.base(2) eq $x.base(2).flip;
$acc += $x;
}
$total ⚛+= $acc;
}
}
my int $cores = (Kernel.cpu-cores * 2.2).Int;
my int $per = 1_000_000 div $cores;
++$per if $per * $cores < 1_000_000;
my #promises;
my int $start = 1;
for ^$cores {
my int $end = $start + $per - 2;
$end = 1_000_000 if $end > 1_000_000;
push #promises, process $start, $end;
#say $start, "\t", $end;
$start = $end + 2;
}
await #promises;
say $total;
Which runs in about 0.63 seconds.
(I messed with the 2.2 value to find a near minimum time on my computer.)
How do i nicely/idiomatically split a string at a list of positions?
What I have:
.say for split-at( "0019ABX26002", (3, 4, 8) );
sub split-at( $s, #positions )
{
my $done = 0;
gather
{
for #positions -> $p
{
take $s.substr($done, $p - $done );
$done = $p;
}
take $s.substr( $done, * );
}
}
which is reasonable. I am puzzled by the lack of language support for this though. If "split on" is a thing, why isn't "split at" too? I think this should be a core operation. I should be able to write
.say for "0019ABX26002".split( :at(3, 4, 8) );
Or maybe I am overlooking something?
Edit: A little Benchmark of what we have so far
O------------O---------O------------O--------O-------O-------O
| | Rate | array-push | holli | raiph | simon |
O============O=========O============O========O=======O=======O
| array-push | 15907/s | -- | -59% | -100% | -91% |
| holli | 9858/s | 142% | -- | -100% | -79% |
| raiph | 72.8/s | 50185% | 20720% | -- | 4335% |
| simon | 2901/s | 1034% | 369% | -98% | -- |
O------------O---------O------------O--------O-------O-------O
Code:
use Bench;
my $s = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbccccddddddddddddddddddddddddddddddddddddefggggggggggggggggggg";
my #p = 29, 65, 69, 105, 106, 107;
Bench.new.cmpthese(1000, {
holli => sub { my # = holli($s, #p); },
simon => sub { my # = simon($s, #p); },
raiph => sub { my # = raiph($s, #p); },
array-push => sub { my # = array-push($s, #p); },
});
#say user($s, #p);
sub simon($str, *#idxs ) {
my #rotors = #idxs.map( { state $l = 0; my $o = $_ - $l; $l = $_; $o } );
$str.comb("").rotor( |#rotors,* ).map(*.join(""));
}
sub raiph($s, #p) {
$s.split( / <?{$/.pos == any(#p)}> / )
}
sub holli( $s, #positions )
{
my $done = 0;
gather
{
for #positions -> $p
{
take $s.substr($done, $p - $done );
$done = $p;
}
take $s.substr( $done, * );
}
}
sub array-push( $s, #positions )
{
my $done = 0;
my #result;
for #positions -> $p
{
#result.push: $s.substr($done, $p - $done );
$done = $p;
}
#result.push: $s.substr( $done, * );
#result;
}
Personally I'd split it into a list, use rotor to divide the list up and join the result :
"0019ABX26002".comb().rotor(3,1,4,*).map(*.join)
If you want a split at function (using the indexes given) :
sub split-at( $str, *#idxs ) {
my #rotors = #idxs.map( { state $l = 0; my $o = $_ - $l; $l = $_; $o } );
$str.comb("").rotor( |#rotors,* ).map(*.join(""));
}
Basically if I want to do list type stuff I use a list.
I came up with another version that I really like from a functional programming sense :
sub split-at( $str, *#idxs ) {
(|#idxs, $str.codes)
==> map( { state $s = 0;my $e = $_ - $s;my $o = [$s,$e]; $s = $_; $o } )
==> map( { $str.substr(|$_) } );
}
It works out to be slightly slower than the other one.
One way:
.say for "0019ABX26002" .split: / <?{ $/.pos ∈ (3,4,8) }> /
displays:
001
9
ABX2
6002
Because each substring does not depend on the other, hyper becomes an option.
method split-at(\p) {
do hyper for (0,|p) Z (|p,self.chars) {
self.substr: .head, .tail - .head
}
}
Or in sub form:
sub split-at(\s, \p) {
do hyper for (0,|p) Z (|p,s.chars) {
s.substr: .head, .tail - .head
}
}
But the overhead involved is not worth it unless the number of elements requested is extreme — in my tests it's about ten times slower than the naïve form.
Here's the solution I would use:
my method break (Str \s: *#i where .all ~~ Int) {
gather for #i Z [\+] 0,|#i -> ($length, $start) {
take s.substr: $start, $length
}
}
say "abcdefghi".&break(2,3,4) # "ab","cde","fghi"
The gather/take lets it be lazy if you ultimately don't need to use all of them. The loop takes #i (2,3,4 in the example) and zips it up with the cascading addition reducer [\+], which would normally produce 2,5,9, but we insert a 0 to make it 0,2,5,9 to mark the starting indexes of each one. This lets the actual take be a simple substr operation.
By making it a method instead of a sub, you can use it just like you would (you could even name it split if you want, the addition of the & sigil means Raku won't be confused whether you want the built in or custom made one.
You could, even, add it directly to Str:
use MONKEY-TYPING; # enable augment
augment class Str {
multi method split (Str \s: *#i where .all ~~ Int) {
gather for #i Z [\+] 0,|#i -> ($length, $start) {
take s.substr: $start, $length
}
}
}
say "abcdefghi".split(2,3,4)
In this case, it needs to be defined as multi method since there are already various split methods. The nice thing is since none of those are defined by only Int arguments, it's easy to ensure our augmented one gets used.
That said, calling it using the sigiled version in a lexical method is definitely the better one.
Please consider the code below. Why is the output of this is "BABABA" and not "AAABAA" / "AABAAAB"? Shouldn't the two supplies run in parallel and the whenever fire immedeatly when there is an event in any of them?
my $i = 0;
my $supply1 = supply { loop { await Promise.in(3); done if $i++> 5; emit("B"); } };
my $supply2 = supply { loop { await Promise.in(1); done if $i++> 5; emit("A"); } };
react
{
#whenever Supply.merge($supply1, $supply2) -> $x { $x.print }
whenever $supply1 -> $x { $x.print };
whenever $supply2 -> $x { $x.print };
}
When we subscribe to a supply block, the body of that supply block is run immediately in order to set up subscriptions. There's no concurrency introduced as part of this; if we want that, we need to ask for it.
The best solution depends on how close the example is to what you're doing. If it's very close - and you want to emit values every time interval - then the solution is to use Supply.interval instead:
my $i = 0;
my $supply1 = supply { whenever Supply.interval(3, 3) { done if $i++ > 5; emit("B"); } };
my $supply2 = supply { whenever Supply.interval(1, 1) { done if $i++> 5; emit("A"); } };
react {
whenever $supply1 -> $x { $x.print };
whenever $supply2 -> $x { $x.print };
}
Which simply sets up a subscription and gets out of the setup, and so gives the output you want, however you do have a data race on the $i.
The more general pattern is to just do anything that gets the loop happening out of the setup step. For example, we could use an a kept Promise to just "thunk" it:
my constant READY = Promise.kept;
my $i = 0;
my $supply1 = supply whenever READY {
loop { await Promise.in(3); done if $i++> 5; emit("B"); }
}
my $supply2 = supply whenever READY {
loop { await Promise.in(1); done if $i++> 5; emit("A"); }
}
react {
whenever $supply1 -> $x { $x.print };
whenever $supply2 -> $x { $x.print };
}
Which helps because the result of a Promise will be delivered to the supply block via the thread pool scheduler, thus forcing the execution of the content of the whenever - containing the loop - into its own scheduled task.
This isn't especially pretty, but if we define a function to do it:
sub asynchronize(Supply $s) {
supply whenever Promise.kept {
whenever $s { .emit }
}
}
Then the original program only needs the addition of two calls to it:
my $i = 0;
my $supply1 = supply { loop { await Promise.in(3); done if $i++> 5; emit("B") } }
my $supply2 = supply { loop { await Promise.in(1); done if $i++> 5; emit("A") } }
react {
whenever asynchronize $supply1 -> $x { $x.print }
whenever asynchronize $supply2 -> $x { $x.print }
}
To make it work as desired. Arguably, something like this should be provided as a built-in.
It is possible to use a Channel as well, as the other solution proposes, and depending on the problem at hand that may be suitable; the question is a bit too abstracted from a real problem for me to say. This solution stays within the Supply paradigm, and is neater in that sense.
Thanks to jjmerelo here, I managed to get it working. The channel was the right track, but you actually have to consume the channels supply.
use v6;
my Channel $c .= new;
my $supply1 = start { loop { await Promise.in(1); $c.send("B"); } };
my $supply2 = start { loop { await Promise.in(0.5); $c.send("A"); } };
react
{
whenever $c.Supply -> $x { $x.print };
}
$c.close;
Additional question: How good does that scale? Can you have several thousand supplies sending to the channel?
Supplies are asynchronous, not concurrent. You will need to use channels instead of supplies to feed them concurrently.
use v6;
my $i = 0;
my Channel $c .= new;
my $supply1 = start { for ^5 { await Promise.in(1); $c.send("B"); } };
my $supply2 = start { for ^5 { await Promise.in(0.5); $c.send("A"); } };
await $supply2;
await $supply1;
$c.close;
.say for $c.list;
In this case, the two threads start at the same time, and instead of using .emit, then .send to the channel. In your example, they are effectively blocked while they wait, since they are both running in the same thread. They only give control to the other supply after the promise is kept, so that they run apparently "in parallel" and as slow as the slower of them.
Ok, so here is my real code. It seems to work, but I think there is a race condition somewhere. Here's some typical (albeit short) output.
A monster hatched.
A monster hatched.
A hero was born.
The Monster is at 2,3
The Monster is at 3,2
The Player is at 0,0
The Monster (2) attacks the Player (3)
The Monster rolls 14
The Player rolls 4
The Monster inflicts 4 damage
The Player (3) attacks the Monster (2)
The Player rolls 11
The Monster rolls 8
The Player inflicts 45 damage
The Monster is dead
The Monster is at -3,-3
The Player is at 4,-3
The Monster (1) attacks the Player (3)
The Monster rolls 8
The Player rolls 5
The Monster inflicts 11 damage
The Player has 32 hitpoints left
The Monster is at -4,1
The Player is at -1,4
The Player (3) attacks the Monster (1)
The Player rolls 12
The Monster rolls 11
The Player inflicts 46 damage
The Monster is dead
Stopping
Game over. The Player has won
Now the strange thing is, sometimes, in maybe 20% of the runs, the last line of the output is
Game over. The GameObject has won
as if the object got caught while it already is partially deconstructed? Or something? Anyway here's the code.
class GameObject
{
has Int $.id;
has Int $.x is rw;
has Int $.y is rw;
has $.game;
has Int $.speed; #the higher the faster
has Bool $.stopped is rw;
multi method start( &action )
{
start {
loop {
&action();
last if self.stopped;
await Promise.in( 1 / self.speed );
}
$.game.remove-object( self );
}
}
method speed {
$!speed +
# 33% variation from the base speed in either direction
( -($!speed / 3).Int .. ($!speed / 3).Int ).pick
;
}
}
role UnnecessaryViolence
{
has $.damage;
has $.hitpoints is rw;
has $.offense;
has $.defense;
method attack ( GameObject $target )
{
say "The {self.WHAT.perl} ({self.id}) attacks the {$target.WHAT.perl} ({$target.id})";
my $attacker = roll( $.offense, 1 .. 6 ).sum;
say "The {self.WHAT.perl} rolls $attacker";
my $defender = roll( $target.defense, 1 .. 6 ).sum;
say "The {$target.WHAT.perl} rolls $defender";
if $attacker > $defender
{
my $damage = ( 1 .. $.damage ).pick;
say "The {self.WHAT.perl} inflicts {$damage} damage";
$target.hitpoints -= $damage ;
}
if $target.hitpoints < 0
{
say "The {$target.WHAT.perl} is dead";
$target.stopped = True;
}
else
{
say "The {$target.WHAT.perl} has { $target.hitpoints } hitpoints left";
}
}
}
class Player is GameObject does UnnecessaryViolence
{
has $.name;
multi method start
{
say "A hero was born.";
self.start({
# say "The hero is moving";
# keyboard logic here, in the meantime random movement
$.game.channel.send( { object => self, x => (-1 .. 1).pick, y => (-1 .. 1).pick } );
});
}
}
class Monster is GameObject does UnnecessaryViolence
{
has $.species;
multi method start
{
say "A monster hatched.";
self.start({
# say "The monster {self.id} is moving";
# AI logic here, in the meantime random movement
$.game.channel.send( { object => self, x => (-1 .. 1).pick, y => (-1 .. 1).pick } );
});
}
}
class Game
{
my $idc = 0;
has GameObject #.objects is rw;
has Channel $.channel = .new;
method run{
self.setup;
self.mainloop;
}
method setup
{
self.add-object( Monster.new( :id(++$idc), :species("Troll"), :hitpoints(20), :damage(14), :offense(3), :speed(300), :defense(3), :x(3), :y(2), :game(self) ) );
self.add-object( Monster.new( :id(++$idc), :species("Troll"), :hitpoints(10), :damage(16), :offense(3), :speed(400), :defense(3), :x(3), :y(2), :game(self) ) );
self.add-object( Player.new( :id(++$idc), :name("Holli"), :hitpoints(50), :damage(60), :offense(3), :speed(200) :defense(2), :x(0), :y(0), :game(self) ) );
}
method add-object( GameObject $object )
{
#!objects.push( $object );
$object.start;
}
method remove-object( GameObject $object )
{
#!objects = #!objects.grep({ !($_ === $object) });
}
method mainloop
{
react {
whenever $.channel.Supply -> $event
{
self.stop-game
if self.all-objects-stopped;
self.process-movement( $event );
self.stop-objects
if self.game-is-over;
};
whenever Supply.interval(1) {
self.render;
}
}
}
method process-movement( $event )
{
#say "The {$event<object>.WHAT.perl} moves.";
given $event<object>
{
my $to-x = .x + $event<x>;
my $to-y = .y + $event<y>;
for #!objects -> $object
{
# we don't care abour ourselves
next
if $_ === $object;
# see if anything is where we want to be
if ( $to-x == $object.x && $to-y == $object.y )
{
# can't move, blocked by friendly
return
if $object.WHAT eqv .WHAT;
# we found a monster
.attack( $object );
last;
}
}
# -5 -1 5
# we won the fight or the place is empty
# so let's move
.x = $to-x == 5 ?? -4 !!
$to-x == -5 ?? 4 !!
$to-x;
.y = $to-y == 5 ?? -4 !!
$to-y == -5 ?? 4 !!
$to-y;
}
}
method render
{
for #!objects -> $object {
"The {$object.WHAT.perl} is at {$object.x},{$object.y}".say;
}
}
method stop-objects
{
say "Stopping";
for #!objects -> $object {
$object.stopped = True;
}
}
method stop-game {
"Game over. The {#!objects[0].WHAT.perl} has won".say;
$.channel.close;
done;
}
method game-is-over {
return (#!objects.map({.WHAT})).unique.elems == 1;
}
method all-objects-stopped {
(#!objects.grep({!.stopped})).elems == 0;
}
}
Game.new.run;
Here's exercise 5.F.2 from 'A Book of Abstract Algebra' by Charles C Pinter:
Let G be the group {e, a, b, b^2, b^3, ab, ab^2, ab^3} whose
generators satisfy a^2 = e, b^4 = e, ba = ab^3. Write the table
of G. (G is called the dihedral group D4.)
Here's a little Perl 6 program which presents a solution:
sub generate(%eqs, $s)
{
my #results = ();
for %eqs.kv -> $key, $val {
if $s ~~ /$key/ { #results.push($s.subst(/$key/, $val)); }
if $s ~~ /$val/ { #results.push($s.subst(/$val/, $key)); }
}
for #results -> $result { take $result; }
my #arrs = #results.map({ gather generate(%eqs, $_) });
my $i = 0;
while (1)
{
for #arrs -> #arr { take #arr[$i]; }
$i++;
}
}
sub table(#G, %eqs)
{
printf " |"; for #G -> $y { printf "%-5s|", $y; }; say '';
printf "-----|"; for #G -> $y { printf "-----|"; }; say '';
for #G -> $x {
printf "%-5s|", $x;
for #G -> $y {
my $result = (gather generate(%eqs, "$x$y")).first(* (elem) #G);
printf "%-5s|", $result;
}
say ''
}
}
# ----------------------------------------------------------------------
# Pinter 5.F.2
my #G = <e a b bb bbb ab abb abbb>;
my %eqs = <aa e bbbb e ba abbb>; %eqs<e> = '';
table #G, %eqs;
Here's what the resulting table looks like:
Let's focus on these particular lines from generate:
my #arrs = #results.map({ gather generate(%eqs, $_) });
my $i = 0;
while (1)
{
for #arrs -> #arr { take #arr[$i]; }
$i++;
}
A recursive call to generate is made for each of the items in #results. Then we're effectively performing a manual 'zip' on the resulting sequences. However, Perl 6 has zip and the Z operator.
Instead of the above lines, I'd like to do something like this:
for ([Z] #results.map({ gather generate(%eqs, $_) })).flat -> $elt { take $elt; }
So here's the full generate using Z:
sub generate(%eqs, $s)
{
my #results = ();
for %eqs.kv -> $key, $val {
if $s ~~ /$key/ { #results.push($s.subst(/$key/, $val)); }
if $s ~~ /$val/ { #results.push($s.subst(/$val/, $key)); }
}
for #results -> $result { take $result; }
for ([Z] #results.map({ gather generate(%eqs, $_) })).flat -> $elt { take $elt; }
}
The issue with the Z version of generate is that it hangs...
So, my question is, is there a way to write generate in terms of Z?
Besides this core question, feel free to share alternative solutions to the exercise which explore and showcase Perl 6.
As another example, here's exercise 5.F.3 from the same book:
Let G be the group {e, a, b, b^2, b^3, ab, ab^2, ab^3} whose
generators satisfy a^4 = e, a^2 = b^2, ba = ab^3. Write the
table of G. (G is called the quaternion group.)
And the program above displaying the table:
As an aside, this program was converted from a version in C#. Here's how generate looks there using LINQ and a version of ZipMany courtesy of Eric Lippert.
static IEnumerable<string> generate(Dictionary<string,string> eqs, string s)
{
var results = new List<string>();
foreach (var elt in eqs)
{
if (new Regex(elt.Key).IsMatch(s))
results.Add(new Regex(elt.Key).Replace(s, elt.Value, 1));
if (new Regex(elt.Value).IsMatch(s))
results.Add(new Regex(elt.Value).Replace(s, elt.Key, 1));
}
foreach (var result in results) yield return result;
foreach (var elt in ZipMany(results.Select(elt => generate(eqs, elt)), elts => elts).SelectMany(elts => elts))
yield return elt;
}
The entire C# program: link.
[2022 update by #raiph. I just tested the first block of code in a recent Rakudo. The fourth example returned one result, 'abc', rather than none. This may be due to a new Raku design decision / roast improvement / trap introduced since this answer was last edited (in 2017), or a Rakudo bug. I'm not going to investigate; I just wanted to let readers know.]
Why your use of zip doesn't work
Your code assumes that [Z] ("reducing with the zip operator") can be used to get the transpose of a list-of-lists.
Unfortunately, this doesn't work in the general case.
It 'usually' works, but breaks on one edge case: Namely, when the list-of-lists is a list of exactly one list. Observe:
my #a = <a b c>, <1 2 3>, <X Y Z>; put [Z~] #a; # a1X b2Y c3Z
my #a = <a b c>, <1 2 3>; put [Z~] #a; # a1 b2 c3
my #a = <a b c>,; put [Z~] #a; # abc
my #a; put [Z~] #a; # abc <-- 2022 update
In the first two examples (3 and 2 sub-lists), you can see that the transpose of #a was returned just fine. The fourth example (0 sub-lists) does the right thing as well.
But the third example (1 sub-list) didn't print a b c as one would expect, i.e. it didn't return the transpose of #a in that case, but rather (it seems) the transpose of #a[0].
Sadly, this is not a Rakudo bug (in which case it could simply be fixed), but an unforseen interaction of two Perl 6 design decisions, namely:
The reduce meta-operator [ ] handles an input list with a single element by calling the operator it's applied to with one argument (said element).
In case you're wondering, an infix operator can be called with only one argument by invoking its function object: &infix:<Z>( <a b c>, ).
The zip operator Z and function zip (like other built-ins that accept nested lists), follows the so-called "single-argument rule" – i.e. its signature uses a single-argument slurpy parameter. This means that when it is called with a single argument, it will descend into it and consider its elements the actual arguments to use. (See also Slurpy conventions.)
So zip(<a b c>,) is treated as zip("a", "b", "c").
Both features provide some nice convenience in many other cases, but in this case their interaction regrettably poses a trap.
How to make it work with zip
You could check the number of elements of #arrs, and special-case the "exactly 1 sub-list" case:
my #arrs = #results.map({ gather generate(%eqs, $_) });
if #arrs.elems == 1 {
.take for #arrs[0][];
}
else {
.take for flat [Z] #arrs
}
The [] is a "zen slice" - it returns the list unchanged, but without the item container that the parent Array wrapped it in. This is needed because the for loop would consider anything wrapped in an item container as a single item and only do one iteration.
Of course, this if-else solution is not very elegant, which probably negates your reason for trying to use zip in the first place.
How to write the code more elegantly without zip
Refer to Christoph's answer.
It might be possible with a Z, but for my poor little brain, zipping recursively generated lazy lists is too much.
Instead, I did some other simplifications:
sub generate($s, %eqs) {
take $s;
# the given equations normalize the string, ie there's no need to apply
# the inverse relation
for %eqs.kv -> $k, $v {
# make copy of $s so we can use s/// instead of .subst
my $t = $s;
generate $t, %eqs
if $t ~~ s/$k/$v/;
}
}
sub table(#G, %eqs) {
# compute the set only once instead of implicitly on each call to (elem)
my $G = set #G;
# some code golfing
put ['', |#G]>>.fmt('%-5s|').join;
put '-----|' x #G + 1;
for #G -> $x {
printf '%-5s|', $x;
for #G -> $y {
printf '%-5s|', (gather generate("$x$y", %eqs)).first(* (elem) $G);
}
put '';
}
}
my #G = <e a b bb bbb ab abb abbb>;
# use double brackets so we can have empty strings
my %eqs = <<aa e bbbb e ba abbb e ''>>;
table #G, %eqs;
Here is a compact rewrite of generate that does bidirectional substitution, still without an explicit zip:
sub generate($s, %eqs) {
my #results = do for |%eqs.pairs, |%eqs.antipairs -> (:$key, :$value) {
take $s.subst($key, $value) if $s ~~ /$key/;
}
my #seqs = #results.map: { gather generate($_, %eqs) }
for 0..* -> $i { take .[$i] for #seqs }
}
Here's a version of generate that uses the approach demonstrated by smls:
sub generate(%eqs, $s)
{
my #results = ();
for %eqs.kv -> $key, $val {
if $s ~~ /$key/ { #results.push($s.subst(/$key/, $val)); }
if $s ~~ /$val/ { #results.push($s.subst(/$val/, $key)); }
}
for #results -> $result { take $result; }
my #arrs = #results.map({ gather generate(%eqs, $_) });
if #arrs.elems == 1 { .take for #arrs[0][]; }
else { .take for flat [Z] #arrs; }
}
I've tested it and it works on exercises 2 and 3.
As smls mentions in his answer, zip doesn't do what we were expecting when the given array of arrays only contains a single array. So, let's make a version of zip which does work with one or more arrays:
sub zip-many (#arrs)
{
if #arrs.elems == 1 { .take for #arrs[0][]; }
else { .take for flat [Z] #arrs; }
}
And now, generate in terms of zip-many:
sub generate(%eqs, $s)
{
my #results = ();
for %eqs.kv -> $key, $val {
if $s ~~ /$key/ { #results.push($s.subst(/$key/, $val)); }
if $s ~~ /$val/ { #results.push($s.subst(/$val/, $key)); }
}
for #results -> $result { take $result; }
zip-many #results.map({ gather generate(%eqs, $_) });
}
That looks pretty good.
Thanks smls!
smls suggests in a comment below that zip-many not invoke take, leaving that to generate. Let's also move flat from zip-many to generate.
The slimmed down zip-many:
sub zip-many (#arrs) { #arrs == 1 ?? #arrs[0][] !! [Z] #arrs }
And the generate to go along with it:
sub generate(%eqs, $s)
{
my #results;
for %eqs.kv -> $key, $val {
if $s ~~ /$key/ { #results.push($s.subst(/$key/, $val)); }
if $s ~~ /$val/ { #results.push($s.subst(/$val/, $key)); }
}
.take for #results;
.take for flat zip-many #results.map({ gather generate(%eqs, $_) });
}
Testing the keys and values separately seems a bit silly; your strings aren't really regexes, so there's no need for // anywhere in your code.
sub generate($s, #eqs) {
my #results = do for #eqs.kv -> $i, $equation {
take $s.subst($equation, #eqs[ $i +^ 1 ]) if $s.index: $equation
}
my #seqs = #results.map: { gather generate($_, #eqs) }
for 0..* -> $i { take .[$i] for #seqs }
}
Obviously with this version of generate you'll have to rewrite table to use #eqs instead of %eqs.