diff options
| -rw-r--r-- | challenge-249/robbie-hatley/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-249/robbie-hatley/perl/ch-1.pl | 148 | ||||
| -rwxr-xr-x | challenge-249/robbie-hatley/perl/ch-2.pl | 152 |
3 files changed, 301 insertions, 0 deletions
diff --git a/challenge-249/robbie-hatley/blog.txt b/challenge-249/robbie-hatley/blog.txt new file mode 100644 index 0000000000..4418ee423b --- /dev/null +++ b/challenge-249/robbie-hatley/blog.txt @@ -0,0 +1 @@ +https://hatley-software.blogspot.com/2023/12/robbie-hatleys-solutions-to-weekly_30.html
\ No newline at end of file diff --git a/challenge-249/robbie-hatley/perl/ch-1.pl b/challenge-249/robbie-hatley/perl/ch-1.pl new file mode 100755 index 0000000000..bed041c05c --- /dev/null +++ b/challenge-249/robbie-hatley/perl/ch-1.pl @@ -0,0 +1,148 @@ +#!/usr/bin/env -S perl -CSDA + +=pod + +-------------------------------------------------------------------------------------------------------------- +COLOPHON: +This is a 110-character-wide Unicode UTF-8 Perl-source-code text file with hard Unix line breaks ("\x0A"). +¡Hablo Español! Говорю Русский. Björt skjöldur. ॐ नमो भगवते वासुदेवाय. 看的星星，知道你是爱。麦藁雪、富士川町、山梨県。 + +-------------------------------------------------------------------------------------------------------------- +TITLE BLOCK: +Solutions in Perl for The Weekly Challenge 249-1. +Written by Robbie Hatley on Fri Dec 29, 2023. + +-------------------------------------------------------------------------------------------------------------- +PROBLEM DESCRIPTION: +Task 249-1: Equal Pairs +Submitted by: Mohammad S Anwar +Given an array of integers with even number of elements, write +a script to divide the given array into equal pairs such that: +a) Each element belongs to exactly one pair. +b) The elements present in a pair are equal. + +Example 1: +Input: @ints = (3, 2, 3, 2, 2, 2) +Output: (2, 2), (3, 3), (2, 2) +There are 6 elements in @ints. +They should be divided into 6 / 2 = 3 pairs. +@ints is divided into the pairs (2, 2), (3, 3), and (2, 2) +satisfying all the conditions. + +Example 2: +Input: @ints = (1, 2, 3, 4) +Output: () +There is no way to divide @ints 2 pairs such that the pairs +satisfy every condition. + + +-------------------------------------------------------------------------------------------------------------- +PROBLEM NOTES: +I make a sub that splices integers from the array and attempts to make equal pairs. If every element can be +paired, the sub will return the array of pairs; if not, it will return an empty array. + +-------------------------------------------------------------------------------------------------------------- +IO NOTES: +Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a +single-quoted array of even-length arrays of integers, in proper Perl syntax: +./ch-1.pl '([9,2,17,6,5,3],[9,2,17,6,17,9,2,6])' + +Output is to STDOUT and will be each input array followed by the corresponding set of equal pairs (or an +empty array if the input array can't be "paired"). + +=cut + +# ------------------------------------------------------------------------------------------------------------ +# PRAGMAS AND MODULES USED: + +use v5.38; +use strict; +use warnings; +use utf8; +use warnings FATAL => 'utf8'; +use Sys::Binmode; +use Time::HiRes 'time'; +use Scalar::Util 'looks_like_number'; + +# ------------------------------------------------------------------------------------------------------------ +# GLOBAL VARIABLES: +our $t0 ; # Seconds since 00:00:00 on Thu Jan 1, 1970. +our $db = 0; # Debug? Set to 0 for no, 1 for yes. + +# ------------------------------------------------------------------------------------------------------------ +# START TIMER: +BEGIN {$t0 = time} + +# ------------------------------------------------------------------------------------------------------------ +# SUBROUTINES: + +# Return an error message if @$aref isn't an even-length array of integers, +# or return 'ok' if it is: +sub error ($aref) { + 'ARRAY' ne ref($aref) and return 'Error: $aref is not a reference to an array.'; + my $n = scalar(@$aref); + $n < 1 and return 'Error: @$aref is empty.'; + 0 != $n % 2 and return 'Error: length of @$aref isn’t even.'; + for my $element (@$aref) { + !looks_like_number($element) and return 'Error: @$aref isn’t an array of integers.'; + } + return 'ok'; +} + +# Return an array of equal pairs of the elements of @$aref, +# or an empty array if @$aref can't be paired: +sub pairs ($aref) { + my @ints = @$aref; my @pairs = (); my $date; my $match; + DATE: while ( scalar(@ints) >= 2 ) { + $date = splice @ints, 0, 1; + MATCH: for ( my $i = 0 ; $i <= $#ints ; ++$i ) { + if ( $ints[$i] == $date ) { + $match = splice @ints, $i, 1; + push @pairs, [$date, $match]; + next DATE; + } + } + last DATE; + } + $db and say 'Number of leftovers = ', scalar @ints; + 0 == scalar(@ints) and return @pairs or return (); +} + +# ------------------------------------------------------------------------------------------------------------ +# MAIN BODY OF PROGRAM: + +# Inputs: +my @arrays = @ARGV ? eval($ARGV[0]) : +( + # Example 1 Input: + [3, 2, 3, 2, 2, 2], + # Expected Output: (2, 2), (3, 3), (2, 2) + + # Example 2 Input: + [1, 2, 3, 4], + # Expected Output: () +); + +# Main loop: +for my $aref (@arrays) { + say ''; + # Skip to next array if array is not an even-length array of integers: + my $error = error($aref); + 'ok' ne $error and say $error and say 'Skipping to next array.' and next; + # Announce array: + say 'Even-length array of ints:'; + say '(' . join(', ', @$aref) . ')'; + # Attempt to decompose array into equal pairs: + my @pairs = pairs($aref); + #If attempt was successful print results: + scalar(@pairs) > 0 and say 'Decomposition of array into equal pairs:' + and say join ', ', map {'(' . join(', ', @$_) . ')'} @pairs + # Otherwise, print failure message: + or say 'Couldn’t decompose array into equal pairs.'; +} +exit; + +# ------------------------------------------------------------------------------------------------------------ +# DETERMINE AND PRINT EXECUTION TIME: +END {my $µs = 1000000 * (time - $t0);printf("\nExecution time was %.0fµs.\n", $µs)} +__END__ diff --git a/challenge-249/robbie-hatley/perl/ch-2.pl b/challenge-249/robbie-hatley/perl/ch-2.pl new file mode 100755 index 0000000000..7d9e60250e --- /dev/null +++ b/challenge-249/robbie-hatley/perl/ch-2.pl @@ -0,0 +1,152 @@ +#!/usr/bin/env -S perl -CSDA + +=pod + +-------------------------------------------------------------------------------------------------------------- +COLOPHON: +This is a 110-character-wide Unicode UTF-8 Perl-source-code text file with hard Unix line breaks ("\x0A"). +¡Hablo Español! Говорю Русский. Björt skjöldur. ॐ नमो भगवते वासुदेवाय. 看的星星，知道你是爱。麦藁雪、富士川町、山梨県。 + +-------------------------------------------------------------------------------------------------------------- +TITLE BLOCK: +Solutions in Perl for The Weekly Challenge 249-2. +Written by Robbie Hatley on Fri Dec 29, 2023. + +-------------------------------------------------------------------------------------------------------------- +PROBLEM DESCRIPTION: +Task 249-2: DI String Match +Submitted by: Mohammad S Anwar +Given a string s, consisting of only the characters "D" and "I", +find a permutation of the integers [0 .. length(s)] such that +for each character s[i] in the string: +s[i] == 'I' ⇒ perm[i] < perm[i + 1] +s[i] == 'D' ⇒ perm[i] > perm[i + 1] + +Example 1: +Input: $str = "IDID" +Output: (0, 4, 1, 3, 2) + +Example 2: +Input: $str = "III" +Output: (0, 1, 2, 3) + +Example 3: +Input: $str = "DDI" +Output: (3, 2, 0, 1) + + +-------------------------------------------------------------------------------------------------------------- +PROBLEM NOTES: +There's probably a "cute trick" way to do this, but I can't see what it is, and I'm not willing to waste +hours this weekend trying to figure it out, so I'll use the "obvious" method instead: I'll use the permute() +function from CPAN module Math::Combinatorics to make all possible permutations of 0..$length and return the +first which meets the given requirements, or an empty array if the requirements cannot be met. + +Addendum: I found that multiple valid answers exist for most compliant strings. + +-------------------------------------------------------------------------------------------------------------- +IO NOTES: +Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a +single-quoted array of double-quoted strings consisting only of "D" and "I" characters, in proper Perl syntax: +./ch-2.pl '("She didn'"'"'t eat clams.", "DIDI", "IIDII", "DIDIIDD", "IIIDDDIII")' + +Output is to STDOUT and will be each input string followed by the corresponding output array (or an empty +array if the given requirements cannot be met). + +=cut + +# ------------------------------------------------------------------------------------------------------------ +# PRAGMAS AND MODULES USED: + +use v5.38; +use strict; +use warnings; +use utf8; +use warnings FATAL => 'utf8'; +use Sys::Binmode; +use Time::HiRes 'time'; +use Math::Combinatorics 'permute'; + +# ------------------------------------------------------------------------------------------------------------ +# GLOBAL VARIABLES: +our $t0 ; # Seconds since 00:00:00 on Thu Jan 1, 1970. +our $db = 0 ; # Debug? Set to 0 for no, 1 for yes. + +# ------------------------------------------------------------------------------------------------------------ +# START TIMER: +BEGIN {$t0 = time} + +# ------------------------------------------------------------------------------------------------------------ +# SUBROUTINES: + +# Return an error message if $string isn't a non-empty string consisting purely of 'D' and 'I' characters, +# or 'ok' if it is: +sub error ($string) { + my $error; + 'SCALAR' ne ref(\$string) and $error = 'Error: String is not a string.' + or $string !~ m/^[DI]+$/ and $error = 'Error: String must consist of D and I characters only' + or $error = 'ok'; + return $error; +} + +# Return a permutation of 0..length($string) meeting the +# requirements given in the problem description, or return +# an empty array if no suitable permutation exists: +sub decrease_increase ($string) { + my $n = length $string; + my @permutations = permute(0..$n); + PERMUTATION: for my $permutation (@permutations) { + $db and say '(' . join(', ', @$permutation) . ')'; + for ( my $i = 0 ; $i < $n ; ++$i ) { + my $char = substr($string, $i, 1); + $db and say "character i = $char"; + # If either of these two violations occur, this is not a compliant permutation: + 'I' eq $char && $permutation->[$i] > $permutation->[$i+1] and next PERMUTATION; + 'D' eq $char && $permutation->[$i] < $permutation->[$i+1] and next PERMUTATION; + } + # If we get to here, this is the first compliant permutation we've found, so return it: + return @$permutation; + } + # If we get to here, no permutation was compliant, so return an empty array: + return (); +} + +# ------------------------------------------------------------------------------------------------------------ +# MAIN BODY OF PROGRAM: + +# Inputs: +my @strings = @ARGV ? eval($ARGV[0]) : +( + # Example 1 Input: + "IDID", + # Expected Output: (0, 4, 1, 3, 2) + + #Example 2 Input: + "III", + # Expected Output: (0, 1, 2, 3) + + #Example 3 Input: + "DDI", + # Expected Output: (3, 2, 0, 1) +); + +# Main loop: +for my $string (@strings) { + # Start by printing a blank line: + say ''; + # Announce this string: + say "String = $string"; + # Skip to next string if string is non-compliant: + my $error = error($string); + 'ok' ne $error and say $error and say 'Skipping to next string.' and next; + # Attempt to get compliant permutation: + my @DI = decrease_increase($string); + 0 == scalar @DI and say 'Unable to form decrease/increase permutation' and next + or say 'decrease/increase permutation: ' and say '('.join(', ', @DI).')'; +} +exit; + +# ------------------------------------------------------------------------------------------------------------ +# DETERMINE AND PRINT EXECUTION TIME: +END {my $µs = 1000000 * (time - $t0);printf("\nExecution time was %.0fµs.\n", $µs)} +__END__ |