Merge pull request #4636 from mattneleigh/pwc123

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

2 files changed, 462 insertions, 0 deletions

diff --git a/challenge-123/mattneleigh/perl/ch-1.pl b/challenge-123/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..5252d9c642
--- /dev/null
+++ b/challenge-123/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,211 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @input = (1, 7, 10, 15, 100, 200);
+
+# Calculate enough Ugly Numbers to satisfy
+# the largest argument we have
+my @ugly_numbers = compute_N_ugly_numbers($input[max_value_index(@input)]);
+
+foreach(@input){
+    printf("%4d --> %5d\n", $_, $ugly_numbers[$_ - 1]);
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Compute the Nth Ugly Number- a positive integer whose only prime factors are
+# 2, 3, or 5
+# Takes one argument:
+# * A positive integer (N) that indicates which Ugly Number out of the sequence
+#   of same is to be calculated; if N is not an integer it will be truncated
+# Returns on success:
+# * The Nth Ugly Number
+# Return on error:
+# * undef if N wasn't a number greater than zero
+################################################################################
+sub compute_Nth_ugly_number{
+    my $n = shift();
+
+    my @ugly_numbers = compute_N_ugly_numbers($n);
+
+    # Make sure we got a defined array
+    # from compute_N_ugly_numbers()
+    return(undef) unless(defined($ugly_numbers[0]));
+
+    # Return the last number in the list
+    return($ugly_numbers[$#ugly_numbers]);
+
+}
+
+
+
+################################################################################
+# Compute the first N Ugly Numbers- positive integers whose only prime factors
+# are 2, 3, or 5
+# Takes one argument:
+# * A positive integer (N) that indicates how many Ugly Numbers out of the
+#   sequence of same are to be calculated; if N is not an integer it will be
+#   truncated
+# Returns on success:
+# * A list of the first N Ugly Numbers; by convention the first element of this
+#   list will be 1
+# Return on error:
+# * undef if N wasn't a number greater than zero
+################################################################################
+sub compute_N_ugly_numbers{
+    my $n = shift();
+
+    # Compute and return a set of composite
+    # numbers using the particular factors
+    # that produce Ugly Numbers...
+    return(compute_N_composite_numbers($n, (2, 3, 5)));
+
+}
+
+
+
+################################################################################
+# Compute the first N composite numbers (miltiplicative products in various
+# combinations) of a specified set of factors
+# Takes two arguments:
+# * The number (N) of composite numbers to calculate, which must be at least 1;
+#   if N is not an integer it will be truncated
+# * A list of factors to be multiplied to produce composite numbers, which must
+#   contain at least one number, and each number must be at least 1; any number
+#   that is not an integer will be truncated
+# Returns on success:
+# * A list of the first N composite numbers; by convention the first element of
+#   this list will be 1
+# Return on error:
+# * undef if no factors are specified or if N or any factor wasn't a number
+#   greater than zero
+################################################################################
+sub compute_N_composite_numbers{
+    my $n = int(shift());
+
+    my @indices;
+    my @factors;
+    my @products;
+
+    # Populate the list in case $n == 1
+    my @composite_list = (1);
+
+    # If $n wasn't an number and greater
+    # than zero
+    return(undef) unless($n > 0);
+
+    # No further args were supplied
+    return(undef) unless(scalar(@ARG));
+
+    while(defined($ARG[0])){
+        push(@factors, int(shift()));
+        # A factor wasn't a number and
+        # greater than zero
+        return(undef) unless($factors[$#factors] > 0);
+    }
+
+    # Initialize indices
+    for(0..$#factors){
+        push(@indices, 0);
+    }
+
+    $n--;
+    while($n--){
+        for(0..$#factors){
+            # Multiply our factors by particular numbers
+            # previously calculated; @products will be
+            # autovivified on the first pass
+            $products[$_] = $composite_list[$indices[$_]] * $factors[$_];
+        }
+
+        # Store the minimum value we just calculated
+        push(@composite_list, $products[min_value_index(@products)]);
+
+        for(0..$#factors){
+            # If any product we calculated equals the
+            # minimum number we stored, increment the
+            # corresponding index
+            if($products[$_] == $composite_list[$#composite_list]){
+                $indices[$_]++;
+            }
+        }
+    }
+
+    # Return the list
+    return(@composite_list);
+
+}
+
+
+
+################################################################################
+# Determine the index of the lowest numerical value in a list
+# Takes as arguments:
+# * A list of numerical values which may be of any nonzero length
+# Returns on success:
+# * The index of the minimum value in the list; if the minimum value occurs
+#   multiple times, this will be the index of the first occurance
+# Returns on error:
+# * undef if the list is of zero length
+################################################################################
+sub min_value_index{
+
+    my $i = 0;
+    my $min_i = 0;
+
+    return(undef) unless(scalar(@ARG));
+
+    for($i=1; $i<=$#ARG; $i++){
+        if($ARG[$i] < $ARG[$min_i]){
+            $min_i = $i;
+        }
+    }
+
+    return($min_i);
+
+}
+
+
+
+################################################################################
+# Determine the index of the highest numerical value in a list
+# Takes as arguments:
+# * A list of numerical values which may be of any nonzero length
+# Returns on success:
+# * The index of the maximum value in the list; if the maximum value occurs
+#   multiple times, this will be the index of the first occurance
+# Returns on error:
+# * undef if the list is of zero length
+################################################################################
+sub max_value_index{
+
+    my $i = 0;
+    my $max_i = 0;
+
+    return(undef) unless(scalar(@ARG));
+
+    for($i=1; $i<=$#ARG; $i++){
+        if($ARG[$i] > $ARG[$max_i]){
+            $max_i = $i;
+        }
+    }
+
+    return($max_i);
+
+}
+
+
+
diff --git a/challenge-123/mattneleigh/perl/ch-2.pl b/challenge-123/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..0c0e19d4f4
--- /dev/null
+++ b/challenge-123/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,251 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+use Math::Trig ':pi';  # For the pip2 constant
+
+# Kind of arbitrary
+use constant EPSILON => 0.000001;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @squares = (
+
+    # This one should be a square
+    [
+        [10, 20], [20, 20], [20, 10], [10, 10]
+    ],
+
+    # This one should not be a square
+    [
+        [12, 24], [16, 10], [20, 12], [18, 16]
+    ],
+
+    # Square, rotated 45 degrees, centered
+    # on the origin
+    [
+        [0, 10], [10, 0], [0, -10], [-10, 0]
+    ],
+
+    # Lozenge, centered on the origin
+    [
+        [0, 5], [15, 0], [0, -5], [-15, 0]
+    ]
+
+);
+my $square;
+
+foreach $square (@squares){
+    printf(
+        "%s is%s a square.\n",
+        points_to_string(@{$square}),
+        is_square(@{$square}) ? "" : " not"
+    );
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Produce a string detailing the contents of a set of points in space
+# Takes one argument:
+# * A list of references to points, which in turn must each be refs to arrays
+#   of numerical data describing the coordinates of each point; the list must
+#   contain at least one point, e.g.:
+#   @points = ([1, 3], [2, 7]);
+#   points_to_string(@points);
+# Returns on success:
+# * A string representation of the set of points provided, e.g.:
+#   "(1, 3), (2, 7)"
+# Returns on error:
+# * undef if the provided list is empty
+################################################################################
+sub points_to_string{
+
+    my @point_strings = ();
+
+    return(undef) unless(defined($ARG[0]));
+
+    foreach(@ARG){
+        push(
+            @point_strings,
+            sprintf(
+                "(%s)",
+                join(", ", @{$_})
+            )
+        );
+    }
+
+    return(join(", ", @point_strings));
+
+}
+
+
+
+################################################################################
+# Determine if a set of points describes a square in 2D space
+# Takes one argument:
+# * A list of references to points which describe the vertices of a polygon,
+#   which in turn must each be refs to arrays of numerical data describing the
+#   X and Y coordinates of each point, e.g.:
+#   @points = ([0, 0], [0, 1], [1, 1], [1, 0]);
+#   is_square(@points);
+#   The list must contain exactly four points or the shape described will not
+#   be considered a square regardless of the location of each point
+# Returns:
+# * 1 if the polygon appears to be a square
+# * 0 if the polygon does not appear to be a square
+################################################################################
+sub is_square{
+
+    my @sides;
+
+    # Return false if we don't have
+    # exactly four points (last index is
+    # 3)
+    return(0) unless($#ARG == 3);
+
+    # We have some sort of quadrilateral;
+    # return false if all four sides
+    # aren't the same length
+    @sides = (
+        points_distance($ARG[0], $ARG[1]),
+        points_distance($ARG[1], $ARG[2]),
+        points_distance($ARG[2], $ARG[3]),
+        points_distance($ARG[3], $ARG[0]),
+    );
+    return(0) unless(
+        # Only need to compare three times
+        approx_eq($sides[0], $sides[1])
+        &&
+        approx_eq($sides[1], $sides[2])
+        &&
+        approx_eq($sides[2], $sides[3])
+    );
+
+    # We have a rhombus; return false if
+    # a corner isn't a right angle (any
+    # one will do)
+    return(0) unless(is_right_angle($ARG[0], $ARG[1], $ARG[2]));
+
+    # If we got here, we must have a
+    # square; return true
+    return(1);
+
+}
+
+
+
+################################################################################
+# Determine whether three points in 2D space are arranged so as to form a right
+# angle
+# Takes three arguments:
+# * A point (A) which must be a ref to an array of numerical data describing
+#   the X and Y coordinates of the point
+# * A point (B) which is subject to the same requirements as A; this must be
+#   the vertex of the angle
+# * A point (C) which is subject to the same requirements as A
+# Returns:
+# * 1 if ABC is a right angle
+# * 0 if ABC is not a right angle
+################################################################################
+sub is_right_angle{
+    my $a = shift();
+    my $b = shift();
+    my $c = shift();
+
+    my $abs_angle = abs(points_angle($a, $b, $c));
+
+    # Make sure the absolute value of
+    # the angle is pi/2 or 3*pi/2 (pip2
+    # constant from Math::Trig)
+    unless(approx_eq($abs_angle, pip2) || approx_eq($abs_angle, 3 * pip2)){
+        return(0);
+    }
+
+    return(1);
+
+}
+
+
+
+################################################################################
+# Calculate the angle described by three points in 2D space
+# Takes three arguments:
+# * A point (A) which must be a ref to an array of numerical data describing
+#   the X and Y coordinates of the point
+# * A point (B) which is subject to the same requirements as A; this must be
+#   the vertex of the angle
+# * A point (C) which is subject to the same requirements as A
+# Returns:
+# * Angle ABC (B is the vertex) in radians
+################################################################################
+sub points_angle{
+    my $a = shift();
+    my $b = shift();
+    my $c = shift();
+
+    return(
+        atan2($c->[1] - $b->[1], $c->[0] - $b->[0])
+        -
+        atan2($a->[1] - $b->[1], $a->[0] - $b->[0])
+    );
+
+}
+
+
+
+################################################################################
+# Calculate the distance between two points in 2D space
+# Takes two arguments:
+# * A point (A) which must be a ref to an array of numerical data describing
+#   the X and Y coordinates of the point
+# * A point (B) which is subject to the same requirements as A
+# Returns:
+# * The distance between A and B, which will never be a negative quantity
+#   regardless of the relative positions of the points or the order in which
+#   they were specified
+################################################################################
+sub points_distance{
+    my $a = shift();
+    my $b = shift();
+
+    return(
+        sqrt(
+            ($b->[0] - $a->[0]) ** 2 + ($b->[1] - $a->[1]) ** 2
+        )
+    );
+
+}
+
+
+
+################################################################################
+# Determine if two values are approximately equal (their values differ by no
+# more than the pre-defined small constant EPSILON)
+# Takes two arguments:
+# * A numerical value (A)
+# * A numerical value (B)
+# Returns:
+# * 1 if A and B are approximately equal
+# * 0 if A and B are not approximately equal
+################################################################################
+sub approx_eq{
+    my $a = shift();
+    my $b = shift();
+
+    return(
+        abs($a - $b) > EPSILON ? 0 : 1
+    );
+
+}
+
+
+