- Added solutions by Wanderdoc.

2 files changed, 134 insertions, 0 deletions

diff --git a/challenge-051/wanderdoc/perl/ch-1.pl b/challenge-051/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..aeeabe31ba
--- /dev/null
+++ b/challenge-051/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,69 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+Given an array @L of integers. Write a script to find all unique triplets such that a + b + c is same as the given target T. Also make sure a <= b <= c.
+Example: @L = (-25, -10, -7, -3, 2, 4, 8, 10);
+One such triplet for target 0 i.e. -10 + 2 + 8 = 0.
+=cut
+
+
+
+
+my @L = (-25, -10, -7, -3, 2, 4, 8, 10);
+my $target = 0;
+
+my @triplets = find_triplets(\@L, $target);
+print_result(@triplets);
+
+
+sub find_triplets
+{
+     my @arr = sort { $a <=> $b } @{$_[0]};
+     my $t = $_[1];
+     my @result;
+
+     for my $pt1 ( 0 .. $#arr )
+     {
+          next if $pt1 > 0 and $arr[$pt1] == $arr[$pt1 - 1];
+          my $pt2 = $pt1 + 1;
+          my $pt3 = $#arr;
+          while ( $pt2 < $pt3 )
+          {
+               if ( $arr[$pt1] + $arr[$pt2] + $arr[$pt3] == $t )
+               {
+                    push @result, [$arr[$pt1], $arr[$pt2], $arr[$pt3]];
+                    $pt2++; 
+               }
+
+
+               elsif ( $arr[$pt1] + $arr[$pt2] + $arr[$pt3] < $t )
+               {
+                    $pt2++;
+               }
+               else
+               {
+                    $pt3--;
+               }
+
+          }
+     }
+     return @result;
+}
+
+sub print_result
+{
+     my @arr = @_;
+
+     if ( 0 == @arr )
+     {
+          print "No elements!\n";
+     }
+
+     else
+     {
+          print join(" ", @$_), $/ for @arr;
+
+     }
+}
\ No newline at end of file
diff --git a/challenge-051/wanderdoc/perl/ch-2.pl b/challenge-051/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..aa0b102f8e
--- /dev/null
+++ b/challenge-051/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,65 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+Write a script to display all Colorful Number with 3 digits.
+A number can be declare Colorful Number where all the products of consecutive subsets of digit are different.
+For example, 263 is a Colorful Number since 2, 6, 3, 2x6, 6x3, 2x6x3 are unique.
+=cut
+
+use List::Util qw(reduce uniq);
+
+
+
+my %DEBUG_STORE;
+
+sub prod_con_subsets
+{
+     my $num = $_[0];
+     my $len = length($num);
+     my @set;
+     for my $width (1 .. $len)
+     {
+          for my $pos ( 0 .. $len )
+          {
+
+               my $chunk = substr($num, $pos, $width);
+               if ( length($chunk) == $width )
+               {
+                    push @set, $chunk;
+               }
+          }
+     }
+
+     my @products = _products(@set);
+     $DEBUG_STORE{$num} = [@products];
+     return @products;
+}
+
+
+sub _products
+{
+     my @arr = @_;
+
+     my @products = map {my $el = $_; 
+          my $res = length($el) == 1 ? $el :
+          reduce{$a * $b} split(//,$el)} @arr;
+     return @products;
+
+}
+
+sub is_colorful
+{
+     my $num = $_[0];
+     my @arr = prod_con_subsets($num);
+     return scalar @arr == scalar uniq @arr;
+}
+
+my $counter;
+for my $num ( 100 .. 999 )
+{
+     next if $num =~ /[01]/; # cannot be colorful if contains 0 or 1.
+     print "The Nr.", ++$counter, ' is ', $num, '; Proof: ', join(" ", @{$DEBUG_STORE{$num}}), $/ if is_colorful($num);
+
+}
\ No newline at end of file