diff options
| author | Niels van Dijke <perlboy@cpan.org> | 2021-11-15 00:13:23 +0000 |
|---|---|---|
| committer | Niels van Dijke <perlboy@cpan.org> | 2021-11-15 00:13:23 +0000 |
| commit | 125a2addeb2919841cab724b6bca32accf6d2d52 (patch) | |
| tree | c3f3c724c982ef4db1558c324a5a8dc245ef8b66 | |
| parent | dc51668c420ce3232aa5060aa9b569585ab8974b (diff) | |
| download | perlweeklychallenge-club-125a2addeb2919841cab724b6bca32accf6d2d52.tar.gz perlweeklychallenge-club-125a2addeb2919841cab724b6bca32accf6d2d52.tar.bz2 perlweeklychallenge-club-125a2addeb2919841cab724b6bca32accf6d2d52.zip | |
Task 1 & 2
| -rwxr-xr-x | challenge-138/perlboy1967/perl/ch-2.pl | 79 |
1 files changed, 79 insertions, 0 deletions
diff --git a/challenge-138/perlboy1967/perl/ch-2.pl b/challenge-138/perlboy1967/perl/ch-2.pl new file mode 100755 index 0000000000..4cbf782274 --- /dev/null +++ b/challenge-138/perlboy1967/perl/ch-2.pl @@ -0,0 +1,79 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 138 + - https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/#TASK2 + +Author: Niels 'PerlBoy' van Dijke + +TASK #2 › Split Number +Submitted by: Mohammad S Anwar + +You are given a perfect square. + +Write a script to figure out if the square root the given number is same as sum of 2 or more splits of the given number. + +=cut + +use v5.16; +use strict; +use warnings; + +use List::Util qw(sum); + +use Test::More; +use Test::Deep qw(cmp_deeply); + +# Protoptype(s) +sub isSplitNumber($); +sub _isSN($$\@); + +my %tests = ( + 25 => [0,[]], + 36 => [0,[]], + 81 => [1,[8,1]], + 9801 => [1,[98,0,1]], +); + +foreach my $n (sort { $a <=> $b } keys %tests) { + cmp_deeply(isSplitNumber($n),$tests{$n},"n=$n"); +} + +done_testing; + +sub isSplitNumber($) { + my ($n) = @_; + + my $iSqrt = int(sqrt($n)); + return [0,[]] if ($iSqrt != sqrt($n)); + + for my $i (1 .. length($n) - 1) { + my $j = $n; + my $r = substr($j,0,$i,''); + my @return = ($r); + if (_isSN($iSqrt,$j,@return)) { + return [1, [@return]]; + } + } + + return [0,[]]; +} + +sub _isSN ($$\@) { + my ($s,$n,$ar) = @_; + + if ($n !~ m#^0# && sum(@$ar,$n) == $s) { + push(@$ar,$n); + return 1; + } else { + for my $i (1 .. length($n) - 1) { + my $j = $n; + my $r = substr($j,0,$i,''); + push(@$ar,$r); + return 1 if _isSN($s,$j,@$ar); + pop(@$ar); + } + } +} + |
