Merge pull request #1739 from wanderdoc/master

Solutions to challenge 061.

2 files changed, 200 insertions, 0 deletions

diff --git a/challenge-061/wanderdoc/perl/ch-1.pl b/challenge-061/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..39730ed02b
--- /dev/null
+++ b/challenge-061/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,121 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+Given a list of 4 or more numbers, write a script to find the contiguous sublist that has the maximum product. The length of the sublist is irrelevant; your job is to maximize the product.
+Example
+Input: [ 2, 5, -1, 3 ]
+Output: [ 2, 5 ] which gives maximum product 10.
+=cut
+
+
+
+
+
+
+# Assumptions: negative numbers are considered, 
+# there is at least one positive number in the list.
+
+use List::Util qw(reduce);
+my $MIN = -1E9;
+
+my @input = (2, 5, -1, 3, -1, 2, 10, -1, 1000); # (2, 3, -1, 5, -2, -3, 7, 9, 11, 0, -2, 1, 1, 1, 1 ,100 ); # (0, 1, -1, -2);# 
+my ($max_prod, $sublist_pos) = find_sublist(@input);
+
+
+if ( $max_prod > $MIN )
+{
+     my @sublist = @input[split(/ /, $sublist_pos)];
+     print "<@sublist> on indexes <${sublist_pos}> makes ${max_prod} as maximal product.$/";
+}
+
+sub find_sublist
+{
+     my @array = @_;
+     my $max = -1E9;
+
+     my %signs;
+
+
+     $signs{sign($_)}++ for @array;
+     die "At least one positive number required!$/" unless exists $signs{1};
+
+
+     # Special case: complete list.
+     unless (exists $signs{0} )
+     {
+          if ( $signs{1} == scalar @array or $signs{-1} % 2 == 0 )
+
+          {
+               $max = reduce {$a * $b} @array;
+               my $idx_list = join(" ", 0 .. $#array);
+               return ($max, $idx_list);
+
+          }
+     }
+
+
+     # Partitioning of the elements with the same sign.
+
+     my @partition;
+     my @part;
+     for my $idx ( 0 .. $#array )
+
+     {
+          if ( 0 == scalar @part )
+
+          {
+               push @part, $idx;
+          }
+          elsif (same_sign($array[$part[-1]], $array[$idx]))
+          {
+               push @part, $idx;
+
+          }
+
+          else
+          {
+               push @partition, [@part];
+               @part = ();
+               push @part, $idx;
+          }
+          if ( $idx == $#array )
+          {
+
+               push @partition, [@part];
+          }
+     }
+
+     # Products of parts.
+     my %sub_prods = map {$_ => reduce {$a * $b} @array[@{$partition[$_]}] } 
+          0 .. $#partition;
+
+
+     # Combinations of these products.
+     my $max_path = '';
+     for my $idx_1 (0 .. $#partition)
+     {
+          next if ( $sub_prods{$idx_1} == 0 );
+
+          for my $idx_2 ($idx_1 .. $#partition)
+          {
+
+
+               my $this_prod = reduce {$a * $b} @{sub_prods}{$idx_1 .. $idx_2};
+               if ( $this_prod > $max )
+               {
+                    $max = $this_prod;
+                    $max_path = reduce {$a . " " . $b} map @$_, @partition[$idx_1 .. $idx_2];
+               }
+          }
+     }
+
+     return ($max, $max_path);
+
+}
+sub sign {return $_[0] > 0 ? 1 : $_[0] < 0 ? - 1 : 0;}
+sub same_sign
+{
+     return $_[0]*$_[1] > 0;
+}
\ No newline at end of file
diff --git a/challenge-061/wanderdoc/perl/ch-2.pl b/challenge-061/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..766ef99a01
--- /dev/null
+++ b/challenge-061/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,79 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given a string containing only digists (0..9). The string should have between 4 and 12 digits.
+Write a script to print every possible valid IPv4 address that can be made by partitioning the input string.
+For the purposes of this challenge, a valid IPv4 address consists of four "octets", A, B, C, and D, separated by dots (.). Each octet must be between 0 and 255, and must not have any leading zeroes. (e.g., 0 is OK, but 01 is not.)
+
+Example
+
+Input: 25525511135,
+
+Output:
+255.255.11.135
+255.255.111.35
+
+=cut
+
+
+my $string = shift || 25525511135;
+
+find_address($string);
+
+
+
+sub find_address
+{
+     my $string = $_[0];
+     my $str_len = length($string);
+     print "Too short for any valid IPv4 address!$/" 
+          and return unless $str_len > 3;
+     my $counter;
+     my $re = qr/^(?:[0-9]|1[0-9][0-9]|2(?:[0-4][0-9]|[5][0-5])|[1-9][0-9])$/;
+
+     for my $len_A ( 1 .. 3 )
+     {
+          my $oct_A = substr($string, 0, $len_A);
+
+
+          if ( $oct_A =~ $re )
+          {
+               my $pt1 = $len_A;
+
+               B: for my $len_B ( 1 .. 3 )
+               {
+                    last B if ($pt1 + $len_B == $str_len);
+                    my $oct_B = substr($string, $pt1, $len_B);
+
+                    if ( $oct_B =~ $re )
+                    {
+                         my $pt2 = $pt1 + $len_B;
+                         C: for my $len_C ( 1 .. 3 )
+                         {
+                              last C if (
+                                   ($pt2 == $str_len) or ($pt2 + $len_C == $str_len)
+                              );
+
+                              my $oct_C = substr($string, $pt2, $len_C); 
+                              my $pt3 = $pt2 + $len_C;
+
+                              if ( $pt3 < $str_len )
+                              {
+                                   my $oct_D = substr($string, $pt3);
+                                   if ( $oct_C =~ $re and $oct_D =~ $re )
+                                   {
+
+                                        print join('.', $oct_A, $oct_B, $oct_C, $oct_D), $/;
+                                        $counter++;
+                                   }
+                              }
+                         }
+                    }
+               }
+          }
+
+     }
+     print "No valid IPv4 address found!$/" unless $counter;
+}
\ No newline at end of file