Recursive Cinderella

PWC 184 asked to split an array into numbers and letters.

for ( 'a 1 2 b 0', '3 c 4 d'), ( '1 2', 'p q r', 's 3', '4 5 t') -> @a is copy {
    @a.=map: *.split(' ').cache;
    my @numbers = @a.deepmap({ / <[0..9]> / ?? .Numeric !! Empty }).grep(+*)».Array;
    my @letters = @a.deepmap({ / <[a..z]> / ?? .Str !! Empty }).grep(+*)».Array;
    say @numbers, ‘ and ’, @letters;
}

I use deepmap with Empty to separate to weed from the chaff and remove the extra structure added by deepmap with a grep. That extra structure raised the question, what would be needed to split a tree in twain. This could be useful to gain parts of a XML Document with a single parser pass, while maintaining the structure of the tree. Relation of child nodes and parent nodes often carries meaning.

for ( 'a 1 2 b 0', '3 c 4 d'), ( '1 2', 'p q r', 's 3', '4 5 t'), [ '1', [ [ 'a' ], '2 b'], '3 c' ] -> @a is copy {

    multi sub cinderella(@data, @a, $needle-a, @b, $needle-b) {
        for @data {
            @a[$++] := my $new-a;
            @b[$++] := my $new-b;
            cinderella($_, $new-a, $needle-a, $new-b, $needle-b)
        }
    }

    multi sub cinderella(@data, Any:U $a is raw, $needle-a, Any:U $b is raw, $needle-b) {
        my @new-a;
        my @new-b;
        for @data {
            cinderella($_, $a, $needle-a, $b, $needle-b);
            @new-a.push: $a;
            @new-b.push: $b;
        }
        $a = @new-a;
        $b = @new-b;
    }

    multi sub cinderella(Str:D $s, $a is raw, $needle-a, $b is raw, $needle-b) {
        cinderella($_, my @new-a, $needle-a, my @new-b, $needle-b) for $s.split(' ');
        $a = @new-a ?? @new-a.join(' ') !! Empty;
        $b = @new-b ?? @new-b.join(' ') !! Empty;
    }

    multi sub cinderella(Str:D $s where *.chars == 1, @a, $needle-a, @b, $needle-b) {
        given $s {
            when $needle-a { @a.push: $s }
            when $needle-b { @b.push: $s }
            default { fail('dunno where to put: ' ~ $s) }
        }
    }

    cinderella @a, my @numbers, / <[0..9]> /, my @letters, / <[a..z]> /;

    dd @numbers, @letters;
}


# OUTPUT: Array @numbers = ["1 2 0", "3 4"]
          Array @letters = ["a b", "c d"]
          Array @numbers = ["1 2", Empty, "3", "4 5"]
          Array @letters = [Empty, "p q r", "s", "t"]
          Array @numbers = ["1", [[[],], "2"], "3"]
          Array @letters = [[], [["a"], "b"], "c"]

The leaves in the target tree can be either a Str or (empty) Array. However, the first multi candidate doesn’t make the decision what item is added to the target Arrays. Instead I create a fresh scalar container and bind it to a container within the Arrays. I then pass that container on to the next multi-candidate where it might be filled with Positional– or Str-object. Please note the distinction. MMD doesn’t care about the container type we use, it looks for the properties of the value. This allows me to split the strings on a white space and pass it on into the next round of MMD matches. The 2nd candidate handles the case where we descent into a nested Array. It can manipulate the scalar container created with @a[$++] := my $new-a; and turn it into a Positional value (here an Array), because that initial container is pass into the multi with is raw.

This is a very powerful concept. Writing the same with a single recursive function would contain a lot of special casing and be no join to debug.

Not doing what the instructor asked for seems to produce better results. I shall do so more often.

Rabbitholeing

With PWC 182-2 specifically asking for Linux paths to be handled, we need to resolve issues like /../ and symbolic links. Since I didn’t feel like putting a directory called a into my root folder, I wrote a little helper that deals with some of the tripwires that modern filesystems provide.

my @input = qw <
    /a/b/c/1/x.pl
    /a/b/c/d/e/2/x.pl
    /a/b//c/d/3/x.pl
    /a/b/./c/4/x.pl
    /a/../a/b/c/d/5/x.pl
>;

sub resolve(Str:D() $s){
    my @parent-refs = (my @parts = $s.split(rx{ ‘/./’ | ‘/’+ })).pairs.grep(*.value eq '..')».key;
    @parent-refs = flat @parent-refs, @parent-refs »-» 1;
    @parts[@parent-refs]:delete;
    @parts.join(‘/’)
}

