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);
+    }
+  }
+}
+