Digital Value at the Palindrome Thunderdome

Wherein we look to find the value of the strange characters we meet, and test the mettle of symmetry when we gather together in groups.

THE WEEKLY CHALLENGE – PERL & RAKU #65

TASK #1 › Digits Sum

Submitted by: Mohammad S Anwar
Tuned and Tweaked by: RYAN THOMPSON

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

Method

Perl has the wonderful ability to seamlessly glide between looking at individual digits as either raw glyphs or atomic numbers. In certain circumstances this peculiar eye is even extended to other, non-digit characters.¹ As such we can assemble arbitrary digits, so as to positionally represent numbers, in exactly the same way we would do so with a pencil and paper.

This ability to construct strings of digits and such, and then evaluate those strings as representing numbers, opens up all kinds of questions of arithmetic number theory. Not cleanly fitting into the more common sub-disciplines, one might call it positional number theory, or as I like to call it (after its poetic cognate), Concrete Number Theory. We are no longer looking at just the meaning of the number, but also how it looks on the page.

To solve the challenge, we will need to construct a list of all numbers of a given positional length. For any given length, that list starts at a number constructed with a 1 and 0s to fill out the span, and ends with a string of 9s. We will need to make an exception of the numbers of length 1, that list spans from 0 to 9.² We can then filter our list with a function that sums the digits to allow elements that match the desired value. To sum the digits, we take a number and break it apart as we would a string into non-positional digits again, iterating through the list produced and summing to a collector. We could bring in List::Util::sum to replace these two lines with one, but I hardly see the point.

---

¹In the case of the hexadecimal numbering system, the letters A-F become digits. We can construct numbers using these digits in the same way as with the decimal system; we just need to notify Perl as to what we’re doing by adding the 0x prefix and using the oct() function. We can do the same, with different prefixes, to manufacture numbers in binary and octal. In these cases we might well consider the prefixes as part of the numeric representation.

²This task is easily performed mathematically, but this way is more consistent with the way we’re doing the rest of the challenge, and arguably more fun. If you’re interested in solving the problem mathematically. look to the Raku solution. The 0 case still needs to be accounted for, which we do a little differently there as well.

Perl Solution

use warnings;
use strict;
use feature ":5.26";

## ## ## ## ## MAIN:

my ($digit_count, $target) = @ARGV;
$digit_count //=  6;
$target      //= 39;


my $start = '1' . ( '0' x ($digit_count - 1));
my $end   = '9' x $digit_count;

my @result_set = grep { sum_digits($_) == $target } ($start..$end);

say $_ for @result_set;

## ## ## ## ## SUBS:

sub sum_digits {
    my @digits = split //, $_[0];
    my $sum;
    $sum += $_ for @digits;
    return $sum;
}

Raku Solution

Here the result set is constructed in one powerful line of code, filtering a master list of candidates as detailed above, only here we make the list mathematically. There still exists the edge case where the digit length is 1 and the requested total is 0, which we deal with in output here, giving us the opportunity to use the given/when control flow syntax.

sub MAIN (Int:D $digits = 4, Int:D $total = 49 ) {
    
    my @result_set = grep { ($_.comb.sum) == $total }, (10**($digits-1)..10**$digits-1);

    given @result_set { 
        when .list.elems > 0              { .say for @result_set }
        when $digits == 1 and $total == 0 { say 0 }
        { say "no numbers of length $digits sum to $total" }
    }
}

---

---

TASK #2 › Palindrome Partition

Submitted by: Mohammad S Anwar
Selected and Washed by: RYAN THOMPSON

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'

Method

First things first, we’re going to have to define some terms. I’d say on the face of it, the specification is ambiguous. So let’s break it down: we are asked for “all possible partitions that gives Palindrome“. In the examples given, the solutions find ways to split the string to reveal palindromes contained within, but some parts of the string are not included in the answer, suggesting that we are in fact being asked to find all sets of non-overlapping palindromes that can be found within the string. I also note there is also one additional solution to Example 1:

aa aa

which is not listed, but as far I understand fits the criteria, as the two aa groups do not reference the same characters in the string. So by “partition” we appear to mean to divide into an ordered list of segments, and then select out those segments that are palindromes. Which leads to my second clarification, what is a palindrome? Technically any single letter is read the same backwards and forwards, and as such is, technically, a palindrome. But that, to use a technical term, is stupid. So we won’t count them. The examples given, however, allow for two letter groupings, which I also consider a pretty degenerate form and not very interesting, but on this I will concede. I do think that the only reason we care at all about palindromes is because they’re interesting, so I think that’s a pretty powerful reasoning for excluding common double letters from the club. But no mind.

So with our interpretation nailed down, we will proceed.

Lets just go out and say I really wanted to do this with a single regex somehow, to parse the whole thing out using the RE sublanguage. I then realized that this is a tall order, that I didn’t have all week to think this over, and it’s not even necessarily even possible. So, one night when out on a walk, I thought up the process below, which is more of a hybrid approach.

Browsing through the perl RE tutorial, I had wandered across a nice version of a regex to identify whether a given string is indeed a palindrome. I didn’t use it, not because it wasn’t good or anything, but because I had a different idea in mind, and in the first place I was only there to check the syntax for embedding a code block that evaluates to a regex on execution. But it was encouraging to see. In any case I found what I was looking for, and so made my own.