# OUTPUT: /a/b/c/1/x.pl /a/b/c/d/e/2/x.pl /a/b/c/d/3/x.pl /a/b/c/4/x.pl ///a/b/c/d/5/x.pl

The last path starts with a triple root, because join assumes holes are actually there. It won’t skip fields that are Empty either, so is default(Empty) doesn’t help. To actually remove elements from an Array we are better of with splice. Since this method doesn’t return self, we can’t just @parts.splice(@parent-refs.any,1).join(‘/’). Both ways to remove elements are mutators and eager. That doesn’t fit well into the rest of the language and spells doom for concurrency. To find a solution I had to go down the rabbit hole that is iteration in Rakudo. The bottom happens to be located in Rakudo/Iterator.pm6.

method pull-one() is raw {
  nqp::ifnull(
    nqp::atpos($!reified,++$!i),
    nqp::if(
      nqp::islt_i($!i,nqp::elems($!reified)), # found a hole
        self!hole($!i),
        IterationEnd
      )
   )
}

So a hole in an Array is just a null-pointer in C-land — given that we didn’t overshoot the end of the Array. With that knowledge, building an Iterator that skips elements becomes rather simple.

multi sub prune(@a, Int:D $i --> Seq:D) {
    prune @a, $i .. $i
}

multi sub prune(@a, +@l is copy --> Seq:D) {
    @l = @l.sort; # this makes checking the index against the needles simpler

    Seq.new: class :: does Iterator {
        has int $!i;
        has $!reified;
        submethod !SET-SELF(\arr) {
            $!reified := nqp::getattr(@a,List,'$!reified');
            $!i = -1;
            self
        }
        method new(\arr) { nqp::create(self)!SET-SELF(arr) }
        method pull-one is raw {
            loop {
                ++$!i;
                if @l {
                    @l.shift while +@l && $!i > @l[0].max;
                    next if +@l && @l[0].min ≤ $!i ≤ @l[0].max;
                }
                return nqp::ifnull(
                    nqp::atpos($reified, $!i),
                    nqp::if(
                        nqp::isge_i($!i, nqp::elems($reified)),
                        IterationEnd,
                        next # we actually got a hole
                    )
                );
            }
        }
    }.new(@a)
}

@a = ('a' .. 'z').List;

dd @a.&prune( 25 );
dd @a.&prune( 10..15 );
dd @a.&prune( (2,3,10..15, 21..22, 25).pick(5) ); # randomising for testing
# OUTPUT: ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y").Seq
#         ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z").Seq
#         ("a", "b", "e", "f", "g", "h", "i", "j", "q", "r", "s", "t", "u", "x", "y").Seq

The idea is to loop by default and bail out of that loop if the current index held in $!i is not found in any needle. Since we don’t got real goto in Raku, loop/next becomes a decent substitute. As I don’t really understand what a unreified Array is, I’m right now not qualified to provide a PR.

Dealing with lazy and infinite lists makes Array a beast. I shall not falter until I have tamed it!

Valid temperatures

PWC 181 Task 2 asks for input validation of dates and numbers. OK, it should ask for input validation so my solution isn’t totally over the top. Better safe then sorry.

my $data = q:to/EOH/;
2022-08-01, 20
2022-08-09, 10
2022-08-03, 19
2022-08-06, 24
2022-08-05, 22
2022-08-10, 28
2022-08-07, 20
2022-08-04, 18
2022-08-08, 21
2022-08-02, 25
EOH

$data.lines()
==> map(* ~~ / $<date> = [ \d+ ‘-’ \d?\d ‘-’ \d?\d ] \s* ‘,’ \s* $<temperature> = [ '-'?\d+ [ '.' \d+ ]? ] /)
==> map(-> (Date(Str:D(Match)) :$date, Numeric(Str:D(Match)) :$temperature, *%) { [ $date, $temperature ] })
==> sort(*.first)
==> map( -> [$date, $temperature ] {
    state $last-temp;
    LEAVE $last-temp = $temperature;
    once next;
    „$date, Δ{abs $last-temp - $temperature}°C“ if $temperature > $last-temp;
})
==> -> *@a { @a.join($?NL) }()
==> put();

