Perl Weekly Challenge: Week 65

Challenge 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

I'll show the raku solution first because it is practically a one-liner though I spread it over multiple lines for greater legibility.

The xx operator repeats a list a number of times. [X] applied to the lists produces a list of lists containing the cross product. By adding ~ to make [X~], the elements of the cross-product lists are concatenated. The upshot of all this is that we end up with a list (assuming $N = 2 as in the example) of numbers from 00 to 99. If $N was 3 we would get 000 to 999 and so on.

([X~] ([0 .. 9] xx $N))

But there numbers that start with 0. In the case of $N = 2, $S = 4, for example, 04 is actually 4 so it should not be included as a successful match. So this next step filters out numbers beginning with 0. Actually, as I write this, I realize that I've made a mistake; the regex shoulw be /^0+/ to deal with e.g $N = 3 which produces 004 which is also really just 4. Luckily it doesn't make a practical difference as the leading 0 means such numbers still get filtered out.

.grep({ !/^0/ })

Now we filter yet again. Each number that survived the last step is split into digits with .comb() and the digits are summed together with [+]. If the result equals $S then we have a successful match.

.grep({ ([+] $_.comb) == $S })

All that remains is to print the list of successfull matches delimited by commas to look nicer.

.join(q{, })
.say;

(Full code on Github.)

The Perl version is more verbose as it lacks some of the handy features of Raku. Most notable are the xx and X operators. The former can be readily simulated with a loop, the latter is harder. Luckily I had already written a replacement for challenge 44 which I reused. One unexpected benefit over Raku, is that by initially making @digits 1 to 9, I could omit the filtering out of numbers with leading 0's.

my @digits = 1 .. 9;

for (1 .. $N - 1) {
    @digits = X(\@digits, [0 .. 9]);
}

The elegent .grep from the Raku version had to be replaced by a map, grep, and another grep.

@digits = map { join q{}, @{$_}; }
    grep { my $accum; map {$accum += $_; } @{$_}; $accum == $S; }
    @digits;

But printing out the results is more or less the same.

say join q{, }, @digits;

(Full code on Github.)

Challenge 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'

Output: 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'

A palindrome is a string that reads the same backwards and forwards. Detecting if a string is a palindrome is very easy in Perl.

sub is_palindrome {
    my ($s) = @_;

    return $s eq reverse $s;
}

We want to check each partition of a string for palindromeness (palindromosity?) An initial bit of confusion I had was that you can have more than two partitions. In fact if you think about it each separate character of a string can be considered a 'partition'. However for a palindrome you need at least two characters.

sub get_palindromes {
    my ($s) = @_;
    my @palindromes;

So my code takes the initial 2 to length characters of the string and checks if it is a palindrome. If it is, it adds it to the list of results and recursively does the same check to the rest of the string. If it isn't, it adds 1 to the length of the part it is checking and tries again.

    for my $l (2 .. length $s ) {
        my $possible = substr $s, 0, $l;
        if (is_palindrome($possible)) {
            push @palindromes, $possible;
            push @palindromes, get_palindromes(substr $s, $l);
        }
    }

When all possible sequences have been searched, we can return the found palindromes.

    return @palindromes;
}

Now the list returned from the function above might include duplicates. So before I print it out, I add the values as keys to a hash which are by definition unique.

for my $n (0 .. (length $S) - 1) {
    for my $palindrome (get_palindromes(substr $S, $n)) {
        $results{$palindrome}++;
    }
}

say scalar keys %results ? join q{, }, keys %results : '-1';

(Full code on Github.)

The Raku version works the same way. Note Raku Strings have a .flip() method to do the reversing.

sub is_palindrome(Str $s) {
    return $s eq $s.flip;
}

sub get_palindromes(Str $s) {
    my @palindromes;

    for 2 .. $s.chars -> $l {
        my $possible = $s.substr(0, $l);
        if $possible.chars && is_palindrome($possible) {
            @palindromes.push($possible);
            @palindromes.push(get_palindromes($s.substr($l)));
        }
    }
    return @palindromes;
}

For reasons I don't fully understand, using .substr() in Raku ends up with extra whitespace around each palindrome. Luckily strings have a .trim() method which can get rid of it before we add it to the hash.

    for 0 ..^ $S.chars -> $n {
        for get_palindromes($S.substr($n)) -> $palindrome {
            if ($palindrome.trim ne q{}) {
                %results{$palindrome.trim}++;
            }
        }
    }

    say %results.keys.elems ?? %results.keys.join(q{, }) !! '-1';
}

(Full code on Github.)