I'm attempting to implement a class that 'does' Positional that also allows me to update its values by assigning to the result returned by the AT-POS method. Eventually, I was able to concoct the following class that works as intended:
class Test does Positional
{
has $.slot_1 is rw = 12;
has $.slot_2 is rw = 24;
method AT-POS(\position)
{
my $t = self;
return-rw Proxy.new:
FETCH => method ()
{
position % 2 ?? $t.slot_1 !! $t.slot_2
},
STORE => method ($v)
{
if position % 2
{
$t.slot_1 = $v
}
else
{
$t.slot_2 = $v
}
}
}
}
my $test = Test.new;
die unless $test[2] == 24;
die unless $test[5] == 12;
$test[7] = 120;
die unless $test[2] == 24;
die unless $test[5] == 120;
$test[10] = 240;
die unless $test[2] == 240;
die unless $test[5] == 120;
Would it be possible to somehow (and: simply) return the container bound to $!slot_1 (or $!slot_2) inside the Test class implementation?
Before I discovered the use of Proxy instances I attempted to return (and return-rw) the result of expression position % 2 ?? $!slot_1.VAR !! $!slot_2.VAR, because I'm under the impression that the VAR method gives me access to the underlying container, in the hope that I can simply return it. That didn't really work, and I do not understand why yet: I suspect it somehow gets coerced back to a value somehow?
So in other words: is it possible to simplify my AT-POS implementation in this particular situation?
Thanks,
Regards,
Raymond.
Assuming you do not want accessors for "slot_1" and "slot_2", and if I understand the question correctly, this would be my implementation. I wouldn't call it a Test class, as that would interfere with the Test class that is used for testing.
class Foo {
has #elements = 24, 12;
method AT-POS(Int:D $pos) is raw {
#elements[$pos % 2]
}
}
my $f = Foo.new;
say $f[2]; # 24
say $f[5]; # 12
$f[2] = 666;
say $f[4]; # 666
Note that the defaults in the array have changed order, that's to keep the arithmetic in AT-POS simple.
Also note the is raw in the definition of the AT-POS method: it will ensure that no de-containerization will take place when returning a value. This allows you to just assign to whatever $f[2] returns.
Hope this made sense!
Also: the Array::Agnostic module may be of interest for you, to use directly, or to use as a source of inspiration.
First off if you aren't going to use an attribute outside of the object, there isn't a reason to declare them as public, and especially not rw.
class Foo {
has $!odd = 12;
has $!even = 24;
…
}
You can also directly return a Scalar container from a method. You should declare the method as rw or raw. (raw doesn't guarantee that it is writable.)
class Foo {
has $!odd = 12;
has $!even = 24;
method AT-POS(\position) is rw {
position % 2 ?? $!odd !! $!even
}
}
# we actually get the Scalar container given to us
say Foo.new[10].VAR.name; # $!even
Note that even if you declare the attributes as public they still have a private name. The private attribute is always rw even if it isn't publicly declared as rw.
class Foo {
has $.odd = 12;
has $.even = 24;
method AT-POS(\position) is rw {
position % 2 ?? $!odd !! $!even
}
}
If you are going to use a Proxy, I would consider moving the common code outside of it.
class Foo {
has $.odd = 12;
has $.even = 24;
method AT-POS(\position) is rw {
# no need to write this twice
my $alias := (position % 2 ?? $!odd !! $!even);
Proxy.new:
FETCH => method () { $alias },
STORE => method ($new-value) { $alias = $new-value }
}
}
Of course the ?? !! code is a core feature of this module, so it would make sense to put it into a single method so that you don't end up with duplicate code all over your class. In this case I made it a private method.
class Foo {
has $.odd = 12;
has $.even = 24;
# has to be either `raw` or `rw`
# it is debatable of which is better here
method !attr(\position) is raw {
position % 2 ?? $!odd !! $!even
}
method AT-POS(\position) is rw {
my $alias := self!attr(position);
Proxy.new:
FETCH => -> $ { $alias },
STORE => -> $, $new-value { $alias = $new-value }
}
}
Again, not much reason to use a Proxy.
class Foo {
has $.odd = 12;
has $.even = 24;
method !attr(\position) is raw {
position % 2 ?? $!odd !! $!even
}
method AT-POS(\position) is rw {
self!attr(position);
}
}
Instead of ?? !! you could use an indexing operation.
method !attr(\position) is raw {
($!even,$!odd)[position % 2]
}
Which would allow for a ternary data structure.
method !attr(\position) is raw {
($!mod0,$!mod1,$!mod2)[position % 3]
}
There was no need to write the if statement that you did as Raku usually passes Scalar containers around instead of the value.
(position % 2 ?? $t.slot_1 !! $t.slot_2) = $v;
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.
Any suggestion how to create a conditional mixin based on parameter existence?
For example I need to to verify that all the parameters are passed in order to perform something or not, for example:
.margin (#margintop:0,#marginbottom:0,#marginright:0,#marginleft:0) {
// if #marginright:0 or #marginleft:0 are passed do that...
// else...
}
1:
In general, when you need to generate different things for different number of arguments passed you don't need to use default argument values at all, e.g.:
.margin(#top, #bottom, #right, #left) {
/* right and left are passed */
}
.margin(#top, #bottom) {
/* right and left are not passed */
}
.margin() {
/* no arguments passed */
}
// etc.
Note that each of these mixins can reuse the others, for example .margin(#top, #bottom) can do something special for the "no right and left case" and then call .margin(#top, #bottom, 0, 0) to perform the main job.
2:
But if you still need these defaults for some reason you can use some special default value that can't be a valid margin, e.g. something like this:
.margin(#top: undefined, #bottom: undefined, #right: undefined, #left: undefined) {
.test-args();
.test-args() when (#right = undefined) {
/* right is not passed */
}
.test-args() when (#left = undefined) {
/* left is not passed */
}
.test-args()
when not(#right = undefined)
and not(#left = undefined) {
/* right and left are passed */
}
// etc.
}
3:
And the third option would be to use variadic arguments and test their count, but this one is the most verbose and dumb I guess:
.margin(#args...) {
.eval-args(length(#args)); // requires LESS 1.5.+
.eval-args(#nargs) {
// default values:
#top: not passed;
#bottom: not passed;
#right: not passed;
#left: not passed;
}
.eval-args(#nargs) when (#nargs > 0) {
#top: extract(#args, 1);
}
.eval-args(#nargs) when (#nargs > 1) {
#bottom: extract(#args, 2);
}
.eval-args(#nargs) when (#nargs > 2) {
#right: extract(#args, 3);
}
.eval-args(#nargs) when (#nargs > 3) {
#left: extract(#args, 4);
}
args: #top, #bottom, #right, #left;
}
Though it may probably have its pros in some special use-cases.
I'm having trouble writing a nested block. Say I want a block that takes and integer. That block returns a block that takes another integer, and returns the sum of the two integers. I haven't had any luck writing this out. Here's one try, which is no worse than any other of mine:
(int ^(int)) (^bblock)(int) = ^(int a) {
return ^(int b){ return a + b; };
};
Can anybody spot what's wrong?
Quite ugly, but you can do it using parenthesis instead of typedefs:
int (^(^functor)(int))(int) = ^(int a) {
return Block_copy(^(int b) {
return a + b;
});
};