Task 1 & 2

2 files changed, 152 insertions, 0 deletions

diff --git a/challenge-136/perlboy1967/perl/ch-1.pl b/challenge-136/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..0fd84eef77
--- /dev/null
+++ b/challenge-136/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+=pod
+
+Perl Weekly Challenge - 136
+ - https://perlweeklychallenge.org/blog/perl-weekly-challenge-136/#TASK1
+
+Author: Niels 'PerlBoy' van Dijke
+
+TASK #1 › Two Friendly
+Submitted by: Mohammad S Anwar
+
+You are given 2 positive numbers, $m and $n.
+
+Write a script to find out if the given two numbers are Two Friendly.
+
+ ||   Two positive numbers, m and n are two friendly when gcd(m, n) = 2 ^ p where p > 0. 
+ ||   The greatest common divisor (gcd) of a set of numbers is the largest positive number 
+ ||   that divides all the numbers in the set without remainder.
+
+=cut
+
+use v5.16;
+use strict;
+use warnings;
+
+# Prototype
+sub gcd($$);
+
+# Unbuffered STDOUT
+$|++;
+
+use Scalar::Util qw(looks_like_number);
+
+my ($M, $N) = @ARGV;
+
+die "Please provide two positive integer numbers"
+  unless (looks_like_number($M) and $M > 0 and $M == int($M) and
+          looks_like_number($N) and $N > 0 and $N == int($N));
+
+my $gcd = gcd($M,$N); 
+my $exponent = log($gcd)/log(2);
+my $isTwoFriendly = (int($exponent) == $exponent) && ($exponent > 0);
+
+printf "Input: m = %d, n = %d\n", $M, $N;
+printf "Output: %d\n", $isTwoFriendly;
+printf "Reason: gcd(%d,%d) = %d %s\n", $M, $N, $gcd, 
+        ($isTwoFriendly ? sprintf(' => 2 ^ %d', $exponent) : '');
+
+
+sub gcd ($$) {
+  return 0 == $_[1] ? $_[0] : gcd($_[1], $_[0] % $_[1]);
+} 
diff --git a/challenge-136/perlboy1967/perl/ch-2.pl b/challenge-136/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..06e5609d91
--- /dev/null
+++ b/challenge-136/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,99 @@
+#!/usr/bin/perl
+
+=pod
+
+Perl Weekly Challenge - 136
+ - https://perlweeklychallenge.org/blog/perl-weekly-challenge-136/#TASK2
+
+Author: Niels 'PerlBoy' van Dijke
+
+TASK #2 › Fibonacci Sequence
+Submitted by: Mohammad S Anwar
+
+You are given a positive number $n.
+
+Write a script to find how many different sequences you can create using Fibonacci numbers where the sum of unique numbers in each sequence are the same as the given number.
+
+  ||    Fibonacci Numbers: 1,2,3,5,8,13,21,34,55,89, …
+
+NOTE: This script is a 100% copy of week 77, task 1!
+
+=cut
+
+use v5.16;
+use strict;
+use warnings;
+
+# Unbuffered STDOUT
+$|++;
+
+use Algorithm::Combinatorics qw(combinations);
+use List::Util qw(sum);
+use Memoize;
+
+# Prototypes
+sub fibonacci ($);
+sub getFibonacciNumbersSmallerN ($);
+sub findFibonacciSumSolutions ($\@\@);
+
+memoize('fibonacci');
+
+my ($N) = @ARGV;
+
+die "Input must be integer value and >= 2"
+  unless (defined $N and $N =~ m#^[1-9][0-9]*$# and $N >= 2);
+
+my @solutions;
+
+my @fib = getFibonacciNumbersSmallerN($N);
+findFibonacciSumSolutions($N, @solutions, @fib);
+
+print "Input:\n";
+printf "\t%s = %d\n\n", '$N', $N;
+
+print "Output:\n";
+if (scalar @solutions) {
+  printf "\t%d as the sum of Fibonacci numbers (%s) is same as input number.\n",
+          scalar(@solutions), 
+          join(', ', map { '['.join(',',@$_).']' } @solutions);
+} else {
+  print "\tNo solution can be found.\n";
+}
+
+
+sub fibonacci ($) {
+  my ($n) = @_;
+
+  return 1 if ($n == 1 or $n == 2);
+
+  return fibonacci($n - 1) + fibonacci($n - 2);
+}
+
+
+sub getFibonacciNumbersSmallerN ($) {
+  my ($n) = @_;
+
+  my @fib;
+
+  my $i = 2;
+  my $f;
+
+  while ($f = fibonacci($i++) and $f < $n) {
+    push(@fib, $f);
+  }
+
+  return @fib;
+}
+
+
+sub findFibonacciSumSolutions($\@\@) {
+   my ($n, $arSol, $arFib) = @_;
+
+   foreach my $level (1 .. scalar @$arFib) {
+     my $iter = combinations($arFib, $level);
+     while (my $arCombi = $iter->next) {
+       push(@$arSol, $arCombi) 
+        if (sum(@$arCombi) == $n);
+     }
+  }
+}