3.days.ago implementation in Perl6 - raku

I want to implement a time calculation like 3.days.ago and 2.months.from_now.
Is is possible to extend method to Int, or operator overriding can do this?
1.day.ago # equivalent to yesterday
1.day.from_now # equivalent to tomorrow

To get exactly what you are asking for:
use MONKEY-TYPING;
augment class Int {
my class Date::Offset {
has Pair $.offset is required;
method ago () {
Date.today.earlier( |$!offset )
}
method from-now () {
Date.today.later( |$!offset )
}
}
method days () {
Date::Offset.new( offset => days => self );
}
method months () {
Date::Offset.new( offset => months => self );
}
}
say 1.days.ago; # 2017-03-13
say Date.today; # 2017-03-14
say 1.days.from-now; # 2017-03-15
say 1.months.ago; # 2017-02-14
Now that I've shown you how, please don't. You may end up affecting code that you didn't intend to, in a way that is very hard to troubleshoot.
(There are legitimate reasons to do something like that, but I don't think this is one of them)
If you want to mess with how basic operations happen, do it lexically.
{
sub postfix:« .days.ago » ( Int:D $offset ) {
Date.today.earlier( days => $offset )
}
sub postfix:« .days.from-now » ( Int:D $offset ) {
Date.today.later( days => $offset )
}
sub postfix:« .months.ago » ( Int:D $offset ) {
Date.today.earlier( months => $offset )
}
sub postfix:« .months.from-now » ( Int:D $offset ) {
Date.today.later( months => $offset )
}
say 1.days.ago; # 2017-03-13
say Date.today; # 2017-03-14
say 1.days.from-now; # 2017-03-15
say 1.months.ago; # 2017-02-14
}
say 1.days.ago; # error

The basic way to extend an existing class, is to augment it:
use MONKEY-TYPING;
augment class Int {
method day() { "day" }
}
say 42.day
From there you can have the "day" method create an object that can handle the "ago" and "from_now" methods.
Mind you, it appears though you would need to think a bit about your API: in the first line, 1.day appears to refer to today, whereas in the second line only the "from_now" seems to have that functionality.
Please note that at the moment, subclasses don't know about superclasses being augmented: this is a known issue. The only way around that at the moment is to re-compose the subclasses you need after augmenting their superclass:
use MONKEY-TYPING;
augment class Cool { # Int is a subclass of Cool
method day() { "day" }
}
BEGIN Int.^compose; # make sure Int knows about ".day"
say 42.day

It might be fun to use MONKEY-TYPING, but if you really just want to calculate dates, then please just use the built-in Date object:
put Date.today; # 2017-03-23
put Date.today.earlier(day=>3); # 2017-03-20
put Date.today.later(month=>3); # 2017-06-23
(I know about trying clever syntax, but am glad to have been talked out of it).

Related

How can I implement 2d subscripts via AT-POS for different classes?

here is an MRE (showing two attempts, with debug left in to be helpful) to try and get 2d subscripting working with AT-POS across a DataFrame that has columns of Series...
class Series does Positional {
has Real #.data = [0.1,0.2,0.3];
method AT-POS( $p ) {
#!data[$p]
}
}
class DataFrame does Positional {
has Series #.series;
#`[ ATTEMPT #1
method AT-POS( $p, $q? ) {
given $q {
when Int { #say 'Int';
#!series[$p][$q]
}
when Whatever { #say '*';
#!series[$p].data
}
default { #say 'default';
#!series[$p]
}
}
}
#]
# ATTEMPT #2
method AT-POS(|c) is raw { #`[dd c;] #!series.AT-POS(|c) }
}
my $df = DataFrame.new( series => [Series.new xx 3] );
say $df[1].data; #[0.1 0.2 0.3]
say $df[1][2]; #0.3
say $df[0,1]; #(Series.new(data => $[0.1, 0.2, 0.3]) Series.new(data => $[0.1, 0.2, 0.3]))
say $df[1;2]; #0.3
say $df[1;*]; #got (0.1) ... expected [0.1 0.2 0.3]
say $df[*;1]; #got (0.2) ... wanted [0.2 0.2 0.2]
I already researched on SO and found three related questions here, here and here ... and the attempt #2 in my code seeks to apply #lizmats Answer to the third one. Encouragingly both the attempts in my MRE have the same behaviour. But I cannot workout
why the when Whatever {} option is not entered (attempt #1)
what the |c is doing - even though I can see that it works in the single subscript case (attempt #2)
I have done some experimenting with multi postcircumfix:<[ ]>( DataFrame:D $df, #slicer where Range|List ) is export {} but this seems to overcomplicate matters.
==================
Great answer from #jonathan building on the original from #Lizmat - thanks! Here is the final, working code:
class Series does Positional {
has Real #.data = [0.1,0.2,0.3];
method elems {
#!data.elems
}
method AT-POS( |p ) is raw {
#!data.AT-POS( |p )
}
}
class DataFrame does Positional {
has Series #.series;
method elems {
#!series.elems
}
method AT-POS( |p ) is raw {
#!series.AT-POS( |p )
}
}
my $df = DataFrame.new( series => Series.new xx 3 );
say $df[1].data; #[0.1 0.2 0.3]
say $df[1][2]; #0.3
say $df[0,1]; #(Series.new(data => $[0.1, 0.2, 0.3]) Series.new(data => $[0.1, 0.2, 0.3]))
say $df[1;2]; #0.3
say $df[1;*]; #(0.1 0.2 0.3)
say $df[*;1]; #(0.2 0.2 0.2)
The AT-POS method is only ever passed integer array indices.
The logic to handle slicing (with *, ranges, other iterables, the zen slice) is located in the array indexing operator, which is implemented as the multiple-dispatch subroutine postcircumfix:<[ ]> for single-dimension indexing and postcircumfix:<[; ]> for multi-dimension indexing. The idea is that a class that wants to act as an array-alike need not worry about re-implementing all of the slicing behavior and, further, that the slicing behavior will behave consistently over different user-defined types.
For slicing to work, one must implement elems as well as AT-POS. Adding:
method elems() { #!data.elems }
Is Series and:
method elems() { #!series.elems }
In DataFrame gives the results you're looking for.
If one really wants different slicing semantics, or a far more efficient implementation than the standard one is possible, one can also add multi candidates for the indexing operator (remembering to mark them is export).
This answer is simply an elaboration of the point #raiph made in a comment:
You may be able to simplify the code by using handles
Indeed you can – so much so that I thought it was worth showing what that would look like in a code block without a comment's formatting limits.
Using handles, you can simplify each of the two classes from 9 non-whitespace lines to 3:
class Series does Positional {
has Real #.data handles <elems AT-POS> = [0.1,0.2,0.3];
}
class DataFrame does Positional {
has Series #.series handles <elems AT-POS>;
}
(or you could even have each class on 1 line, if you format them the way I'd be tempted to.)
This code produces all the same results to the say statements from the code in the question.

Raku Ambiguous call to infix(Hyper: Dan::Series, Int)

I am writing a model Series class (kinda like the one in pandas) - and it should be both Positional and Associative.
class Series does Positional does Iterable does Associative {
has Array $.data is required;
has Array $.index;
### Construction ###
method TWEAK {
# sort out data-index dependencies
$!index = gather {
my $i = 0;
for |$!data -> $d {
take ( $!index[$i++] => $d )
}
}.Array
}
### Output ###
method Str {
$!index
}
### Role Support ###
# Positional role support
# viz. https://docs.raku.org/type/Positional
method of {
Mu
}
method elems {
$!data.elems
}
method AT-POS( $p ) {
$!data[$p]
}
method EXISTS-POS( $p ) {
0 <= $p < $!data.elems ?? True !! False
}
# Iterable role support
# viz. https://docs.raku.org/type/Iterable
method iterator {
$!data.iterator
}
method flat {
$!data.flat
}
method lazy {
$!data.lazy
}
method hyper {
$!data.hyper
}
# Associative role support
# viz. https://docs.raku.org/type/Associative
method keyof {
Str(Any)
}
method AT-KEY( $k ) {
for |$!index -> $p {
return $p.value if $p.key ~~ $k
}
}
method EXISTS-KEY( $k ) {
for |$!index -> $p {
return True if $p.key ~~ $k
}
}
#`[ solution attempt #1 does NOT get called
multi method infix(Hyper: Series, Int) is default {
die "I was called"
}
#]
}
my $s = Series.new(data => [rand xx 5], index => [<a b c d e>]);
say ~$s;
say $s[2];
say $s<b>;
So far pretty darn cool.
I can go dd $s.hyper and get this
HyperSeq.new(configuration => HyperConfiguration.new(batch => 64, degree => 1))
BUT (there had to be a but coming), I want to be able to do hyper math on my Series' elements, something like:
say $s >>+>> 2;
But that yields:
Ambiguous call to 'infix(Hyper: Dan::Series, Int)'; these signatures all match:
(Hyper: Associative:D \left, \right, *%_)
(Hyper: Positional:D \left, \right, *%_)
in block <unit> at ./synopsis-dan.raku line 63
How can I tell my class Series not to offer the Associative hyper candidate...?
Note: edited example to be a runnable MRE per #raiph's comment ... I have thus left in the minimum requirements for the 3 roles in play per docs.raku.org
After some experimentation (and new directions to consider from the very helpful comments to this SO along the way), I think I have found a solution:
drop the does Associative role from the class declaration like this:
class Series does Positional does Iterable {...}
BUT
leave the Associative role support methods in the body of the class:
# Associative role support
# viz. https://docs.raku.org/type/Associative
method keyof {
Str(Any)
}
method AT-KEY( $k ) {
for |$!index -> $p {
return $p.value if $p.key ~~ $k
}
}
method EXISTS-KEY( $k ) {
for |$!index -> $p {
return True if $p.key ~~ $k
}
}
This gives me the Positional and Associative accessors, and functional hyper math operators:
my $s = Series.new(data => [rand xx 5], index => [<a b c d e>]);
say ~$s; #([a => 0.6137271559776396 b => 0.7942959887386045 c => 0.5768018697817604 d => 0.8964323560788711 e => 0.025740150933493577] , dtype: Num)
say $s[2]; #0.7942959887386045
say $s<b>; #0.5768018697817604
say $s >>+>> 2; #(2.6137271559776396 2.7942959887386047 2.5768018697817605 2.896432356078871 2.0257401509334936)
While this feels a bit thin (and probably lacks the full set of Associative functions) I am fairly confident that the basic methods will give me slimmed down access like a hash from a key capability that I seek. And it no longer creates the ambiguous call.
This solution may be cheating a bit in that I know the level of compromise that I will accept ;-).
Take #1
First, an MRE with an emphasis on the M1:
class foo does Positional does Associative { method of {} }
sub infix:<baz> (\l,\r) { say 'baz' }
foo.new >>baz>> 42;
yields:
Ambiguous call to 'infix(Hyper: foo, Int)'; these signatures all match:
(Hyper: Associative:D \left, \right, *%_)
(Hyper: Positional:D \left, \right, *%_)
in block <unit> at ./synopsis-dan.raku line 63
The error message shows it's A) a call to a method named infix with an invocant matching Hyper, and B) there are two methods that potentially match that call.
Given that there's no class Hyper in your MRE, these methods and the Hyper class must be either built-ins or internal details that are leaking out.
A search of the doc finds no such class. So Hyper is undocumented Given that the doc has fairly broad coverage these days, this suggests Hyper is an internal detail. But regardless, it looks like you can't solve your problem using official/documented features.
Hopefully this bad news is still better than none.2
Take #2
Where's the fun in letting little details like "not an official feature" stop us doing what we want to do?
There's a core.c module named Hyper.pm6 in the Rakudo source repo.
A few seconds browsing that, and clicks on its History and Blame, and I can instantly see it really is time for me to conclude this SO answer, with a recommendation for your next move.
To wit, I suggest you start another SO, using this answer as its heart (but reversing my presentation order, ie starting by mentioning Hyper, and that it's not doc'd), and namechecking Liz (per Hyper's History/Blame), with a link back to your Q here as its background. I'm pretty sure that will get you a good answer, or at least an authoritative one.
Footnotes
1 I also tried this:
class foo does Positional does Associative { method of {} }
sub postfix:<bar>(\arg) { say 'bar' }
foo.new>>bar;
but that worked (displayed bar).
2 If you didn't get to my Take #1 conclusion yourself, perhaps that was was because your MRE wasn't very M? If you did arrive at the same point (cf "solution attempt #1 does NOT get called" in your MRE) then please read and, for future SOs, take to heart, the wisdom of "Explain ... any difficulties that have prevented you from solving it yourself".

(Identifier) terms vs. constants vs. null signature routines

Identifier terms are defined in the documentation alongside constants, with pretty much the same use case, although terms compute their value in run time while constants get it in compile time. Potentially, that could make terms use global variables, but that's action at a distance and ugly, so I guess that's not their use case.
OTOH, they could be simply routines with null signature:
sub term:<þor> { "Is mighty" }
sub Þor { "Is mighty" }
say þor, Þor;
But you can already define routines with null signature. You can sabe, however, the error when you write:
say Þor ~ Þor;
Which would produce a many positionals passed; expected 0 arguments but got 1, unlike the term. That seems however a bit farfetched and you can save the trouble by just adding () at the end.
Another possible use case is defying the rules of normal identifiers
sub term:<✔> { True }
say ✔; # True
Are there any other use cases I have missed?
Making zero-argument subs work as terms will break the possibility to post-declare subs, since finding a sub after having parsed usages of it would require re-parsing of earlier code (which the perl 6 language refuses to do, "one-pass parsing" and all that) if the sub takes no arguments.
Terms are useful in combination with the ternary operator:
$ perl6 -e 'sub a() { "foo" }; say 42 ?? a !! 666'
===SORRY!=== Error while compiling -e
Your !! was gobbled by the expression in the middle; please parenthesize
$ perl6 -e 'sub term:<a> { "foo" }; say 42 ?? a !! 666'
foo
Constants are basically terms. So of course they are grouped together.
constant foo = 12;
say foo;
constant term:<bar> = 36;
say bar;
There is a slight difference because term:<…> works by modifying the parser. So it takes precedence.
constant fubar = 38;
constant term:<fubar> = 45;
say fubar; # 45
The above will print 45 regardless of which constant definition comes first.
Since term:<…> takes precedence the only way to get at the other value is to use ::<fubar> to directly access the symbol table.
say ::<fubar>; # 38
say ::<term:<fubar>>; # 45
There are two main use-cases for term:<…>.
One is to get a subroutine to be parsed similarly to a constant or sigilless variable.
sub fubar () { 'fubar'.comb.roll }
# say( fubar( prefix:<~>( 4 ) ) );
say fubar ~ 4; # ERROR
sub term:<fubar> () { 'fubar'.comb.roll }
# say( infix:<~>( fubar, 4 ) );
say fubar ~ 4;
The other is to have a constant or sigiless variable be something other than an a normal identifier.
my \✔ = True; # ERROR: Malformed my
my \term:<✔> = True;
say ✔;
Of course both use-cases can be combined.
sub term:<✔> () { True }
Perl 5 allows subroutines to have an empty prototype (different than a signature) which will alter how it gets parsed. The main purpose of prototypes in Perl 5 is to alter how the code gets parsed.
use v5;
sub fubar () { ord [split('','fubar')]->[rand 5] }
# say( fubar() + 4 );
say fubar + 4; # infix +
use v5;
sub fubar { ord [split('','fubar')]->[rand 5] }
# say( fubar( +4 ) );
say fubar + 4; # prefix +
Perl 6 doesn't use signatures the way Perl 5 uses prototypes. The main way to alter how Perl 6 parses code is by using the namespace.
use v6;
sub fubar ( $_ ) { .comb.roll }
sub term:<fubar> () { 'fubar'.comb.roll }
say fubar( 'zoo' ); # `z` or `o` (`o` is twice as likely)
say fubar; # `f` or `u` or `b` or `a` or `r`
sub prefix:<✔> ( $_ ) { "checked $_" }
say ✔ 'under the bed'; # checked under the bed
Note that Perl 5 doesn't really have constants, they are just subroutines with an empty prototype.
use v5;
use constant foo => 12;
use v5;
sub foo () { 12 } # ditto
(This became less true after 5.16)
As far as I know all of the other uses of prototypes have been superseded by design decisions in Perl 6.
use v5;
sub foo (&$) { $_[0]->($_[1]) }
say foo { 100 + $_[0] } 5; # 105;
That block is seen as a sub lambda because of the prototype of the foo subroutine.
use v6;
# sub foo ( &f, $v ) { f $v }
sub foo { #_[0].( #_[1] ) }
say foo { 100 + #_[0] }, 5; # 105
In Perl 6 a block is seen as a lambda if a term is expected. So there is no need to alter the parser with a feature like a prototype.
You are asking for exactly one use of prototypes to be brought back even though there is already a feature that covers that use-case.
Doing so would be a special-case. Part of the design ethos of Perl 6 is to limit the number of special-cases.
Other versions of Perl had a wide variety of special-cases, and it isn't always easy to remember them all.
Don't get me wrong; the special-cases in Perl 5 are useful, but Perl 6 has for the most part made them general-cases.

Assigning values to attributes in the BUILD phaser for an object

When a BUILD phaser is called, it overrides default attribute assignment in Perl6. Suppose we have to use that BUILD phaser, like we do in this module (that's where I met this problem). What's the way of assigning values to attributes in that phase?
I have used this
class my-class {
has $.dash-attribute;
submethod BUILD(*%args) {
for %args.kv -> $k, $value {
self."$k"( $value );
}
}
};
my $my-instance = my-class.new( dash-attribute => 'This is the attribute' );
And I get this error
Too many positionals passed; expected 1 argument but got 2
Other combinations of $!or $., direct assignment, declaring the attribute as rw (same error) yield different kind of errors. This is probably just a syntax issue, but I couldn't find the solution. Any help will be appreciated.
There are two things wrong in your example, the way I see it. First of all, if you want an attribute to be writeable, you will need to mark it is rw. Secondly, changing the value of an attribute is done by assignment, rather than by giving the new value as an argument.
So I think the code should be:
class my-class {
has $.dash-attribute is rw;
submethod BUILD(*%args) {
for %args.kv -> $k, $value {
self."$k"() = $value;
}
}
};
my $my-instance = my-class.new( dash-attribute => 'attribute value' );
dd $my-instance;
# my-class $my-instance = my-class.new(dash-attribute => "attribute value")
You could do it the same way the object system normally does it under the hood for you.
(not recommended)
class C {
has $.d;
submethod BUILD ( *%args ){
for self.^attributes {
my $short-name = .name.substr(2); # remove leading 「$!」
next unless %args{$short-name}:exists;
.set_value( self, %args{$short-name} )
}
}
}
say C.new(d => 42)
C.new(d => 42)

How does one write custom accessor methods in Perl6?

How does one write custom accessor methods in Perl6?
If I have this class:
class Wizard {
has Int $.mana is rw;
}
I can do this:
my Wizard $gandalf .= new;
$gandalf.mana = 150;
Let's say I want to add a little check to a setter in my Perl6 class without giving up the $gandalf.mana = 150; notation (in other words, I don't want to write this: $gandalf.setMana(150);). The program should die, if it tries to set a negative mana. How do I do this? The Perl6 documentation just mentions it is possible to write custom accessors, but does not say how.
With more recent versions of Rakudo there is a subset named UInt that restricts it to positive values.
class Wizard {
has UInt $.mana is rw;
}
So that you're not stuck in a lurch if you need to something like this; here is how that is defined:
( you can leave off the my, but I wanted to show you the actual line from the Rakudo source )
my subset UInt of Int where * >= 0;
You could also do this:
class Wizard {
has Int $.mana is rw where * >= 0;
}
I would like to point out that the * >= 0 in the where constraint is just a short way to create a Callable.
You could have any of the following as a where constraint:
... where &subroutine # a subroutine that returns a true value for positive values
... where { $_ >= 0 }
... where -> $a { $a >= 0 }
... where { $^a >= 0 }
... where $_ >= 0 # statements also work ( 「$_」 is set to the value it's testing )
( If you wanted it to just not be zero you could also use ... where &prefix:<?> which is probably better spelled as ... where ?* or ... where * !== 0 )
If you feel like being annoying to people using your code you could also do this.
class Wizard {
has UInt $.mana is rw where Bool.pick; # accepts changes randomly
}
If you want to make sure the value "makes sense" when looking at all of the values in the class in aggregate, you will have to go to a lot more work.
( It may require a lot more knowledge of the implementation as well )
class Wizard {
has Int $.mana; # use . instead of ! for better `.perl` representation
# overwrite the method the attribute declaration added
method mana () is rw {
Proxy.new(
FETCH => -> $ { $!mana },
STORE => -> $, Int $new {
die 'invalid mana' unless $new >= 0; # placeholder for a better error
$!mana = $new
}
)
}
}
You can get the same accessor interface that saying $.mana provides by declaring a method is rw. Then you can wrap a proxy around the underlying attribute like so:
#!/usr/bin/env perl6
use v6;
use Test;
plan 2;
class Wizard {
has Int $!mana;
method mana() is rw {
return Proxy.new:
FETCH => sub ($) { return $!mana },
STORE => sub ($, $mana) {
die "It's over 9000!" if ($mana // 0) > 9000;
$!mana = $mana;
}
}
}
my Wizard $gandalf .= new;
$gandalf.mana = 150;
ok $gandalf.mana == 150, 'Updating mana works';
throws_like sub {
$gandalf.mana = 9001;
}, X::AdHoc, 'Too much mana is too much';
Proxy is basically a way to intercept read and write calls to storage and do something other than the default behavior. As their capitalization suggests, FETCH and STORE are called automatically by Perl to resolve expressions like $gandalf.mana = $gandalf.mana + 5.
There's a fuller discussion, including whether you should even attempt this, at PerlMonks. I would recommend against the above -- and public rw attributes in general. It's more a display of what it is possible to express in the language than a useful tool.