Merge pull request #7439 from mattneleigh/pwc200

	new file:   challenge-200/mattneleigh/perl/ch-1.pl

2 files changed, 286 insertions, 0 deletions

diff --git a/challenge-200/mattneleigh/perl/ch-1.pl b/challenge-200/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..fd552bb891
--- /dev/null
+++ b/challenge-200/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,104 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @arrays = (
+    # Given cases
+    [ 1,2,3,4 ],
+    [ 2 ],
+
+    # Additional test cases
+    [ 1, 3, 9 ],
+    [ 1, 2, 3 ],
+    [ 5, 7, 6, 9, 4 ],
+    [ 4, 6, 8, 12, 10, 9, 8, 7 ],
+    [ 5, 5, 5, 5 ]
+);
+
+print("\n");
+foreach my $array (@arrays){
+    my @slices = find_arithmetic_slices(@{$array});
+
+    printf(
+        "Input: \@array = (%s)\nOutput: %s\n\n",
+        join(", ", @{$array}),
+        scalar(@slices)
+            ?
+            join(
+                ", ",
+                map(
+                    sprintf("(%s)", join(", ", @{$_})),
+                    @slices
+                )
+            )
+            :
+            "() as no slice found."
+    )
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Find the arithmetic slices within an array of integers- that is to say, those
+# sub-sections of the array where at least three consecutive numbers have the
+# same difference among all adjacent pairs
+# Takes one argument:
+# * The array to examine (e.g. ( 1, 2, 3, 4, 8, 6, 4 ) )
+# Returns on success:
+# * A list of refs to arrays that represent the arithmetic slices found within
+#   the array (e.g. ( [ 1, 2, 3 ], [ 1, 2, 3, 4 ], [ 2, 3, 4 ], [ 8, 6, 4 ] );
+#   if no arithmetic slices are found, OR if the input array has fewer than
+#   three members (by definition there cannot be an arithmetic slice in an
+#   array of one or two numbers) then the returned list will be empty
+# NOTE: Although it is not shown in the example above, zero (0) is considered a
+# valid difference for determining which slices are arithmetic
+################################################################################
+sub find_arithmetic_slices{
+
+    my @slices = ();
+
+    # Only process the array if there are more than
+    # two elements in it
+    if(scalar(@ARG) > 2){
+        # Run this position from the start of the array to
+        # two elements short of the end
+        for my $base (0 .. ($#ARG - 2)){
+            my $initial_diff = $ARG[$base + 1] - $ARG[$base];
+
+            # Run this position from two elements ahead of $base
+            # to the end of the array
+            for my $lookahead (($base + 2) .. $#ARG){
+                my $local_diff = $ARG[$lookahead]
+                    - $ARG[$lookahead - 1];
+
+                # Break the inner loop if differences
+                # don't match
+                last
+                    unless($local_diff == $initial_diff);
+
+                # Differences matched- store the slice
+                push(
+                    @slices,
+                    [ @ARG[$base .. $lookahead] ]
+                );
+            }
+        }
+    }
+
+    return(@slices);
+
+}
+
+
+
diff --git a/challenge-200/mattneleigh/perl/ch-2.pl b/challenge-200/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..d0f15d8992
--- /dev/null
+++ b/challenge-200/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,182 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @numbers = (
+    # Additional test cases
+    17825,
+    33.333,
+    ".175",
+    -5.43,
+    "-.96",
+
+    # Given case- processed last, this time;
+    # Happy 200th PWC  :)
+    200
+);
+
+print("\n");
+foreach my $number (@numbers){
+    # Join all lines with newlines, concatenate two
+    # final newlines, and print the resulting string
+    print(
+        join(
+            "\n",
+            @{ number_to_segmented_display($number) }
+        )
+        .
+        "\n\n"
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Convert a number to a textual representation of a series or seven-segment
+# displays that each have the appropriate segments lit to represent the digits
+# in the supplied number
+# Takes one argument:
+# * The number to represent
+# Returns on success:
+# * A ref to an array of strings that contain the representation of the
+#   seven segment displays; this will consist of five lines of nine characters
+#   per digit (but there will be no newline characters)
+################################################################################
+sub number_to_segmented_display{
+    my $number = shift();
+
+    my $lines = [
+        "", "", "", "", ""
+    ];
+    my $neg = 0;
+
+    if($number < 0){
+        # The number is negative, make it positive for
+        # now, and make a note...
+        $neg = 1;
+        $number *= -1;
+    }
+
+    # Split the number into individual digits and
+    # loop over each
+    foreach my $digit (split('', $number)){
+        if($digit eq "."){
+            # This 'digit' was a decimal point
+            unless(length($lines->[4])){
+                # If there aren't already any digits, add a
+                # leading zero
+                $lines = digit_to_segments(0);
+            }
+
+            # Add the decimal point 'segment' to the last
+            # digit
+            substr($lines->[4], -2, 1, "o");
+        } else{
+            # Add the digit's segments to the text
+            my $segments = digit_to_segments($digit);
+
+            for my $i (0 .. 4){
+                $lines->[$i] .= $segments->[$i];
+            }
+        }
+    }
+
+    if($neg){
+        # The original number was negative- prepend a
+        # negative sign to our set of lines
+        foreach(0 .. $#$lines){
+            $lines->[$_] = " " x 9 . $lines->[$_];
+        }
+        substr($lines->[2], 3, 3, "---");
+    }
+
+    return($lines);
+
+}
+
+
+
+################################################################################
+# Convert a digit to a textual representation of a seven-segment display that
+# has the appropriate segments lit to represent the supplied digit
+# Takes one argument:
+# * The digit to represent
+# Returns on success:
+# * A ref to an array of strings that contain the representation of the
+#   seven segment display; this will consist of five lines of nine characters
+#   each (but there will be no newline characters)
+# Returns on error:
+# * undef if the value passed is not a single positive digit
+################################################################################
+sub digit_to_segments{
+    my $digit = shift();
+
+    return(undef)
+        unless($digit =~ m/^\d$/);
+
+    # Segment table:
+    #        a
+    #       ---
+    #   f / g / b
+    #     ---
+    # e /   / c
+    #   ---   o
+    #    d
+    # NOTE: 'o' shows the intended location of a
+    # decimal point, but this code doesn't 'light'
+    # that segment- the calling code does, as
+    # needed
+    my @segment_table = (
+        "abcdef",
+        "bc",
+        "abdeg",
+        "abcdg",
+        "bcfg",
+        "acdfg",
+        "acdefg",
+        "abc",
+        "abcdefg",
+        "abcdfg",
+    );
+    my $text = [
+        "         ",
+        "         ",
+        "         ",
+        "         ",
+        "         "
+    ];
+
+    # Substitute other characters depending on which
+    # segments are supposed to be "lit"
+    substr($text->[0], 5, 3, "---")
+        if($segment_table[$digit] =~ m/a/);
+    substr($text->[1], 7, 1, "/")
+        if($segment_table[$digit] =~ m/b/);
+    substr($text->[3], 5, 1, "/")
+        if($segment_table[$digit] =~ m/c/);
+    substr($text->[4], 1, 3, "---")
+        if($segment_table[$digit] =~ m/d/);
+    substr($text->[3], 1, 1, "/")
+        if($segment_table[$digit] =~ m/e/);
+    substr($text->[1], 3, 1, "/")
+        if($segment_table[$digit] =~ m/f/);
+    substr($text->[2], 3, 3, "---")
+        if($segment_table[$digit] =~ m/g/);
+
+    return($text);
+
+}
+
+
+