Amicable Split with Raku

This is my response to the Perl Weekly Challenge #20.

I'm in Riga this week, attending PerlCon 2019. The banner image is from Kemeri Bog, which I visited on Monday.

Challenge #20.1

Loop

sub MAIN (Str $string, :$quote = '"') # [1]
{
  split-change($string).map({ $quote ~ $_ ~ $quote }).join(", ").say;
} # [2] ############### # [2a] ###################### # [2c] ### # [2d]

sub split-change ($string)            # [3]
{
  my @out;                            # [4]
  my @in = $string.comb;              # [5]
  my $out;                            # [7]

  while @in                           # [6]
  {
    $out = @in.shift;                 # [7]

    while @in                         # [8]
    {
      if @in[0] eq $out.substr(0,1)   # [9]
      {
        $out ~= @in.shift;            # [9]
      }
      else
      {
        @out.push($out); $out = "";   # [10]
        last;                         # [10]
      }
    }  
  }

  @out.push($out) if $out;            # [11]

  return @out;                        # [12]
}

[1] I have chosen to write a MAIN wrapper around the actual «split-change» function. It uses normal double quotes by default, but this can be overridden with the «--quote» command line option. (The challenge uses different opening and closing quotes, but I have chosen to disregard that.)

[2] «split-change» returns a list of strings,

[2b] • so we use «map» to add the quotes around the strings,

[2c] • and use «join» to join them together as a single string, comma separated,

[2d] • and finally we print the line

[3] The procedure doing the actual job.

[4] We collect the partial strings here.

[5] I have chosen to treat the input as an array of single characters.

[6] As long as there are more characters left,

[7] • get the next one. We build up the nes string in «$out»

[8] As long as there are more characters left,

[9] If the next character is the same as the last one (in «$out»), add it

