diff options
| -rwxr-xr-x | challenge-134/mattneleigh/perl/ch-1.pl | 202 | ||||
| -rwxr-xr-x | challenge-134/mattneleigh/perl/ch-2.pl | 214 |
2 files changed, 416 insertions, 0 deletions
diff --git a/challenge-134/mattneleigh/perl/ch-1.pl b/challenge-134/mattneleigh/perl/ch-1.pl new file mode 100755 index 0000000000..6929a26475 --- /dev/null +++ b/challenge-134/mattneleigh/perl/ch-1.pl @@ -0,0 +1,202 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use English; + +################################################################################ +# Begin main execution +################################################################################ + +my $quantity = 5; + +print("The first ", $quantity, " pandigital numbers in Base 10 are:\n"); +foreach(find_pandigital_numbers($quantity)){ + print(" $_\n"); +} + +exit(0); +################################################################################ +# End main execution; subroutines follow +################################################################################ + + + +################################################################################ +# Find the first N pandigital numbers in Base 10 +# Takes one argument: +# * The number N of pandigital numbers to find +# Returns: +# * A list of N pandigital numbers in Base 10, in ascending order +################################################################################ +sub find_pandigital_numbers{ + my $n = shift(); + + my $digit_count; + my @digits; + my @permutations = (); + my @pandigitals = (); + + # Cheat (a little) by setting up the + # smallest pandigital number in Base 10 to + # start with + @digits = (1, 0, 2, 3, 4, 5, 6, 7, 8, 9); + + # The inverse factorial of the quantity of + # numbers we're expected to find will tell + # us how many digits need to be permuted; + # calculate this and make sure the value + # is sane + $digit_count = inverse_factorial($n); + if($digit_count > scalar(@digits)){ + $digit_count = scalar(@digits); + } + + # Gather a list of permutations involving + # only the requisite number of digits at the + # end of the list- it saves some memory to + # do it this way + permute_list_sequence( + [ @digits[$#digits - $digit_count + 1 .. $#digits] ], + 0, + $digit_count, + \@permutations + ); + + if($digit_count == scalar(@digits)){ + # All the digits were used for + # permutations; build strings out of the + # permuted digits. + # Assignment in conditional is deliberate + while(my $permutation = shift(@permutations)){ + # Most definitions of a pandigital number + # don't permit leading zeros, so skip any + # permutations that have ended up with + # one; this should only happen if all + # available digits were permuted + next if($permutation->[0] == 0); + $permutation = join( + "", + @{$permutation} + ); + push(@pandigitals, $permutation); + } + } else{ + # There are unpermuted digits; build + # strings out of the unpermuted and permuted + # digits. + # Assignment in conditional is deliberate + while(my $permutation = shift(@permutations)){ + $permutation = join( + "", + @digits[0 .. $#digits - $digit_count], + @{$permutation} + ); + push(@pandigitals, $permutation); + } + } + + # The numbers likely won't be in ascending + # order, however; sort them and return the + # desired quantity + $n--; + return( + (sort(@pandigitals))[ + 0 .. ($n < $#pandigitals ? $n : $#pandigitals) + ] + ); + +} + + + +################################################################################ +# Generate a sequence of permutations based on the contents of a supplied +# array. Permutations will take place within the specified range of cells, +# which must be within the array or undefined behavior may result. The +# permutations may not be generated in any particularly meaningful order. +# Takes four arguments: +# * A ref to an array of cells to permute. NOTE: this array will be modified +# as the permutations are generated; see the output array below for a copy of +# the array in its original order +# * The index of the first cell (base) of the active permutation region +# * The number of cells, including the base, that will be part of the active +# permutation region +# * A ref to an array in which the permutations are to be stored as output; +# this will be populated with permuted copies of the entire original input +# array, including cells outside the active permutation region, if any. The +# first array in this list will contain the cells in their unpermuted order. +# Returns: +# * undef at all times, which conveys no meaningful information +# Adapted from Heap's Algorithm as described here +# https://www.geeksforgeeks.org/heaps-algorithm-for-generating-permutations/ +################################################################################ +sub permute_list_sequence{ + my $list = shift(); + my $base = shift(); + my $region_size = shift(); + my $permutations = shift(); + + # Active region is just one cell- + # store a copy of the current list + if($region_size == 1){ + push(@{$permutations}, [ @{$list} ]); + return(); + } + + for(0 .. $region_size - 1){ + # Recurse deeper with a smaller active + # region + permute_list_sequence( + $list, + $base, + $region_size - 1, + $permutations + ); + + if($region_size % 2){ + # Odd range size- swap first and last + # elements in the active region + @{$list}[$base, $base + $region_size - 1] + = @{$list}[$base + $region_size - 1, $base]; + } else{ + # Even range size- swap the $_th and + # last elements in the active region + @{$list}[$base + $_, $base + $region_size - 1] + = @{$list}[$base + $region_size - 1, $base + $_]; + } + } + + return(); + +} + + + +################################################################################ +# Calculate the inverse factorial of an integer (i.e. given y, solve x! = y for +# x). If the integer is not actually a factorial, the number calculated is the +# inverse of the next largest factorial (e.g. an input of 10 yields 4; 3! = 6 +# while 4! = 24) +# Takes one argument: +# * A factorial whose inverse is to be calculated +# Returns: +# * The inverse of the factorial (or next largest factorial if the input is not +# a factorial) +################################################################################ +sub inverse_factorial{ + my $y = int(shift()); + + my $x = 1; + + while($y > 1){ + $x++; + $y /= $x; + } + + return($x); + +} + + + diff --git a/challenge-134/mattneleigh/perl/ch-2.pl b/challenge-134/mattneleigh/perl/ch-2.pl new file mode 100755 index 0000000000..57c0ab142c --- /dev/null +++ b/challenge-134/mattneleigh/perl/ch-2.pl @@ -0,0 +1,214 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use English; + +################################################################################ +# Begin main execution +################################################################################ + +my @dimensions = ( + # Given cases + [3, 3], + [3, 5], + + # Additional test cases + [10, 10] +); + +foreach(@dimensions){ + my $table = generate_multiplication_table(@{$_}); + + printf("Input: \$m = %d, \$n = %d\n", $_->[0], $_->[1]); + printf("Output:\n\n"); + + foreach(@{$table->{table}}){ + print(" $_\n"); + } + print("\n"); + + print("Distinct Terms: ", join(", ", @{$table->{distinct_terms}}) ,"\n"); + print("Count: ", scalar(@{$table->{distinct_terms}}), "\n"); + print("\n\n"); +} + +exit(0); +################################################################################ +# End main execution; subroutines follow +################################################################################ + + + +################################################################################ +# Create a multiplication table containing a specified number of columns and +# rows +# Takes two arguments: +# * An integer M that defines how many rows will be in the table; this must be +# at least two (2) +# * An integer N that defines how many columns will be in the table; this must +# be at least two (2) +# Returns on success: +# * A ref to a hash containing the following fields: +# { +# table => [], # A list of formatted strings comprising the +# # multiplication table with M * N products, +# # ready for output +# distinct_terms => [], # A list of distinct products contained within +# # the table +# } +# Returns on error: +# * undef if either M or N is smaller than two (2) +################################################################################ +sub generate_multiplication_table{ + my $m = int(shift()); + my $n = int(shift()); + + my $N; + my $max_factor_width; + my $max_product_width; + my %output = (); + + # Impose some notion of sanity on our + # input values + return(undef) if(($m < 2) || ($n < 2)); + + $output{table} = []; + $output{distinct_terms} = (); + + # The maximum factor width will be + # determined by the initial value of $m; + # the width required for factors from $n + # is determined by the maximum product + # width, which is $m * $n + $max_factor_width = count_integer_characters($m); + $max_product_width = count_integer_characters($m * $n); + + $N = $n; + while($m--){ + my @row = ( ); + + $n = $N; + while($n--){ + my $term = ($m + 1) * ($n + 1); + + # Store the calculated product in this + # row, and make a note of it in the + # distinct terms table + unshift(@row, $term); + $output{distinct_terms}{$term} = 1; + } + + # Include the $m factor for the vertical + # axis that will appear in the table + unshift(@row, $m + 1); + + # Make a nicely formatted row for output + # and store it + unshift( + @{$output{table}}, + format_table_row(\@row, $max_factor_width, $max_product_width) + ); + + unless($m){ + # The last (top) row of products has + # been calculated; add a couple more + # things to the top of the table: + unshift( + @{$output{table}}, + + # A row of $N factors for the horizontal + # axis... + format_table_row( + [ "x", (1 .. $N) ], + $max_factor_width, + $max_product_width + ), + + # And a horizontal rule + "-" x ($max_factor_width + 1) + . + "+" + . + "-" x (($max_product_width + 1) * $N) + ); + } + + } # end while($m--) + + # Store the distinct terms for output- + # convert the distinct terms table into + # a list of its former keys + $output{distinct_terms} = [ + sort({ $a <=> $b } keys(%{$output{distinct_terms}})) + ]; + + return(\%output); + +} + + + +################################################################################ +# Format a multiplication table row for output +# Takes three arguments: +# * A ref to an array that must contain the M factor for that row and its +# products with all values of N (e.g [ 4, 4, 8, 12, 16 ] ) +# * The calculated width of the maximum value of M (e.g. 1) +# * The calculated width of the maximum of all the products of M and N (e.g. 2) +# Returns: +# * A formatted string suitable for the body of a multiplicatino table, with a +# vertical bar between the factor and its appropriately-spaced products +# (e.g. "4 | 4 8 12 16") +################################################################################ +sub format_table_row{ + my $row = shift(); + my $max_factor_width = shift(); + my $max_term_width = shift(); + + return( + sprintf("%".$max_factor_width."s ", $row->[0]) + . + "|" + . + join( + "", + map( + { sprintf(" %".$max_term_width."s", $_) } + @{$row}[1 .. $#$row] + ) + ) + ); + +} + + + +################################################################################ +# Calculate the number of characters required to display an integer +# Takes one argument: +# * The number to examine +# Returns: +# * The number of characters required to display the provided number +# NOTE: If a non-integer number is provided, the number of characters required +# to display just the integer portion of the number will be calculated; if a +# negative number is provided, the character required to display the sign will +# be accounted for in the value returned +################################################################################ +sub count_integer_characters{ + + return( + int( + log(abs($ARG[0])) / log(10) + + + ($ARG[0] < 0 ? 2 : 1) + + + # Fudge because of round-off error... + 0.000000000000001 + ) + ); + +} + + + |