diff options
| -rwxr-xr-x | challenge-277/mattneleigh/perl/ch-1.pl | 118 | ||||
| -rwxr-xr-x | challenge-277/mattneleigh/perl/ch-2.pl | 73 |
2 files changed, 191 insertions, 0 deletions
diff --git a/challenge-277/mattneleigh/perl/ch-1.pl b/challenge-277/mattneleigh/perl/ch-1.pl new file mode 100755 index 0000000000..344f600064 --- /dev/null +++ b/challenge-277/mattneleigh/perl/ch-1.pl @@ -0,0 +1,118 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use English; + +################################################################################ +# Begin main execution +################################################################################ + +my @string_sets = ( + [ + [ "Perl", "is", "my", "friend" ], + [ "Perl", "and", "Raku", "are", "friend" ] + ], + [ + [ "Perl", "and", "Python", "are", "very", "similar" ], + [ "Python", "is", "top", "in", "guest", "languages" ] + ], + [ + [ "Perl", "is", "imperative", "Lisp", "is", "functional" ], + [ "Crystal", "is", "similar", "to", "Ruby" ] + ] +); + +print("\n"); +foreach my $string_set (@string_sets){ + printf( + "Input: \@words1 = (%s)\n \@words2 = (%s)\nOutput: %d\n\n", + join( + ", ", + map("\"" . $_ . "\"", @{$string_set->[0]}) + ), + join( + ", ", + map("\"" . $_ . "\"", @{$string_set->[1]}) + ), + count_mutual_singles($string_set) + ); +} + +exit(0); +################################################################################ +# End main execution; subroutines follow +################################################################################ + + + +################################################################################ +# Given two or more arrays of strings, count the number of words that appear in +# all of these arrays but only once each +# Takes one argument: +# * A ref to an array of arrays of strings (e.g. +# [ +# [ "Perl", "and", "Python", "are", "very", "similar" ], +# [ "Python", "is", "top", "in", "guest", "languages" ] +# ] +# ) +# Returns: +# * The number of words that appear in all of the supplied arrays but only once +# each (e.g. 1 ) +################################################################################ +sub count_mutual_singles{ + + my @singles_tables; + my $single_count = 0; + + # Loop over each list of strings + foreach my $string_list (@{$ARG[0]}){ + my $string; + my $singles_table = {}; + + # Set up a table of the counts of instances of + # each string + foreach $string (@{$string_list}){ + $singles_table->{$string}++; + } + + # Strip out any strings that showed up more than + # once + foreach $string (keys(%{$singles_table})){ + delete($singles_table->{$string}) + if($singles_table->{$string} > 1); + } + + # Store the table of singles from this list of + # strings + push(@singles_tables, $singles_table); + } + + # Loop over every remaining string in the + # first table of single words + foreach my $string (keys(%{$singles_tables[0]})){ + my $missing = 0; + + # Loop over all subsequent tables + for my $i (1 .. $#singles_tables){ + # Mark this word as missing and break out of the + # loop if it is not found in this table + unless($singles_tables[$i]->{$string}){ + $missing = 1; + last; + } + } + + # Increment the singles count unless this string + # was marked as missing + $single_count++ + unless($missing); + + } + + return($single_count); + +} + + + diff --git a/challenge-277/mattneleigh/perl/ch-2.pl b/challenge-277/mattneleigh/perl/ch-2.pl new file mode 100755 index 0000000000..6789ae35e0 --- /dev/null +++ b/challenge-277/mattneleigh/perl/ch-2.pl @@ -0,0 +1,73 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use English; + +################################################################################ +# Begin main execution +################################################################################ + +my @things = ( + [ 1, 2, 3, 4, 5 ], + [ 5, 7, 1, 7 ] +); + +print("\n"); +foreach my $thing (@things){ + printf( + "Input: \@ints = (%s)\nOuput: %s\n\n", + join(", ", @{$thing}), + count_strong_pairs(@{$thing}) + ); +} + +exit(0); +################################################################################ +# End main execution; subroutines follow +################################################################################ + + + +################################################################################ +# Given a a list of integers, count the number of strong pairs among the unique +# members of the list- that is to say, those pairs of unique integers (say, +# (x, y)) such that 0 < |x - y| < min(x, y) +# Takes one argument: +# * The list of integers to examine (e.g. ( 5, 7, 1, 7 ) ) +# Returns +# * The count of strong pairs among unique elements in the supplied array (e.g. +# 1 ) +################################################################################ +sub count_strong_pairs{ + use List::Util qw(uniq); + + # Get a list of unique integers from the + # arguments we were given + my @ints = uniq(@ARG); + + my $abs_diff; + my $strong_pair_count = 0; + + # Loop over every pair of unique integers + for my $i (0 .. $#ints - 1){ + for my $j ($i + 1 .. $#ints){ + $abs_diff = abs($ints[$j] - $ints[$i]); + + # Increment the count if this pair meets + # the specified criteria + $strong_pair_count++ + if( + 0 < $abs_diff + && + $abs_diff < ($ints[$i] < $ints[$j] ? $ints[$i] : $ints[$j]) + ); + } + } + + return($strong_pair_count); + +} + + + |