From 568e151da3d26924cc5b31e380f147d4cd47313c Mon Sep 17 00:00:00 2001 From: Matthew Neleigh Date: Thu, 3 Oct 2024 21:29:42 -0400 Subject: new file: challenge-289/mattneleigh/perl/ch-1.pl new file: challenge-289/mattneleigh/perl/ch-2.pl --- challenge-289/mattneleigh/perl/ch-1.pl | 61 +++++++++++++++++ challenge-289/mattneleigh/perl/ch-2.pl | 122 +++++++++++++++++++++++++++++++++ 2 files changed, 183 insertions(+) create mode 100755 challenge-289/mattneleigh/perl/ch-1.pl create mode 100755 challenge-289/mattneleigh/perl/ch-2.pl diff --git a/challenge-289/mattneleigh/perl/ch-1.pl b/challenge-289/mattneleigh/perl/ch-1.pl new file mode 100755 index 0000000000..f415f5e311 --- /dev/null +++ b/challenge-289/mattneleigh/perl/ch-1.pl @@ -0,0 +1,61 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use English; + +################################################################################ +# Begin main execution +################################################################################ + +my @integer_lists = ( + [ 5, 6, 4, 1 ], + [ 4, 5 ], + [ 1, 2, 2, 3 ] +); + +print("\n"); +foreach my $integer_list (@integer_lists){ + printf( + "Input: \@ints = (%s)\nOutput: %d\n\n", + join(", ", @{$integer_list}), + get_third_distinct_max(@{$integer_list}) + ); +} + +exit(0); +################################################################################ +# End main execution; subroutines follow +################################################################################ + + + +################################################################################ +# Given an array of integers, find and report the third distinct maximum; if +# there are not three distinct maxima, report the first (largest) maximum +# Takes one argument: +# * A list of integers to examine (e.g. ( 5, 6, 4, 1 ) ) +# Returns: +# * The third distinct maximum, if available, otherwise the largest maximum +# (e.g. 4 ) +################################################################################ +sub get_third_distinct_max{ + use List::MoreUtils qw(uniq); + + # Grab only unique ints and sort those that + # remain in descending order + my @sorted = sort({ $b <=> $a } uniq(@ARG)); + + # Return the third largest int if we have + # enough left, or the largest if we don't + return( + scalar(@sorted) > 2 ? + $sorted[2] + : + $sorted[0] + ); + +} + + + diff --git a/challenge-289/mattneleigh/perl/ch-2.pl b/challenge-289/mattneleigh/perl/ch-2.pl new file mode 100755 index 0000000000..2212e30200 --- /dev/null +++ b/challenge-289/mattneleigh/perl/ch-2.pl @@ -0,0 +1,122 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use English; + +################################################################################ +# Begin main execution +################################################################################ + +my @sentences = ( + "The quick, brown fox jumped over the lazy dog.", + "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.", + "The fool doth think he is wise, but the wise man knows himself to be a fool." +); + +print("\n"); +foreach my $sentence (@sentences){ + printf( + "Input: %s\nOutput: %s\n\n", + $sentence, + recognizeable_word_jumble($sentence) + ); +} + +exit(0); +################################################################################ +# End main execution; subroutines follow +################################################################################ + + + +################################################################################ +# Jumble the medial latters (those not at the start and end) of each word in a +# sentence, leaving all other characters in place. This is based on the idea +# that words in a sentence remain easily readable as long as the first and last +# letters are unchanged even if all the others are randomly rearranged. +# Takes one argument +# * The sentence to shuffle (e.g. "The quick, brown fox jumped over the lazy +# dog.") +# Returns: +# * The sentence with all medial letter shuffled (e.g. "The quick, borwn fox +# juempd oevr the lzay dog." [exact medial letter arrangement to vary with +# each call; some words may pass through unchanged]) +################################################################################ +sub recognizeable_word_jumble{ + + return( + # 3. Re-join the groups of jumbled and + # not-jumbled characters into one string + join( + "", + # 2. Run the char jumbler on each set of + # letters of sufficient length; pass not- + # letters and short groups of letters + # through unchanged + map( + ((length($_) > 3) && m/[[:alpha:]]/) ? + shuffle_medial_string($_) + : + $_, + # 1. Split the input string into groups of + # letters and groups of not-letters by + # splitting on collections of letters and + # capturing the "delimiters" + split(/([[:alpha:]]+)/, shift()) + ) + ) + ); + +} + + + +################################################################################ +# Shuffle the medial contents of a string- that is to say, rearrange in random +# order all the characters that are NOT the first and last. Note that calling +# this function on a string of fewer than four characters is futile as the +# order of a single medial character is impossible to change. Shuffling is +# accomplished via the Fisher-Yates method (see +# https://en.wikipedia.org/wiki/Fisher-Yates_shuffle ) +# Takes one argument: +# * The string to shuffle (e.g. "Programming") +# Returns: +# * The shuffled string (e.g. "Pmgmrnioarg" [exact medial letter arrangement to +# vary with each call; some strings may pass through unchanged if random +# chance or their length so dictates]) +################################################################################ +sub shuffle_medial_string{ + # Break up the word into its component + # characters + my @chars = split(//, shift()); + + my ($i, $j); + my $temp; + + # Run the Fisher-Yates Shuffle on the array + # of chars EXCEPT the first and last, which + # are to remain in place + for $i (1 .. $#chars - 2){ + # Select a random char to swap with the + # current one, within the range of + # swappable chars + $j = $i + int(rand($#chars - $i)); + + # Swap the chars at $i and $j; doing it + # this way turns out to be somewhat faster + # than using array slices (e.g. + # @chars[$i, $j] = @chars[$j, $i]; ) + $temp = $chars[$i]; + $chars[$i] = $chars[$j]; + $chars[$j] = $temp; + } + + # Recombine all chars and return the + # resulting string + return(join("", @chars)); + +} + + + -- cgit