Perl Weekly Challenge in Raku : Week 55
Tags: raku
Published: 2020-04-07 08:43:51

---
title: Perl Weekly Challenge in Raku : Week 55
published: true
description: Talking about my ongoing attempts at the Perl weekly challenge in Raku
tags: raku
---
So it's been a few weeks, I don't know about you but I've been a bit stressed so blogging about the challenges has been a bit hard. Still I'm also lucky to be [working in a job I enjoy](https://careers.zoopla.co.uk/) from home. Stay safe everyone and lets take a look at [this weeks challenges](https://perlweeklychallenge.org/blog/perl-weekly-challenge-055/) 

## Challenge 1

As is often the way my first thought on a challenge like this is to approach it with brute force and ignorance. I generally find that throwing computing power at the problem can often solve it quickly, if it doesn't I'll use my more valuable (and somewhat ageing) brainpower instead.

The first thing I decided was I'd represent my binary strings as Arrays, this is because I find bit twiddling annoying at the best of times and reserve it for instances when it's absolutely necessary. I value readability of my code and I just can't read masks and binary wibbly things all the easily. 

So with that in mind here's a simple function that given an array of `1`s and `0`s plus a start and end index flips all the ones in between.

    sub flip( @bin is copy, $l, $r ) {
        @bin[$l..$r] = @bin[$l..$r].map( { abs($_-1) } );
        @bin;
    }

This makes use of a few neat things. Firstly you can assign to an array slice so we modify the slice and assign back into it. The second thing is that `abs(x-1)` for `x=0` and `x=1` returns the flipped value as `abs(0-1) == abs(-1) == 1` and `abs(1-1) == 0`. So it makes the flipping itself nice and easy. 

After that we just need to loop through all the possible values for `l` and `r` and keep track of the results with the most elements. For this we can use a stream cache, where we store the value of the most elements found and the list of all those results. For each new result if it's got more `1`s than the current highest we reset the list of just have out new result and update the highest value. If it's got the same number of `1`s we add it to the current list, otherwise we ignore it.

This is a useful trick when you're dealing with a stream of data and you know what you're looking but you don't know how much data you're going to have. Putting everything into a hash and iterating over that after can lead to memory issues. 

Anyhow, here's the main loop.

    #| Given a binary string find the start and end points
    #| for flipping the bits that results in the most 1's
    #| in the final string
    sub MAIN( Str $bin where { m!^ <[10]>+ $! } ) {
        my @bin = $bin.comb;
    
        my @results;
        my $len = 0;
    
        for 0..@bin.elems-1 -> $l {
            for $l..@bin.elems-1 -> $r {
                my @res = flip(@bin,$l,$r);
                given @res.grep(* == 1).elems {
                    when * > $len {
                        $len = $_;
                        @results = [ { l => $l, r => $r, bin => @res.join("") }, ];
                    }
                    when $len {
                        @results.push( { l => $l, r => $r, bin => @res.join("") } );
                    }
                }
            }
        }
        say "Max 1's : {$len}";
        say "{$_<l>} -> {$_<r>} : {$_<bin>}" for @results;
    }

## Challenge 2

So Challenge 2 is about doing a Wave Sort, which is where a list `a,b,c,d,e` is sorted so that `a >= b <= c >= d <= e` and so on. There's probably a nifty way to make a custom infix operator that can handle this using chaining but I decided to go old school (Edinburgh University AI department in the 90's to be exact) and use the Prolog like abilities of the Raku Multi Dispatch model.

First up we need a way to get the unique permutations of a list. The challenge states your list can have non unique values in and the standard [permutations](https://docs.raku.org/routine/permutations) method treats each element as unique so for the the `(1,1)` will give two results `(1,1),(1,1)` which is not what we want.

My original version of this got all the permutations joined them with commas and put the in a set to get the unique keys and split them up. The problem with this is `permutations` returns a Sequnece which is evaluated lazily whilst that had to calculate all the permutations before anything could be done.

So then I came up with a nest method involving [gather / take](https://docs.raku.org/syntax/gather%20take) and a hash to give a sequence of values.

And then while writing this I thought, surely Raku has a [unique](https://docs.raku.org/routine/unique) method? And lo and behold my final unique permissions sub:

    sub unique-perms ( @input ) {
        @input.permutations.unique(:as(*.join(",")));
    }

This uses the `:as` option to specific how to change the input for `===` comparison and it slightly fasted then using `:with(&infix:<~~>)`. This gives us a sequence which means our code to check each permutation and see if it's valid is simple enough and can make use of [race](https://docs.raku.org/routine/race) to give us simple threading.

    #| Given a list of integers return all the wave sorted lists
    multi sub MAIN( *@input where { $_.elems >= 2 && $_.all ~~ Int } ) {
        .say for unique-perms( @input ).race.grep( -> @l { is-wave( 'gte', |@l ) } );
    }

...

Oh yeah. What's in `is-wave` and where's the Prolog you talked about? 

So first thing you'll note is `is-wave` take a staring string argument of `gte` (for `>=`) and then take the array the permutation as a set of arguments by having the `|` slip operator in front (I believe some language use `...` to do this?) 

So lets go through some possible ways this function could be called :

    multi sub is-wave( 'gte', Int $a, Int $b where { $b > $a }, *@ ) {
        False 
    }

So if we call it with `gte`, two integers (`$a` and `$b`) and some more positional arguments `*@` but `$b` is greater then `$a` we return `False`.

There are two other simple results :

    multi sub is-wave( 'gte', Int $a, Int $b where { $a >= $b } ) { 
        True 
    }
    multi sub is-wave( 'gte', Int $a, Int $b where { $a < $b } ) { 
        False 
    }

There's two cases where we call `is-wave` with `gte` and just two arguments. In on case `$a` *is* `>=` `$b` so we return `True` and in the other it isn't so we return `False`

This leaves us with one last possibly situation. More than two arguments and `$a >= $b`...

    multi sub is-wave( 
                       'gte', 
                       Int $a, 
                       Int $b where { $a >= $b }, 
                       $c, 
                       *@r 
                     ) { 
        True && is-wave( 'lte', $b, $c, |@r ); 
    }

So here we take *3* values where `$a >= $b` then we recurse into `is-wave` but now we pass `lte`, `$b`, `$c` and the rest of the list `@r` (this may be empty).

The code for the `lte` options are basically the same giving use this :

    multi sub is-wave( 'lte', Int $a, Int $b where { $a <= $b } )
        { True }
    multi sub is-wave( 'lte', Int $a, Int $b where { $a > $b } )
        { False }
    multi sub is-wave( 'gte', Int $a, Int $b where { $a >= $b } )          
        { True }
    multi sub is-wave( 'gte', Int $a, Int $b where { $a < $b } )           
        { False }
    multi sub is-wave( 'gte', Int $a, Int $b where { $a < $b }, *@ )       
        { False }
    multi sub is-wave( 'lte', Int $a, Int $b where { $a > $b }, *@ )       
        { False }
    multi sub is-wave( 'gte', Int $a, Int $b where { $a >= $b }, $c, *@r )
        { True && is-wave( 'lte', $b, $c, |@r ); }
    multi sub is-wave( 'lte', Int $a, Int $b where { $a <= $b }, $c, *@r )        
        { True && is-wave( 'gte', $b, $c, |@r ); }

There's probably a more elegant way to solve the problem without my brute force "Find every possible list and filter out the right ones" way but I do love that piece of code right there for it's simple elegance and the power that multi dispatch can bring to the table.