First I use a regex with named captures to get hold of the date and temperature Strs. Those are not overly helpful, as I need to sort by date. The 2nd map solves that problem with nested coercions in a destructuring sub-signature. As Match contains a few extra methods that I don’t care for, I need to gobble those up with an anonymous hash slurpy. Now I have a LoL with a date and temperature sub-list, where the date is a Date and the temperature is something Numeric. I sort by the first and then destructure again. I use a state container to keep a link between consecutive iteration steps. (To make this hyper-friendly, we would need to .rotor.) I always want $last-temp to contain the $temperature of the previous iteration but I don’t want to do anything else in the first iteration. Hence, the LEAVE-phaser and the once. Anything else means to create the output text. Since I don’t want a combo breaker, I use a pointy-block like we need to in a feed-operator-chain to add newlines where they belong.

If you managed to stuff more Raku-features into your solution, you out-convoluted me and I would love to see your code.

Joking aside, I believe to have another candidate for macro-ideas.txt. If we look at the first and second map, there is a pattern. We use the same named-arguments in both. With RakuAST it might be possible to provide a Regex, a block and a list of coercions, to produce a Sub that does that in one go. That would be a neat shortcut for simple parsers that deal with lines of text.

Assuming optionality

PWC 180 Task 1 asks us to find the first unique character in a string. I wanted to have a nice interface where I would write:

say $str.comb.first: &unique-char;

The idea was to curry postcircumfix:<{ }> so it will be bound to a BagHash and always ask for :!exists. Alas, .assuming doesn’t do the right thing if the proto contains optional positions. I found a workaround utilising once.

for ‘Perl Weekly Challenge’, ‘Long Live Perl’ -> $str {
    my &unique-char = { (once $str.comb.BagHash»--){$_}:!exists }
    say $str.comb.first: &unique-char;
}

I don’t want to build the BagHash and remove single elements every time unique-char is called. There is a slight overhead when using once but that beats .assuming by a mile.

Given all the special cases Signatures provide, we may want to consider turning .assuming into a RakuAST-macro.

@data».sparkle

While reading solutions to the PWC, I spotted a pattern. There where plenty of .map-calls that contained only simple maths. It must not be so! Task 179-2 leans itself to use vector operations.

use v6.d;

constant @sparks = "▁" .. "█";
constant \steps = +@sparks - 1;

multi MAIN(
    #| space separated list of numbers
    *@data
) {
    my $scale := @data.&{ (.max - .min) / steps };
    put @sparks[((@data »-» @data.min) »/» $scale)».round].join;
}

multi MAIN(
    #| output an example sparkline-graph
    Bool :$test
) {
    .&MAIN for <2 4 6 8 10 12 10 8 6 4 2>, <0 1 19 20>, <0 999 4000 4999 7000 7999>;
}

First, I define a character range (no need for .ord here) and store the number of bar-graph steps. Then I calculate the scale like it is used in a map (those paper-things, that always work and don’t break when dropped). Now I can use that scale to shrink (or grow) values. I believe rounding is better here then to cut of to integers.

When we feed a list to a postcircumfix:<[ ]> we get a list of values in return. However, we break the method-call chain when we do so. Since operators are just Subs with a funny syntax, we can solve that issue easily.

constant &sparks = {
    constant @sparks = "▁" .. "█";
    constant \steps = +@sparks - 1;

    &postcircumfix:<[ ]>.assuming(@sparks) but role :: { has $.steps = steps }
}.();

my $scale := @data.&{ (.max - .min) / &sparks.steps };
((@data »-» @data.min) »/» $scale)».round.&sparks.join.put;

The constants are hidden within a block-scope and only steps is exposed as part of a Subs “namespace”. By declaring &sparks as constant, I move the currying to compile time.

Hypers are not getting much use in PWC-solutions. I believe another entry in raku-did-you-know is in order.

Suspicious introspection

One of my routines is acting suspicious. I’m almost certain it wilfully misinterprets arguments just so it can throw an exception. There is a way to spy on it.

sub suspicious($a, :$b, *@rest, *%opts) {
    die('imaoutahere!');

    CATCH {
        put (my $sig = &?ROUTINE.signature.gist) ~ ' -> ' ~ $sig.trans(<*@ *%> => <@ %>).EVAL».raku.join(',');
    }
}

suspicious(1, :2b, 3,4,5);
# OUTPUT: ($a, :$b, *@rest, *%opts) -> 1,:b(2),3 4 5,
          imaoutahere!
            in sub suspicious at tmp/2021-03-08.raku line 1910
            in block <unit> at tmp/2021-03-08.raku line 1917

Please note, that the CATCH-block doesn’t do anything to the exception. It is just there to trigger the debugging code. The proper place to put that would be a macro. Alas, macro can’t inject CATCH-blocks that are actually used as exception handlers. It will have to wait for RakuAST, what would also allow me to replace the EVAL-shenanigans with proper code. Another entry in macro-ideas.txt until then.

