aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Neleigh <matthew.neleigh@gmail.com>2021-08-01 03:23:45 -0400
committerMatthew Neleigh <matthew.neleigh@gmail.com>2021-08-01 03:23:45 -0400
commitc6b6d3afebb0db323f95bb91e15a5a396c6ba6cb (patch)
treefa0303ad46530277aa9c5e7547b4c50b87f91954
parent8e96ef7e364aecf50d01c2cf19cf1fcb9d7a705a (diff)
downloadperlweeklychallenge-club-c6b6d3afebb0db323f95bb91e15a5a396c6ba6cb.tar.gz
perlweeklychallenge-club-c6b6d3afebb0db323f95bb91e15a5a396c6ba6cb.tar.bz2
perlweeklychallenge-club-c6b6d3afebb0db323f95bb91e15a5a396c6ba6cb.zip
new file: challenge-123/mattneleigh/perl/ch-1.pl
new file: challenge-123/mattneleigh/perl/ch-2.pl
-rwxr-xr-xchallenge-123/mattneleigh/perl/ch-1.pl211
-rwxr-xr-xchallenge-123/mattneleigh/perl/ch-2.pl251
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
+ );
+
+}
+
+
+