Merge pull request #5220 from PerlBoy1967/branch-for-challenge-138

Task 1

2 files changed, 136 insertions, 0 deletions

diff --git a/challenge-138/perlboy1967/perl/ch-1.pl b/challenge-138/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..0b8d525455
--- /dev/null
+++ b/challenge-138/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,50 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 138
+ - https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/#TASK1
+
+Author: Niels 'PerlBoy' van Dijke
+
+TASK #1 › Workdays
+Submitted by: Mohammad S Anwar
+
+You are given a year, $year in 4-digits form.
+
+Write a script to calculate the total number of workdays in the given year.
+
+ ||  For the task, we consider, Monday - Friday as workdays.
+
+=cut
+
+use v5.16;
+use strict;
+use warnings;
+
+use Date::Calc qw(Day_of_Week Week_of_Year);
+
+use Test::More;
+
+my %tests = (
+  2000 => 260, 2001 => 261, 2002 => 261, 2003 => 261,
+  2004 => 262, 2005 => 260, 2006 => 260, 2007 => 261,
+  2008 => 262, 2009 => 261, 2010 => 261, 2011 => 260,
+  2012 => 261, 2013 => 261, 2014 => 261, 2015 => 261,
+  2016 => 261, 2017 => 260, 2018 => 261, 2019 => 261,
+  2020 => 262, 2021 => 261, 2022 => 260, 2023 => 260,
+  2024 => 262, 2025 => 261, 2026 => 261, 2027 => 261,
+);
+
+foreach my $y (sort { $a <=> $b } keys %tests) {
+  my ($dayOfWeek1,$dayOfWeek2) = (Day_of_Week($y,1,1),Day_of_Week($y,12,31));
+
+  my $workingDays = 262;
+  $workingDays-- if ($dayOfWeek1 > 5);
+  $workingDays-- if ($dayOfWeek2 > 5);
+  $workingDays-- if ($dayOfWeek1 == $dayOfWeek2 and $dayOfWeek1 < 6);
+
+  is($workingDays,$tests{$y},"year=$y");
+}
+
+done_testing;
diff --git a/challenge-138/perlboy1967/perl/ch-2.pl b/challenge-138/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..46af363c10
--- /dev/null
+++ b/challenge-138/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,86 @@
+#!/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]],
+  1296 => [1,[1,29,6]],
+  2025 => [1,[20,25]],
+  3025 => [1,[30,25]],
+  6724 => [1,[6,72,4]],
+  8281 => [1,[8,2,81]],
+  9801 => [1,[98,0,1]],
+ 55225 => [1,[5,5,225]],
+ 88209 => [1,[88,209]],
+);
+
+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);
+    }
+  }
+}
+