Defeating definedness

In his latest blogpost, p6steve went through a lot of trouble to enforce definedness. I managed to shorten it a bit.

None: Nil;
subset Option of Any where Any:D | None;

my Option $defined = 42;
my Option $nothing = None;
my Option $undefined = Mu;

.&dd for $defined, $nothing, $undefined;

# OUTPUT: Type check failed in assignment to $undefined; expected Option but got Mu (Mu)

I would really like to see the content of $nothing, and while I’m on it show why Steve’s hard labour was in vain.

try {
    my Option $defined = 42;
    my Option $nothing = None;
    my Option $undefined = Mu;

    .&dd for $defined, $nothing, $undefined;

    CATCH { default { note .message; .resume } }
}

# OUTPUT: Type check failed in assignment to $undefined; expected Option but got Mu (Mu)
#         Int $defined = 42
#         Label $nothing = Label.new(name => "None", file => "tmp/2021-03-08.raku", line => 1880)
#         Any $undefined = Any

Raku is a dynamic, late bound language. There are language constructs, like resumable exceptions and NativeCall, that can defeat any type-check. Trying to use Raku like Rust, Haskell or any other strictly typed language will eventually fail. No amount of :Ds will substitute testing, testing and even more testing.

I hope not to have tested p6steve’s patience and try to calm the waves with a new repo.

Symbolism

On IRC deoac wished to know how to print the name of a variable. This question is ambiguous. To get the name of the container is easy.

my $foo;
say $foo.VAR.name;
# OUTPUT: $foo

If binding or constants involved, things get odd or fail.

my $bar := $foo;
constant $never-changes = 'war';
# OUTPUT: $foo
          No such method 'name' for invocant of type 'Str'.  Did you mean any of
          these: 'Date', 'Num', 'are', 'none', 'note', 'take'?

The second meaning of “variable” might be “symbol” for deoac’s use case. Getting hold of a symbol name requires early compile time measures.

use experimental :macros;
macro symbol-name($symbol) {
    quasi { $symbol.Str }
}

say symbol-name($foo);
say symbol-name($bar);
say symbol-name($never-changes);
# OUTPUT: ($foo)
          ($bar)
          ($never-changes)

The value of $symbol is an AST object and stringifies (in this case) to a list of Str. I didn’t dig deeper, because with RakuAST things will change.

However, this once again shows that we might do better by explaining what my actually does instead of assuming that one can guess what we mean when using the term “variable”.

Swarming Sundays

To not miss any Sundays, PWC 175 is asking us to find them. Raku helps us a great deal, because we can easily find the last day in a month, calculate it’s distance to the next Sunday and turn the clock back by that many days.

for 2022 -> $year {
    for 1..12 -> $month {
        my $last-day-in-month = Date.new($year, $month, *);
        my $Δsunday = $last-day-in-month.day-of-week % 7;
        say $last-day-in-month.earlier(:days($Δsunday));
    }
}

If you follow this blog, you will have spotted my distaste for simple loops. They get in the way of using interesting language features and thus fun. Date.new will only ever return a single date. With an Array of dates I could use vector operations to calculate all last Sundays in a month in one go. So I need a way to create a swarm of Dates, depending on a pattern. Signatures are patterns (and just fancy lists), so let’s use those.

sub swarm(::Type, @sig is copy, Range $range) {
    my $var;
    my $marker-index = @sig.first([], :k);
    @sig[$marker-index] := $var;
    gather for @$range {
        $var = $_;
        take Type.new: |@sig;
    }
}

my @months = swarm(Date, (2022, @, *), 1..12);
my @Δsunday = @months».day-of-week »%» 7;
.say for @months.map({ .earlier(:days(@Δsunday.shift)) });

The sub swarm takes a type, a parameter-list meant to be used on that types’ new method and a range. It finds the empty list created by @ and replaced it with a container. That container is then filled with a value taken from the range. This is as neat as it is unnecessary. Raku will do the whole shebang for us if we use a Junction. Getting hold of the results requires a module by lizmat.

use eigenstates;

my @months = Date.new(2022, (1..12).any, *).&eigenstates;
my @Δsunday = @months».day-of-week »%» 7;
.say for @months.map({ .earlier(:days(@Δsunday.shift)) });

# OUTPUT: No such method 'List' for invocant of type 'BOOTArray'.  Found 'List'
on type 'Any'
  in sub eigenstates at /usr/local/src/rakudo/install/share/perl6/site/sources/EDAA4AE0C8813633A2EA392374FB72F6B4D61047 (eigenstates) line 4

