Tag: Parker

Wherein we wonder where the wabbits are…

THE WEEKLY CHALLENGE – PERL & RAKU #116

---

episode one:
“Little Bunny Foo-Foo”

---

Task 1

Number Sequence

Submitted by: Mohammad S Anwar

You are given a number $N >= 10.

Write a script to split the given number such that the difference between two consecutive numbers is always 1 and it shouldn’t have leading 0.

Print the given number if it impossible to split the number.

Example

Input: $N = 1234
Output: 1,2,3,4

Input: $N = 91011
Output: 9,10,11

Input: $N = 10203
Output: 10203 as it is impossible to split satisfying the conditions.

Method

There’s a little semantic oddity about the description for this task, in that that description only states that the difference between two adjacent values should be be 1, not that the sequence should be ascending or anything like that. Which in turn means that by rights the sequence can go up, down or oscillate; all that matters is an absolute value. One could, I suppose, make the argument that the difference in a descending sequence like 3,2,1 is -1, but that’s why I called it a semantic oddity. We could conclude it’s ambiguous at minimum, and I’m going to, as is often my want, go with the more complex choice.

Another aspect is this specific request for not having a leading 0. I had to decipher the third example to realize the intent was that no segment should have a leading 0, rather than the entire number, which was the first way I read that directive. I added the input string to 0 to numify it anyway, but that got me thinking: we can’t have a sequence starting with 0, but what about negative numbers? I had at first dismissed the idea out-of-hand, but there is one such set of possibilities available, which is with numbers starting like

–10123...

which can break into

-1, 0, 1, 2, 3, ...

satisfying the criteria. I think we can safely consider a single 0 to be just a zero, not a leading zero.

So rather than requiring the input to be positive, we should allow for this outcome somehow.

One very interesting detail is highlighted in the second example, in that the sequential numbers need not be the same number of digits. And as we’re now allowing ourselves to go both up and down with our increments, we could potentially ride that boundary back and forth, which makes our search a little more complicated.

The best way to proceed seems to carve out a number to start a potential sequence, compute those values one greater and one less, and see whether the digits following create either one of these. If so, we repeat the search technique with the new number and the remaining digits. Due to the vagaries of digit lengths it’s unclear how long a sequence can continue, so if we set up the routine recursively we can go until we either run out of sequence or string. Then if these two occurrences happen at the same time we’re in luck.

PERL 5 SOLUTION

We don’t know how long the segments in our solution will end up being, so we’ll need to try first 1-digit numbers, then 2, 3 and so on up to to the ceiling of the half-way point in the length of the number, the longest length that leaves room after for another in a sequence.

I had originally had this as the integer truncation, the floor, being the longest length less than or equal to the half-way point. Except… for that pesky digit boundary that can change our segment length. Say we have the number 1000999. Here the first segment is longer than the second. Switching to the ceiling allow for this edge-case possibility, which can only occur across a descending digit boundary in a two-element sequence.

For the other edge-case we’re allowing, negative numbers, we just need to add one line to let this work:

return if $seg eq '-';

This will jump out of the case where we look at “-” as a number, which would evaluate to 0, which could be followed by 1 and end up with the wrong result. Returning from the routine the outside loop will next try two character segments, which will grab “-1” which parses just fine, and can be followed by 0. Malformed numbers with negative signs n the middle get rejected outright in our earlier numification step so we don’t have to worry about that. It turns out that initial numifying of the base input comes in hand again. I’d left that in already, so our number doesn’t start with a leading 0, from the other possible interpretation of that requirement. Why not? Seems reasonable to me. Now it does dual duty by letting us know input like 10-1-2 isn’t a number we can do addition on. It’s just a warning, mind you; Perl will do its best to treat it as a number, but now will warn us that what we’re working on isn’t numeric.

use warnings;
use strict;
use utf8;
use feature ":5.26";
use feature qw(signatures);
no warnings 'experimental::signatures';

my $num =  $ARGV[0] || '10099';
   $num += 0;
my $out;

