Merge pull request #1755 from PerlBoy1967/new-branch

Perl Weekly Challenge #61 contribution.

3 files changed, 193 insertions, 0 deletions

diff --git a/challenge-061/PerlBoy1967/README b/challenge-061/PerlBoy1967/README
new file mode 100644
index 0000000000..ae244a43c7
--- /dev/null
+++ b/challenge-061/PerlBoy1967/README
@@ -0,0 +1 @@
+Solution by Niels van Dijke.
diff --git a/challenge-061/PerlBoy1967/perl/ch-1.pl b/challenge-061/PerlBoy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..3717d09c11
--- /dev/null
+++ b/challenge-061/PerlBoy1967/perl/ch-1.pl
@@ -0,0 +1,109 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 061 - Task 1
+#
+# Author: Niels 'PerlBoy' van Dijke
+#
+# Usage:
+#   perl ch-1.pl < number_list_file
+#
+# Challenge:
+# 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.
+
+use strict;
+use warnings;
+
+my @listOfLists;
+
+# Read the number list
+while (<DATA>) {
+  s/#.*//;
+  s/^\s*(.*?)\s*$/$1/;
+
+  my @l = split(/\s+/);
+
+  push(@listOfLists,\@l) if (scalar(@l));
+}
+
+foreach my $list (@listOfLists) {
+  # Deref for easier editing ;-)
+  my @list = @$list;
+
+  my ($maxLeftIdx, $lIdx) = (0, 0);
+  my ($maxRightIdx, $rIdx)  = (1, 1);
+
+  # Initially the first two factors are the first maximum
+  my $maxProduct = $list[$lIdx] * $list[$rIdx];
+
+  my $tmpProduct = $maxProduct;
+
+  # Go for a 'C' like style solution with 'pointers'
+  while ($rIdx < scalar(@list) - 1) {
+    while ($rIdx < scalar(@list) - 1 and 
+           $tmpProduct * $list[$rIdx + 1] > $tmpProduct) {
+      $tmpProduct *= $list[$rIdx + 1];
+      $rIdx++;
+    }
+
+    # New maximum product found?
+    # If so keep value and indexes
+    if ($tmpProduct > $maxProduct) {
+      ($maxProduct, $maxLeftIdx, $maxRightIdx) = ($tmpProduct, $lIdx, $rIdx);
+    }
+
+    # List exhausted?
+    last if ($rIdx == scalar(@list) - 1);
+
+    # Last factor must have been 0 or smaller to make the running 
+    # product smaller then its predecessor.
+    #
+    # Set 'pointers' to new starting point
+    if ($list[$rIdx + 1] == 0) {
+      # If 0 then maximum is (potentially) at the right
+      $rIdx += 2;
+    } else {
+      $rIdx++;
+    }
+
+    # List exhausted?
+    last if ($rIdx == scalar(@list) - 1);
+
+    $lIdx = $rIdx - 1; 
+
+    # Calculate the new potential maximum
+    $tmpProduct = $list[$lIdx] * $list[$rIdx];
+  }
+
+  # New maximum product found?
+  # If so keep value and indexes
+  if ($tmpProduct > $maxProduct) {
+    ($maxProduct, $maxLeftIdx, $maxRightIdx) = ($tmpProduct, $lIdx, $rIdx);
+  }
+
+  print "# ------------------------------------------------------------------\n";
+  printf "Input: [ %s ]\n", join(', ', @list);
+  printf "Output: [ %s ] which gives maximum product %d\n",
+          join(', ', @list[$maxLeftIdx .. $maxRightIdx]), $maxProduct;
+  print "# ------------------------------------------------------------------\n";
+}
+
+# The rest of the file is test sets
+__DATA__
+ 2  5 -1  3 
+ 3  1  0  6  1  2
+ 3 -1 -2 -1  5  1
+-2  3  0  5 -1 -2
+-3  2  0  0 -5 -3
+-4 -1 -8  0  1  7
+ 5 -1  0  1  1
+ 1 -9  1 -1  1  2
+ 1 -5  1  0 -5  1  2
+ 1 -4  1  2 
diff --git a/challenge-061/PerlBoy1967/perl/ch-2.pl b/challenge-061/PerlBoy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..0fc7dc4c36
--- /dev/null
+++ b/challenge-061/PerlBoy1967/perl/ch-2.pl
@@ -0,0 +1,83 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 061 - Task 2
+#
+# Author: Niels 'PerlBoy' van Dijke
+#
+# Note:
+#   The input should be one 'ip number' per line
+#
+# Challenge:
+#
+# You are given a string containing only digits (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 purpose of this challenge, a valid IPv4 address consists of four “octets” i.e. 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
+
+
+use strict;
+use warnings;
+
+# Define octet regexp options
+my %d = (
+  1 => '\d',
+  2 => '[1-9]\d',
+  3 => '1\d\d|2[0-4][0-9]|25[0-5]',
+);
+
+my %re;
+
+# Build regexp hash arrays
+for my $a (1..3) {
+  for my $b (1..3) {
+    my $ab = $a + $b;
+    for my $c (1..3) {
+      my $abc = $ab + $c;
+      for my $d (1..3) {
+        my $abcd = $abc + $d;
+        push(@{$re{$abcd}},"($d{$a})($d{$b})($d{$c})($d{$d})");
+      }
+    }
+  }
+} 
+
+while(<DATA>) {
+  if (my ($ipnum) = $_ =~ m#(\d{4,12})#) {
+
+    my $len = length($ipnum);
+
+    print "$ipnum:\n";
+    study($ipnum);
+    foreach my $re (@{$re{$len}}) {
+      if ($ipnum =~ m#^$re$#) {
+        print "\t".join('.', $1, $2, $3, $4)."\n";
+      }
+    }
+  }
+}
+
+__DATA__
+1234
+12345
+123456
+1234567
+12345678
+1234567190
+1211121191
+12315611110
+127200201110
+227201201110
+