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.