my $ceil = length($num) - int(length($num)/2);
for my $group (1..$ceil) {
    if ($out = match_next_segment($num, 0, $group)) {
        say join ',', $out->@*;
        exit;
    }
}
say $num;

sub match_next_segment ($num, $start = 0, $len = 1, $part = []) {
    my $seg = substr $num, $start, $len;
    return if $seg eq '-';
    my @part = ($part->@*, $seg);
    return \@part if $start+$len == length $num;
    for my $next ( $seg+1, $seg-1 ) {
        my $len2 = length $next;
        if ( substr($num, $start+$len, $len2) == $next ) {
            my $sol = match_next_segment($num, $start+$len, $len2, \@part);
            return $sol if defined $sol;
        }        
    }
    return undef;
}

raku solution

unit sub MAIN (Int $num = 10099) ;

my $out ;

for 1..($num.chars/2).ceiling -> $group { 
    if $out = match_next_segment($num, 0, $group) {
        $out.join(',').say;
        return;
    }
}
say $num;

sub match_next_segment ($num, $start = 0, $len = 1, $prev = () ) {
    my $seg = $num.substr: $start, $len;
    my $part = (|$prev, $seg);
    return $part if $num.chars == $start+$len;
    for $seg+1, $seg-1 -> $next {
        my $len2 = $next.chars;
        if $num.substr($start+$len, $len2) == $next  {
            my $sol = match_next_segment($num, $start+$len, $len2, $part);
            return $sol if $sol.defined;
        }        
    }
    return;
}

---

episode two:
“Bopping Them On the Head”

---

task 2

Sum of Squares

Submitted by: Mohammad Meraj Zia

You are given a number $N >= 10.

Write a script to find out if the given number $N is such that sum of squares of all digits is a perfect square. Print 1 if it is otherwise 0.

Example

Input: $N = 34
Ouput: 1 as 3^2 + 4^2 => 9 + 16 => 25 => 5^2

Input: $N = 50
Output: 1 as 5^2 + 0^2 => 25 + 0 => 25 => 5^2

Input: $N = 52
Output: 0 as 5^2 + 2^2 => 25 + 4 => 29

Method

After quite a lot of this writing, I may have finally come to a place where I’ve run out of words. I’m not speechless or dumbstruck, appalled and shocked into mute disgust or anything; it’s just that with the fundamental abstraction behind Perl’s data types — a thing can be a number, a string, or when required magically both — this task is kinda, sorta, super straightforward. Mathematically it might be a bother to extract the individual values of a the digits making up a number, but looked at as a string we can do string stuff and break it up into an array of characters that happen to be digits. Then we look at those characters as digits again to do number stuff, then square them, then sum the squares.

Checking to see whether a number is a perfect square is the most bother: here we’ll truncate the square root and square that and see if we end up where we started. If so our truncation had no effect and our initial value was perfect.

PERL 5 SOLUTION

In Perl this process breaks down into just a couple of lines of code: one to split, square and sum the squares and a second to check the result for square perfection.

use warnings;
use strict;
use utf8;
use feature ":5.26";
use feature qw(signatures);
no warnings 'experimental::signatures';
use List::Util qw( sum );

die "usage:\n ./that-cats-some-square.pl positive-integer \n" unless @ARGV && $ARGV[0] > 0;
my $num = $ARGV[0] ;

my $sum = sum map { $_ ** 2 } split //, $num;
(int(sqrt($sum)))**2 == $sum 
    ? say 1
    : say 0 ;

Raku Solution

In Raku, with method chaining and Unicode exponentiation the results are, I’d say, nothing less than sublime. Yes those are powers of two and yes this works. Thats a “whatever” splat we’re squaring in the .map() method. Sometimes I feel formatting Raku code out on a page is pure poetry.

unit sub MAIN (Int $num where {$num > 0} = 50) ;

my $sum = $num.comb
              .map(*²)
              .sum ;
              
say
$sum == (floor sqrt $sum)² 
    ?? 1
    !! 0 ;

Parker, the softest bun