- Added Perl solutions to Challenge #065.

4 files changed, 252 insertions, 0 deletions

diff --git a/challenge-065/mohammad-anwar/perl/ch-1.pl b/challenge-065/mohammad-anwar/perl/ch-1.pl
new file mode 100644
index 0000000000..50d73236cd
--- /dev/null
+++ b/challenge-065/mohammad-anwar/perl/ch-1.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+
+#
+# Perl Weekly Challenge - 065
+#
+# Task #1: Digits Sum
+#
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-065/
+#
+
+use strict;
+use warnings;
+
+use List::Util qw(sum);
+
+my $N = $ARGV[0] || 2;
+my $S = $ARGV[1] || 4;
+
+print sprintf("%s\n", join(", ", find_numbers($N, $S)));
+
+sub find_numbers {
+    my ($digits, $sum) = @_;
+
+    die "ERROR: Missing digits.\n" unless defined $digits;
+    die "ERROR: Missing sum.\n"    unless defined $sum;
+
+    die "ERROR: Invalid digits [$digits].\n" unless ($digits =~ /^[0-9]+$/);
+    die "ERROR: Invalid sum [$sum].\n"       unless ($sum    =~ /^[0-9]+$/);
+
+    my $start = sprintf("%d", '1' . '0' x ($digits-1));
+    my $end   = sprintf("%d", '9' x $digits);
+    --$start;
+
+    my @numbers;
+    while (++$start <= $end) {
+
+        my @digits = split //, $start;
+        next if (grep { $_ > $sum } @digits);
+
+        my $SUM = sum @digits;
+        next if ($SUM != $sum);
+
+        push @numbers, $start;
+    }
+
+    return @numbers;
+}
diff --git a/challenge-065/mohammad-anwar/perl/ch-1a.pl b/challenge-065/mohammad-anwar/perl/ch-1a.pl
new file mode 100644
index 0000000000..15f4055d06
--- /dev/null
+++ b/challenge-065/mohammad-anwar/perl/ch-1a.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+#
+# Perl Weekly Challenge - 065
+#
+# Task #1: Digits Sum
+#
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-065/
+#
+
+use strict;
+use warnings;
+
+use Test::More;
+use List::Util qw(sum);
+
+is sprintf("%s", join(", ", find_numbers(2, 4))),
+   "13, 22, 31, 40",
+   "\$N=2 \$S=4";
+is sprintf("%s", join(", ", find_numbers(3, 26))),
+   "899, 989, 998",
+   "\$N=3 \$S=26";
+is sprintf("%s", join(", ", find_numbers(3, 30))),
+   "",
+   "\$N=3 \$S=30";
+
+done_testing;
+
+sub find_numbers {
+    my ($digits, $sum) = @_;
+
+    die "ERROR: Missing digits.\n" unless defined $digits;
+    die "ERROR: Missing sum.\n"    unless defined $sum;
+
+    die "ERROR: Invalid digits [$digits].\n" unless ($digits =~ /^[0-9]+$/);
+    die "ERROR: Invalid sum [$sum].\n"       unless ($sum    =~ /^[0-9]+$/);
+
+    my $start = sprintf("%d", '1' . '0' x ($digits-1));
+    my $end   = sprintf("%d", '9' x $digits);
+    --$start;
+
+    my @numbers;
+    while (++$start <= $end) {
+
+        my @digits = split //, $start;
+        next if (grep { $_ > $sum } @digits);
+
+        my $SUM = sum @digits;
+        next if ($SUM != $sum);
+
+        push @numbers, $start;
+    }
+
+    return @numbers;
+}
diff --git a/challenge-065/mohammad-anwar/perl/ch-2.pl b/challenge-065/mohammad-anwar/perl/ch-2.pl
new file mode 100644
index 0000000000..a6b7a3df31
--- /dev/null
+++ b/challenge-065/mohammad-anwar/perl/ch-2.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+
+#
+# Perl Weekly Challenge - 065
+#
+# Task #2: Palindrome Partition
+#
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-065/
+#
+
+use strict;
+use warnings;
+
+use Algorithm::Combinatorics qw(partitions);
+
+my $palindromes = find_palindromes($ARGV[0]);
+print sprintf("%s\n", join(", ", @$_)) for @$palindromes;
+
+sub find_palindromes {
+    my ($string) = @_;
+
+    die "ERROR: Missing string.\n"
+        unless defined $string;
+    die "ERROR: String must have 2 or more alphabets. [$string]\n"
+        unless (length($string) >= 2);
+
+    my @partitions = partitions([split //, $string]);
+    my %partitions = ();
+
+    foreach my $entry (@partitions) {
+        foreach my $partition (@$entry) {
+            my $str = join ("", @$partition);
+            next if (length($str) == 1
+                     ||
+                     length($str) == length($string)
+                    );
+
+            if (index($string, $str) >= 0) {
+                $partitions{$str} = index($string, $str);
+            }
+        }
+    }
+
+    my $index = 0;
+    my $palindromes     = [];
+    my %seen_partitions = ();
+    foreach my $primary (sort { $partitions{$a} <=> $partitions{$b} }
+                         sort keys %partitions) {
+        next unless ($primary eq reverse($primary));
+        next if (exists $seen_partitions{$primary});
+
+        push @{$palindromes->[$index]}, $primary;
+        foreach my $secondary (sort keys %partitions) {
+            next unless ($secondary eq reverse($secondary));
+
+            if ($partitions{$secondary} >= $partitions{$primary} + length($primary)) {
+                push @{$palindromes->[$index]}, $secondary;
+                $seen_partitions{$secondary} = 1;
+            }
+        }
+        $index++;
+    }
+
+    push @{$palindromes->[scalar @$palindromes]}, $string
+        if ($string eq reverse($string));
+
+    return $palindromes;
+}
diff --git a/challenge-065/mohammad-anwar/perl/ch-2a.pl b/challenge-065/mohammad-anwar/perl/ch-2a.pl
new file mode 100644
index 0000000000..fd48d6e264
--- /dev/null
+++ b/challenge-065/mohammad-anwar/perl/ch-2a.pl
@@ -0,0 +1,82 @@
+#!/usr/bin/perl
+
+#
+# Perl Weekly Challenge - 065
+#
+# Task #2: Palindrome Partition
+#
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-065/
+#
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Deep;
+use Algorithm::Combinatorics qw(partitions);
+
+is_deeply find_palindromes('aabaab'),
+          [['aa','baab'],['aabaa'],['aba']],
+          'aabaab';
+is_deeply find_palindromes('abbaba'),
+          [['abba'],['bb','aba'],['bab']],
+          'abbaba';
+is_deeply find_palindromes('aa'),
+          [['aa']],
+          'aa';
+is_deeply find_palindromes('ab'),
+          [],
+          'ab';
+
+done_testing;
+
+sub find_palindromes {
+    my ($string) = @_;
+
+    die "ERROR: Missing string.\n"
+        unless defined $string;
+    die "ERROR: String must have 2 or more alphabets. [$string]\n"
+        unless (length($string) >= 2);
+
+    my @partitions = partitions([split //, $string]);
+    my %partitions = ();
+
+    foreach my $entry (@partitions) {
+        foreach my $partition (@$entry) {
+            my $str = join ("", @$partition);
+            next if (length($str) == 1
+                     ||
+                     length($str) == length($string)
+                    );
+
+            if (index($string, $str) >= 0) {
+                $partitions{$str} = index($string, $str);
+            }
+        }
+    }
+
+    my $index = 0;
+    my $palindromes     = [];
+    my %seen_partitions = ();
+    foreach my $primary (sort { $partitions{$a} <=> $partitions{$b} }
+                         sort keys %partitions) {
+        next unless ($primary eq reverse($primary));
+        next if (exists $seen_partitions{$primary});
+
+        push @{$palindromes->[$index]}, $primary;
+        foreach my $secondary (sort keys %partitions) {
+            next unless ($secondary eq reverse($secondary));
+
+            if ($partitions{$secondary} >= $partitions{$primary} + length($primary)) {
+                push @{$palindromes->[$index]}, $secondary;
+                $seen_partitions{$secondary} = 1;
+            }
+        }
+        $index++;
+    }
+
+    push @{$palindromes->[scalar @$palindromes]}, $string
+        if ($string eq reverse($string));
+
+    return $palindromes;
+}