Perl Weekly Challenge 116.
My solutions (task 1, and task 2) to the The Weekly Challenge - 116.
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.
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
# Task 1: Number sequence
#
# See https://wlmb.github.io/2021/06/11/PWC116/#task-1-number-sequence
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->[0]-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
#
# See https://wlmb.github.io/2021/06/11/PWC116/#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