Merge pull request #6386 from PerlBoy1967/branch-for-challenge-171

w171 - Task 1 & 2

2 files changed, 85 insertions, 0 deletions

diff --git a/challenge-171/perlboy1967/perl/ch-1.pl b/challenge-171/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..707514e6c8
--- /dev/null
+++ b/challenge-171/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,43 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 171 - Task 1
+ - https://theweeklychallenge.org/blog/perl-weekly-challenge-171/#TASK1
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 1: Abundant Number
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 20 Abundant Odd Numbers.
+
+According to wikipedia,
+
+ || A number n for which the sum of divisors σ(n) > 2n, or, equivalently, 
+ || the sum of proper divisors (or aliquot sum) s(n) > n.
+
+=cut
+
+use v5.16;
+use warnings;
+
+use List::Util qw(sum0);
+use Math::Factor::XS qw(factors);
+
+# Prototype(s)
+sub isOddAbudant ($);
+
+
+my ($i,$n) = (1,1);
+while ($i <= 20) {
+  if (isOddAbudant($n)) {
+    say "$i\t$n"; $i++;
+  }
+  $n += 2;
+}
+
+
+sub isOddAbudant ($) {
+  return $_[0] % 2 && sum0(factors($_[0])) > $_[0];
+}
diff --git a/challenge-171/perlboy1967/perl/ch-2.pl b/challenge-171/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..229afaf736
--- /dev/null
+++ b/challenge-171/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,42 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 171 - Task 2
+ - https://theweeklychallenge.org/blog/perl-weekly-challenge-171/#TASK2
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 2: First-class Function
+Submitted by: Mohammad S Anwar
+
+Create sub compose($f, $g) which takes in two parameters $f and $g as subroutine
+refs and returns subroutine ref i.e. compose($f, $g)->($x) = $f->($g->($x))
+
+=cut
+
+use v5.16;
+use warnings;
+
+use List::Util qw(sum);
+use List::MoreUtils qw(apply);
+
+sub compose ($$);
+
+my $f = \&sum;
+my $g = sub { apply { $_ *= 2 } @_ };
+my @list1 = (1,2,3);
+my @list2 = (2,3,4);
+
+say compose($f,$g)->(@list1);
+say $f->($g->(@list1));
+
+$g = sub { apply { $_ *= 3 } @_ };
+say $f->($g->(@list2));
+say compose($f,$g)->(@list2);
+
+sub compose ($$) {
+  my $f = shift; die unless ref($f) eq 'CODE';
+  my $g = shift; die unless ref($g) eq 'CODE';
+  sub { $f->($g->(@_)) };
+}