Thank you MoarVM, for creating a nice BOOTArray for us that we can’t easily turn into a List. Some bewilderment and a PR later, the result changed. You may wish to zef upgrade if you use eigenstates.

2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25

Just displaying those Sundays wont justify getting rid of the loop. If we need that in an API, returning a list of Dates without much hassle seems valuable. Please note, that the BOOTArray indicates eagerness and I don’t think it has to be. Junctions might get lazier and faster in the future.

Coercive bits

Altreus was looking for a way to convert a list of bitmask names, provided as a string by the user, to a bitmask. He wished for BUILDARGS, as provided by Perl’s Moose but was given good advise how to solve the problem without making object instantiation even more complex. Nobody can stop me from doing just that.

With Moose, BUILDARGS allows to modify values before they are bound to attributes of a class. We can do the same by using the COERCE-protocol, not just for Routine-arguments.

role BitMask[@names] {
    has int $.mask;
    sub names-to-bits(@a) {
        my int $mask;
        for @a -> $s {
            $mask = $mask +^ (1 +< @names.first($s, :k) // fail('bad‼'))
        }

        $mask
    }
    sub bits-to-names($mask) {
        ($mask.base(2).comb.reverse Z @names).map: -> [Int() $is-it, $name] { $is-it ?? $name !! Empty }
    }

    multi method COERCE(Str $s) { self.COERCE: $s.split(' ').list }
    multi method COERCE(List $l) { self.new: :mask($l.&names-to-bits) }

    method raku { "BitMask[<@names[]>](<{$!mask.&bits-to-names}>)" }
    method bits(--> Str) { $.mask.fmt('%b') }
}

class C {
    has BitMask[<ENODOC ENOSPEC LTA SEGV>]() $.attr is required;
}

my $c = C.new: :attr<ENODOC ENOSPEC SEGV>;
say $c;
say $c.attr.bits;
# OUTOUT: C.new(attr => BitMask[<ENODOC ENOSPEC LTA SEGV>](<ENOSPEC LTA SEGV>))
#         1011 

Here I build a role that carries the names of bits in a bit-field and will create the bit-field when give a Str or List containing those names. Since I use a parametrised role, my bitfield is type-safe and the type is tied to the actual names of the bits. As a consequence a user of the module that exports C can extend the accepted types by using that specific role-candidate.

enum IssueTypes ( ENODOC => 0b0001, ENOSPEC => 0b0010, LTA => 0b0100, SEGV => 0b1001 );

class IssueTypesBits does BitMask[<ENODOC ENOSPEC LTA SEGV>] {
    method new(*@a where .all ~~ IssueTypes) {
        self.bless: mask => [+|] @a
    }
}

sub bitmask(*@a where .all ~~ IssueTypes) {
    IssueTypesBits.new: |@a
}

my $c3 = C.new: attr => BEGIN bitmask(ENODOC, LTA, SEGV);
say $c3;
say $c3.attr.bits;
# OUTPUT: C.new(attr => BitMask[<ENODOC ENOSPEC LTA SEGV>](<ENODOC LTA SEGV>))
          1101

Here I define an enum and provide the same names in the same order as in does BitMask. With the shim bitmask I create the type-safety bridge between IssueTypes and BitMask[<ENODOC ENOSPEC LTA SEGV>].

It is very pleasing how well the new COERCE-protocol ties into the rest of the language, because we can use a coercing-type at any place in the source code which takes a normal type as well. What is not pleasing are the LTA-messages X::Coerce::Impossible is producing.

my $c4 = C.new: attr => 42;
# OUTPUT: Impossible coercion from 'Int' into 'BitMask[List]': method new returned a type object NQPMu
            in block <unit> at parameterised-attribute.raku line 60

This is surpring because we can get hold of the candidates for COERCE at runtime.

CATCH {
    when X::Coerce::Impossible && .target-type.HOW === Metamodel::CurriedRoleHOW {
        put "Sadly, COERCE has failed for {.from-type.^name}. Available candidates are: ", .target-type.new.^lookup('COERCE').candidates».signature».params[*;1]».type.map(*.^name)
    }
}

# OUTPUT: Sadly, COERCE has failed for Int. Available candidates are: Str List

What we can’t see are the candidates of IssueTypesBits, because that is hidden behind the constructor new. I tried to use the MOP to add another multi candidate but failed. When parametrising the underlying type-object gets cloned. Any change to the multi-chain wont propagate to any specialised types.

The COERCE-protocol is quite useful indeed. Maybe it’s time to document it.