There are two forms of code block, the first,

(?:{ your_code_here })

allows the insertion of a logical test, or really any arbitrary piece of code, as part of the match process; this is a zero-width assertion that must evaluate to a true value to continue.

The second form,

 (??:{ evaluation_becomes_part_of_the_match_expression }

is what we want. I find the doubling of the ?? as analogous to the /ee doubled eval switch. First the code is run, the result is inserted in place into the regex and then the match evaluated. Ideal.

The idea here is to match one or more characters and capture, then possibly a central pivot character, then reverse the captured string to check the match: instant palindrome. To do this the construct

(.+).?(??:(reverse $1))

will do the job for us nicely.

To find all the internal palindromes we will need to check each substring of at least two characters starting from each position in the original string. This is likely to be the most expensive operation, but we can constrain it a little to keep things manageable. We run the successful matches through a hash to keep the list elements unique.

Once we have a master list of palindromes we can construct individual sets of internal palindromes by recursively iterating through the list and passing $’ to the next function, adding to the chain until there are no more matches to be made. This familiar path walking exercise will produce all possible match sequences, so hence all ways to divide out any internal palindromes, if we allow that some of the partitions are not to be counted in the result set.

Which is what we decided earlier was what the challenge was asking for.

Perl Solution

[colincrain:~/PWC]$  perl 65_2_palindrome_thunderdome.pl A Man, a plan, a canal -- Panama!
aca ama
aca ana
ama aca ama
ama aca ana
ama ama
ama ana ama
ama ana ana ama
ama ana ana ana
ama anacana ama
ama anacana ana
ama aplanacanalpa ama
ama lanacanal ama
ama lanacanal ana
ama nacan ama
ama nacan ana
ama naplanacanalpan ama
ama planacanalp ama
ama planacanalp ana
amanaplanacanalpanama
ana aca ama
ana aca ana

    (etc... for 45 solutions)

use warnings;
use strict;
use feature ":5.26";

## ## ## ## ## MAIN:

my $string = prepare_input( @ARGV );

## get list of all palindromes
my @palins = all_palindromes($string);

## do an exhaustive global search for internal palindrome sets
my $solutions = [];
get_lists( $string, [], $solutions, \@palins);

for ($solutions->@*) {
    say "$_->@*";
}

## ## ## ## ## SUBS:

sub all_palindromes {
## extract every possible palindrome from the input string
    my $string = shift;
    my %palins;
    my $target;
    my $start = -1;
    while ( $start++ < length($string)-2 ) {
        for (2..length($string)-$start) {
            $target = substr( $string, $start, $_);
            if( $target =~ m/^(.+).?(??{reverse($1)})$/)  {                
                $palins{$target}++;
            }
        }
    }
    return keys %palins;
}

sub get_lists {
## recursively walk lists of combinations of palindrome matches
    my ($string, $list, $solutions, $palins, ) = @_;
    my $joined = join '|', $palins->@*;
    if ($string !~ /$joined/) {
        push $solutions->@*, $list;
        return;
    }
    for ( $palins->@* ) {
        if ($string =~ /$_/) {
            my @list = ( $list->@*, $_ );
            get_lists( $', \@list, $solutions, $palins);
        }
    }
}

sub prepare_input {
## palindromes traditionally ignore case, whitespace and punctuation
    $_ = join '', @_;
    s/\W//g;
    s/_//g;
    return lc;
}

Raku Solution

On the Raku side, the get_all_palindromes() routine gets lot simpler with the :exhaustive adjective. Oddly, calling .Str on the .list of @matches produces a list containing one element composed of a stringification of all the matches separated by spaces, rather than providing access to the matches as a list of strings. A one might easily imagine this would be a hard bug to catch, as the printed representation of the lists are the same, and you would be right. As always, dd, with it’s nicely verbose output, is your friend. We can then call .unique before returning.

The special variables $&, $` and $' are replaced by $/, the current match object, which knows all kinds of things about itself. This includes the parts of the original string before and after, which are accessed with $/.prematch and $/.postmatch. Another thing to notice is again we need pointy brackets within the regex we have constructed in order to get proper variable interpretation for our joined up string of palindrome options.

sub MAIN( *@input ) {
    my $string = process_input(@input);
    $string ||= "aaaBBaacXXyz";                 ## default processed input
    my @palins = get_all_palindromes($string);

    my @solutions;
    get_lists($string, [], @solutions, @palins);

    .say for @solutions;
}

sub get_all_palindromes ( $string ) {
    my @matches =  $string ~~ m:ex/ (.+) {} .? "{$0.flip}" /;
    my @list = @matches.map: {.Str};
    return @list.unique;
}

sub get_lists ($string, @list, @solutions, @palins) {
## recursively walk lists of combinations of palindrome matches

    my $joined = @palins.join: '||';
    unless $string ~~ m/<$joined>/ {
        @solutions.push: @list;
        return;
    }
    for ( @palins) -> $item {
        if ($string ~~ m/$item/) {
            my @newlist = @list;
            @newlist.push: $item ;
            get_lists( $/.postmatch, @newlist, @solutions, @palins);
        }
    }
}

sub process_input ( @input ) {
    my $string = @input.join;
    $string ~~ s:g/\W//;
    return $string;
}