[10] If not, push the string and get rid of the old value. The «last» statement exits the inner loop (in [8[), and the outer loop kicks in (in [6)) and reads the next character (in [7]).

[11] Save the last string, if non-empty. It is empty if we passed the program an empty string (typically "").

[12] Return the lot.

See docs.raku.org/syntax/last for more information about last.

Running it:

$ raku split-change-loop ""

$ raku split-change-loop 1234567
"1", "2", "3", "4", "5", "6", "7"

$ raku split-change-loop 123334567777
"1", "2", "333", "4", "5", "6", "7777"

gather/take

sub MAIN (Str $string, :$quote = '"')
{
  split-change($string).map({ $quote ~ $_ ~ $quote }).join(", ").say;
}

sub split-change ($in)
{
  gather                                            # [1]
  {
    my $out = $in.substr(0,1);                      # [2]
    for 1 .. $in.chars -> $index                    # [3]
    {
      if $out.substr(0,1) eq $in.substr($index,1)   # [4]
      {
        $out ~= $in.substr($index,1);               # [5]
      }
      else
      {
        take $out;                                  # [6]
        $out = $in.substr($index,1);                # [7]
      }
    }
  }
}

[1] We wrap the code in «gather» to collet the values given with «take» (in [5]).

[2] The «$out» variable starts with the first character in the input string.

[3] Then we loop through the rest of the characters (in the input string), one at a time. Or rather we loop through the index (or position) of the character.

[4] If the current character (in the loop) is the same as the previuos one,

[5] • add it to the «$out» variable.

[6] If not, save the string (with «take»), and

[6] • set «$out» to the new character.

Note that we do not need to handle the end of the string as a special case, as in the loop version.

See my Raku Gather, I Take article for more information about gather/take. They are usually used in a lazy context, but that isn't an issue here as we need all the values at once (for the output).

Running it gives the same result as before:

$ raku split-change-gather ""

$ raku split-change-gather 1234567
"1", "2", "3", "4", "5", "6", "7"

$ raku split-change-gather 123334567777
"1", "2", "333", "4", "5", "6", "7777"

Grammar

And finally a very compact version using a grammar:

grammar SPLIT                # [1]
{
  regex TOP  { <Char>+ }     # [2]
  regex Char { (.) $0* }     # [3]
}

sub MAIN (Str $string, :$quote = '"')
{
  my $result = SPLIT.parse($string); # [4]

  $result<Char>.map({ $quote ~ $_.Str ~ $quote }).join(", ").say;
  # [5] ####### # [5b] ##########################    
}

[1] We start with the grammar.

[4] We use the «parse» method on the grammar and pass the string as argument to get the show going.

[5] The must look up the result in match object by name. The «Char» rule matches several times, so is a list.

[5b] • then we apply «map» on the individual elements to add the quotes. Note the explicit «.Str» on the individual value, as it is a match object. Printing a match object adds the funny quotes as «｢aaaa｣», so don't do that.

Running it gives almost the same result as before:

$ raku split-change-grammar ""
Use of uninitialized value of type Any in string context.
Methods .^name, .raku, .gist, or .say can be used to stringify it to something
meaningful.
  in block at split-change-grammar line 13

$ raku split-change-grammar 1234567
"1", "2", "3", "4", "5", "6", "7"

$ raku split-change-grammar 123334567777
"1", "2", "333", "4", "5", "6", "7777"

The grammar doesn't support empty strings. The easiest way to fix this is by cheating, checking if we have any matches:

  $result
    ?? $result<Char>.map({ $quote ~ $_.Str ~ $quote }).join(", ").say
    !! print "\n";

Now it works:

$ raku split-change-grammar2 ""

File Sizes

Note that the Crash Bang line (#! /usr/bin/env raku) is present in all the files, even if not shown in the listings, and is included in the numbers. The percentages are heavily rounded.

Here you have the whole program:

grammar SPLIT
{
  regex TOP  { <Char>+ }
  regex Char { (.) $0* }
}

sub MAIN (Str $string, :$quote = '"')
{
  my $result = SPLIT.parse($string);

  $result
    ?? $result<Char>.map({ $quote ~ $_.Str ~ $quote }).join(", ").say
    !! print "\n";
}

If you want a grammar version of the familiar «split-change» procedure, here it is (with the empty string fix):

sub MAIN (Str $string, :$quote = '"')
{
  split-change($string).map({ $quote ~ $_ ~ $quote }).join(", ").say;
}

grammar SPLIT
{
  regex TOP  { <Char>+ }
  regex Char { (.) $0* }
}

sub split-change ($in)
{
  my $result = SPLIT.parse($in) // return "";
  return $result<Char>.map({ $_.Str });
}

Challenge #18.2

The challenge uses the word «print» and not «compute», so this is probably an acceptable solution:

say "(220, 284)";

This smallest pair is taken from the wikipedia article.

It does feel like cheating, so I'll do it the hard way as well...

The first thing to notice is that the wiki page talkes about «proper divisors», which was part of Challenge 8.1 as well.

We can start by reusing this program from my solution, shown here without the original explanation:

sub MAIN ($number)
{
  say "Divisors (excluding the number itself): " ~ proper-divisors($number);
}

multi proper-divisors (2) { return (1); } 

multi proper-divisors (Int $number where $number > 2) 
{
  return (1) if $number.is-prime; 

  my @divisors = (1);
  for 2 .. ($number -1) -> $candidate 
  {
    @divisors.push: $candidate if $number %% $candidate;
  }
  return @divisors;
}

The only takeaway here is that the lowest legal input value is 2. We'll have to take care of that.

multi proper-divisors (2) { return (1); } 

multi proper-divisors (Int $number where $number > 2) 
{
  return (1) if $number.is-prime; 

  my @divisors = (1);
  for 2 .. ($number -1) -> $candidate 
  {
    @divisors.push: $candidate if $number %% $candidate;
  }
  return @divisors;
}

my @sum;                                     # [1]

for 2 .. Inf -> $current                     # [2]
{
  my $sum = proper-divisors($current).sum;   # [3]
  @sum[$current] = $sum;                     # [3]

  next if $sum == 1 || $sum >= $current;     # [4]

  my $new-sum = @sum[$sum] // next;          # [5]

  next if $new-sum == 1 || $new-sum >= $current || $sum == $new-sum;  # [6]

  if $sum == @sum[$new-sum]                  # [7]
  {
    say "(@sum[$sum], $sum)";                # [8]
    last;                                    # [9]
  }
}

[1] We keep the sum of the common divisors in this array,

[2] and add new ones incrementally until infinty.

[3] The sum for the current value, stored in the array an as a helper variable to make the lookup easier. sum sums up the values in the list.

[4] If the sum is 1, we have a value that doesn't round trip (it is actually a prime). So we are finished with this value. We are also finished if the sum is larger than the current value, as we haven't reached that far. (We'll get back to it when we compute that number.)

[5] «$new-sum» is the sum of the common divisor for the sum of the common divisor for the current value. (If this is too confusing; see the illustration below the notes.)

[6] The same checks as in [4], but the last one is new. That one checks for a value that leads back to itself, as 6 does.

[7] If it roundtrips (we get back to the same value),

[8] • we have found an amicable number pair, print it (with the lowest value first, to mimic the wikipedia article),

[9] • and we end the program. The first one found is also the lowest.

See docs.raku.org/routine/sum for more information about sun.

• x is $current
• y is $sum (or @sum[$current])
• z is $new-sum (or @sum[@sum[$current]])
• x' is @sum[$new-sum] (or @sum[@sum[@sum[$current]]])

If x == x', the values round trip, and we have found a match.

Running it:

$ raku smallest-amicable-number
(220, 284)

And that's it.