The Palin Digits with Raku

by Arne Sommer

The Palin Digits with Raku

[78] Published 19. June 2020.

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

Challenge #065.1: Digits Sum

You are given two positive numbers $N and $S.

Write a script to list all positive numbers having exactly $N digits where sum of all digits equals to $S.

Example
Input:
    $N = 2
    $S = 4

Output:
    13, 22, 31, 40

The challenge can be divided in two parts. The first is finding «all positive numbers having exactly $N digits. We can get the lower and upper limits by string concatenation. Let us say that $N = 2:

> my $N = 2;
> my $start = 1 ~ '0' x ($N - 1);  # -> 10
> my $stop  = '9' x $N;            # -> 99 

See docs.raku.org/routine/x for more information about the string repetition operator x.

The values we end up with are strings, but they are coerced to integers automatically when we use them in numerical context (in a Range, as shown later on).

Or we can use a mathematical formula:

> my $N = 2;
> my $start = 10 ** ($N - 1);  # -> 10
> my $stop  = (10 ** $N) -1;   # -> 99

See docs.raku.org/routine/** for more information about the exponentiation operator **.

The result is the same.

Then we plug the start and stop values into a Range to get all the (integer) values:

my @all = ($start .. $stop);

See docs.raku.org/language/operators#index-entry-Range_operator for more information about the Range operator ...

Sorting out the numbers where the sum of all digits equals to $S is a task for grep:

my @some = @all.grep({ $_.comb.sum == $S });
                       # 1 ### # 2 #####    

[1] For each value (number), split it into each individual digit with comb (giving a list of single digits).

[2] Add those digits together with sum, and compare with $S. Matching values are collected in @some.

See docs.raku.org/routine/grep for more information about grep.

See docs.raku.org/routine/comb for more information about comb.

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

The program:

File: digits-sum
#! /usr/bin/env raku

unit sub MAIN (Int $N where $N > 0, Int $S where $S > 0, :$verbose);  # [1]

my $start = 10 ** ($N - 1);
my $stop  = (10 ** $N) -1;

say ": Max Range ($start .. $stop)" if $verbose;

say ($start .. $stop).grep({ $_.comb.sum == $S }).join(", ");         # [2]

[1] Ensure that the two values are positive integers. I have added verbose mode as well.

[2] The last part (join) gives the values as a comma separated list, as requested by the challenge.

See docs.raku.org/routine/join for more information about join.

Running it:

$ raku digits-sum 2 4
13, 22, 31, 40

$ raku digits-sum --verbose 2 4
: Max Range (10 .. 99)
13, 22, 31, 40

$ raku digits-sum --verbose 3 4
: Max Range (100 .. 999)
103, 112, 121, 130, 202, 211, 220, 301, 310, 400

$ raku digits-sum --verbose 4 3
: Max Range (1000 .. 9999)
1002, 1011, 1020, 1101, 1110, 1200, 2001, 2010, 2100, 3000

A Perl Version

Just for fun...

File: digits-sum-perl
#! /usr/bin/env perl

use strict;
use feature 'say';

my $verbose = 0;

if ($ARGV[0] eq "--verbose")
{
  $verbose = 1;
  shift @ARGV;
}

my $N     = shift @ARGV || die "No 'N' value";
my $S     = shift @ARGV || die "No 'S' value";

die "Illegal 'N' value" if int($N) ne $N && $N <= 1;
die "Illegal 'S' value" if int($S) ne $S && $S <= 1;

my $start = 10 ** ($N - 1);
my $stop  = (10 ** $N) -1;
my @all   = ($start .. $stop);
my @some  = grep { get_sum($_) == $S } @all;

say ": Max Range ($start .. $stop)" if $verbose;

say join(", ", @some);

sub get_sum
{
  my $integer = shift;
  my $sum = 0;
  for my $digit (split(//, $integer))
  {
    $sum += $digit;
  }
  return $sum;
}

It is quite a bit longer than the Raku version; Raku: 260 bytes vs Perl: 680 bytes.

Running it gives the same output as the Raku version:

$ perl digits-sum-perl 2 4
13, 22, 31, 40

$ perl digits-sum-perl --verbose 2 4
: Max Range (10 .. 99)
13, 22, 31, 40

$ perl digits-sum-perl --verbose 3 4
: Max Range (100 .. 999)
103, 112, 121, 130, 202, 211, 220, 301, 310, 400

$ perl digits-sum-perl --verbose 4 3
: Max Range (1000 .. 9999)
1002, 1011, 1020, 1101, 1110, 1200, 2001, 2010, 2100, 3000

Challenge #065.2: Palindrome Partition

You are given a string $S. Write a script print all possible partitions that gives Palindrome. Return -1 if none found.
Please make sure, partition should not overlap. For example, for given string “abaab”, the partition “aba” and “baab” would not be valid, since they overlap.

Example 1
Input: $S = 'aabaab'
Ouput:
 There are 3 possible solutions.
 a) 'aabaa'
 b) 'aa', 'baab'
 c) 'aba'
Example 2
Input: $S = 'abbaba'
Output:
 There are 3 possible solutions.
 a) 'abba'
 b) 'bb', 'aba'
 c) 'bab'

You may think that this is an excellent task for a parser (and a grammer).

But it can be done with a recursive procedure as well. Here it is:

File: palindrome-partition
#! /usr/bin/env raku

unit sub MAIN (Str $S = 'aabaab', :$verbose);

my @result;                                    # [1]
my %match-with-remainder;                      # [2]
my $matches = 0;                               # [3]

for 0 .. $S.chars -2 -> $start                 # [4]
{
  say ":: Start at pos $start (string: '{ $S.substr($start) }')" if $verbose;

  check($S.substr($start, 2), $S.substr($start + 2));     # [5]
}

sub check($string, $remainder)                            # [6]
{
  say ":: Check '$string' (Remainder: '$remainder')" if $verbose;

  if $string eq $string.flip                              # [7]
  {
    next if %match-with-remainder{$remainder.chars};      # [8]
    %match-with-remainder{$remainder.chars} = True;       # [9]
    @result.push: $string;                                # [10]
    $matches++;                                           # [3]
    
    say ":: Match: '$string'" if $verbose;
    
    check($remainder.substr(0,2), $remainder.substr(2))  # [11]
      if $remainder.chars >= 2;                        

    if @result                                           # [12]
    {
      say @result.map({ "'{ $_ }'" }).join(", ");        # [12a]
      @result = ();                                      # [12b]
    }
  }
  
  check($string ~ $remainder.substr(0,1), $remainder.substr(1))
    if $remainder.chars >= 1;                            # [13]
}

say "-1" unless $matches;                                # [3]

[1] All the partitions that we can get out of the string simultaneously (a single line in the output).

[2] When we have found a palindrome, take note of the number of remaining characters so that we can skip already found palindromes.

[3] No matches at all, print «-1».

[4] Iterate over the substrings; first time all of it, then without the first character, the two first, and so on.

[5] Pass on the two first characters (of the current substring) and the remaining characters to the recursive function doing the work.

[6] The recurive procedure (or monster).

[7] If the current string is a palindrome,

[8] • abort the recursion if we have already registered it (see «Stopped by [8]» in the Verbose output later on).

[9] • set it up so that we can detect the situation in [8], using the length of the remaining string as that is always the same (regardless of where we start (in [4]).

[10] Add the palindrome to the the result array.

[11] Recursively go on with the remaining string, if any.

[12] If we have a result, print it as a comma separated list with quoted strings [12a] and clear out the matches ready for the next iteration [12b].

[13] The block above (the if-block in [7]) gives the shortes match. This one gives the longest match. (Or rather, it adds another character to the string and does the recursion again, which in turn does both shortest and longest matching. Recursively.)

I may be easier to understand what is going on if you run the porgram with verbose mode (as shown later on), and walk through the output and the program code.

The expressions «shortest match» and «longest match» (in [13]) may remind you of «Shortest Token Matching» and «Longest Token Matching». So if you want to look into doing this with Regexes or a Grammar, you have a starting point.

Running it on the strings given in the challenge:

$ raku palindrome-partition 'aabaab'
'aa', 'baab'
'aabaa'
'aba'

$ raku palindrome-partition 'abbaba'
'abba'
'bb', 'aba'
'bab'

And with verbose mode (with some coloured comments, referring to the code):

$ raku palindrome-partition --verbose 'aabaab'
:: Start at pos 0 (string: 'aabaab')
:: Check 'aa' (Remainder: 'baab')
:: Match: 'aa'
:: Check 'ba' (Remainder: 'ab')
:: Check 'baa' (Remainder: 'b')
:: Check 'baab' (Remainder: '')
:: Match: 'baab'
'aa', 'baab'
:: Check 'aab' (Remainder: 'aab')       # Given by [13]
:: Check 'aaba' (Remainder: 'ab')
:: Check 'aabaa' (Remainder: 'b')
:: Match: 'aabaa'
'aabaa'
:: Check 'aabaab' (Remainder: '')
:: Start at pos 1 (string: 'abaab')
:: Check 'ab' (Remainder: 'aab')
:: Check 'aba' (Remainder: 'ab')
:: Match: 'aba'
:: Check 'ab' (Remainder: '')
'aba'
:: Check 'abaa' (Remainder: 'b')
:: Check 'abaab' (Remainder: '')
:: Start at pos 2 (string: 'baab')
:: Check 'ba' (Remainder: 'ab')
:: Check 'baa' (Remainder: 'b')
:: Check 'baab' (Remainder: '')        # Stopped by [8]
:: Start at pos 3 (string: 'aab')
:: Check 'aa' (Remainder: 'b')
:: Start at pos 4 (string: 'ab')
:: Check 'ab' (Remainder: '')
$ raku palindrome-partition --verbose 'abbaba'
:: Start at pos 0 (string: 'abbaba')
:: Check 'ab' (Remainder: 'baba')
:: Check 'abb' (Remainder: 'aba')
:: Check 'abba' (Remainder: 'ba')
:: Match: 'abba'
:: Check 'ba' (Remainder: '')
'abba'
:: Check 'abbab' (Remainder: 'a')
:: Check 'abbaba' (Remainder: '')
:: Start at pos 1 (string: 'bbaba')
:: Check 'bb' (Remainder: 'aba')
:: Match: 'bb'
:: Check 'ab' (Remainder: 'a')
:: Check 'aba' (Remainder: '')
:: Match: 'aba'
'bb', 'aba'
:: Check 'bba' (Remainder: 'ba')
:: Check 'bbab' (Remainder: 'a')
:: Check 'bbaba' (Remainder: '')
:: Start at pos 2 (string: 'baba')
:: Check 'ba' (Remainder: 'ba')
:: Check 'bab' (Remainder: 'a')
:: Match: 'bab'
'bab'
:: Check 'baba' (Remainder: '')
:: Start at pos 3 (string: 'aba')
:: Check 'ab' (Remainder: 'a')
:: Check 'aba' (Remainder: '')
:: Start at pos 4 (string: 'ba')
:: Check 'ba' (Remainder: '')

If you want the output in the same order as in the challenge, just move line [13] before line [7]. (The updated file «palindrome-partition2» is included in the zip file.)

Running it:

$ raku palindrome-partition2 'aabaab'
'aabaa'
'aa', 'baab'
'aba'

$ raku palindrome-partition2 'abbaba'
'abba'
'bb', 'aba'
'bab'

A Perl Version

of this one as well...

File: palindrome-partition-perl
#! /usr/bin/env perl

use feature 'say';
use feature 'signatures';
no warnings qw(experimental::signatures);

my $verbose = 0;

if ($ARGV[0] eq "--verbose")
{
  $verbose++;
  shift @ARGV;
}

my $S = shift @ARGV || 'aabaab';

my @result;
my %match_with_remainder;
my $matches = 0;

for my $start (0 .. length($S) -2)
{
  say ":: Start at pos $start (string: '" . substr($S, $start) . "')" if $verbose;

  check(substr($S, $start, 2), substr($S, $start + 2));
}

sub check($string, $remainder)
{
  say ":: Check '$string' (Remainder: '$remainder')" if $verbose;

  check($string . substr($remainder, 0,1), substr($remainder, 1)) if length $remainder >= 1;

  if ($string eq reverse $string)
  {
    next if $match_with_remainder{length $remainder};
    $match_with_remainder{length $remainder} = 1;
    push(@result, $string);
    $matches++;
    
    say ":: Match: '$string'" if $verbose;
    
    check(substr($remainder,0,2), substr($remainder,2)) if length $remainder >= 2;

    if (@result)
    {
      say join(", ", map { "'$_'" } @result);
      @result = ();
    }
  }
}

say "-1" unless $matches;

Running it gives the same result as the Raku version.

And that's it.