# Perl Weekly Challenge 116.

My solutions (task 1, and task 2) to the The Weekly Challenge - 116.

``````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.
``````

I guess it is faster to construct the sequence from a given starting number than producing all the possible sets of digits and testing them for a sequence of numbers.

Given a number N with digits abc…xyz I can make a number with the first digits, say α=abc and check if the remaining digits “def…” contain the next number α+1. If I succed with the digits “pqr”, I remove them so that now I have a consecutive sequence, say (α,α+1) and two remaining numbers def…mno and stu…xyz. Now I can search for α+2 in the remaining numbers until the search space is depleted or until I fail. In the latter case, I look for α-1, α-2. If I fail, I can backtrack, try new candidate numbers, start removing the largest numbers from the sequence, try changing the length of the initial sequence or finally, give up. I assume that the sequence must have at least two numbers, as it is always possible to find a degenerate consecutive sequence of only one element (the initial number). I use iterators. One splits a given number in all possible ways into a three pieces: the desired target, the digits before the target and the digits that follow the target. The other does something similar but for all the current number fragments. I guess it is faster to try first solutions with big numbers.

``````# Perl weekly challenge 116
#
use strict;
use warnings;
use POSIX qw(ceil);
use v5.12;

my @digits=@ARGV;
die "Usage ./ch-1.pl digits1 [digits2...]" unless @digits;
foreach(@digits){
warn("Expected >=10"), next unless \$_>=10;
my @sequence=find_sequence(\$_);
say "Input: \$_";
say "Output: ", @sequence? join ",", @sequence:\$_;
}
sub find_sequence {
my \$digits=shift;
my \$max=ceil length(\$digits)/2;
foreach(reverse 1..\$max){ #from large to small starting numbers
my @result=find_sequence_initial_size(\$digits, \$_);
return @result if @result;
}
return;
}
sub find_sequence_initial_size {
my (\$digits, \$size)=@_;
my \$first=substr \$digits,0,\$size,"";
#Search upwards first and downwards next
my \$result=increasing([\$first],[\$digits]);
return @\$result if \$result;
return;
}

sub increasing {
my (\$current, \$rest)=@_;  # current sequence and remaining fragments
my \$next=\$current->[-1]+1; # next number in sequence
my @next=(@\$current, \$next); # next sequence if succesful
my \$iterator=try_many(\$next, @\$rest); #find \$next number in @rest
while(my \$remaining=\$iterator->()){ # match?
my @remaining=@\$remaining;
return [@next] if @remaining==0; #exhausted digits?
my \$attempt=increasing([@next], [@\$remaining]); # recurse
return \$attempt if defined \$attempt; #finished?
\$attempt=decreasing([@next],[@\$remaining]); #grow in opposite dir.
return \$attempt if defined \$attempt; #success?
}
return decreasing(\$current, \$rest); # backtrack and try opposite dir.
}

sub decreasing {
my (\$current, \$rest)=@_;  # current sequence and remaining fragments
my \$previous=\$current->-1; # previous number in sequence
return if \$previous < 0; # failure. No negatives.
my @next=(\$previous, @\$current); #next sequence if succesful
my \$iterator=try_many(\$previous, @\$rest);
while(my \$remaining=\$iterator->()){ #match?
my @remaining=@\$remaining;
return [@next] if @remaining==0; #finished
my \$attempt=decreasing([@next], [@remaining]); #recurse
return \$attempt if defined \$attempt; #success
}
return; #failure
}

sub try_many { # returns iterator to search \$target within @numbers in all possible ways
my (\$target, @numbers)=@_;
die "Expected one or more numbers" unless @numbers>=1;
my \$current=0;
my \$iterate=try_one(\$target, \$numbers[\$current]);
sub {
while(\$current<@numbers){
my @next=\$iterate->();
#return array of remaining fragments, filtering out empty strings
return [grep {\$_ ne ""} (@numbers[0..\$current-1],@next, @numbers[\$current+1..@numbers-1])] if @next;
++\$current;
\$iterate=try_one(\$target, \$numbers[\$current]) if \$current < @numbers;
}
return;
}
}

sub try_one {
my (\$target, \$digits)=@_; # iterator to split target from \$digits in all possible ways
my \$length=length \$target;
die "Expect positive length" unless \$length > 0;
my \$index=-1; #index of \$target in \$digits
sub {
\$index=index \$digits, \$target, \$index+1;
return unless \$index >=0;
return (substr(\$digits,0,\$index), substr(\$digits, \$index+\$length));
}
}
``````

Examples:

``````./ch-1.pl 1234 91011 10203
``````

Results:

``````Input: 1234
Output: 1,2,3,4
Input: 91011
Output: 9,10,11
Input: 10203
Output: 10203
``````

I realize that I might have misread the statement of the problem, so that my program succeeds even if succesive fragments are not contiguous in the input. For example:

``````./ch-1.pl 4321 1243 9991000 791113151412108
``````

Results:

``````Input: 4321
Output: 1,2,3,4
Input: 1243
Output: 1,2,3,4
Input: 9991000
Output: 999,1000
Input: 791113151412108
Output: 7,8,9,10,11,12,13,14,15
``````

This made the problem unnecessarily difficult, but more interesting.

# 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
``````

Split, square, add, root=>integer=success. It’s a one-liner:

``````perl -MList::Util=sum0 -MPOSIX=round -E 'map {\$x=sqrt(sum0 map {\$_**2} split "",\$_); say "Input: \$_\nOutput: ", \$x==round(\$x)?1:0;} @ARGV' 34 50 52
``````

Results:

``````Input: 34
Output: 1
Input: 50
Output: 1
Input: 52
Output: 0
``````

The longer version:

``````# Perl weekly challenge 116
# Task 2: Sum of squares
#
use strict;
use warnings;
use List::Util qw(sum0);
use POSIX qw(round);
use v5.12;

foreach(@ARGV){
my \$x=sqrt(sum0 map {\$_**2} split '',\$_);
say "Input: \$_\nOutput: ", \$x==round(\$x)?1:0;
}
``````

Examples:

``````./ch-2.pl 34 50 52
``````

Results:

``````Input: 34
Output: 1
Input: 50
Output: 1
Input: 52
Output: 0
``````
Written on June 11, 2021