Robbie Hatley's Perl solutions for 194

2 files changed, 114 insertions, 0 deletions

diff --git a/challenge-194/LoneWolfiNTj/perl/ch-1.pl b/challenge-194/LoneWolfiNTj/perl/ch-1.pl
new file mode 100755
index 0000000000..beb9e259c6
--- /dev/null
+++ b/challenge-194/LoneWolfiNTj/perl/ch-1.pl
@@ -0,0 +1,62 @@
+#! /usr/bin/env perl
+# PWCC Challenge 194 Task 1 Perl solution by Robbie Hatley
+
+=pod
+
+Task 1: Digital Clock
+Submitted by: Mohammad S Anwar
+
+You are given time in the format hh:mm with one missing digit.
+Write a script to find the highest digit between 0-9 that makes it
+valid time.
+
+Example 1:  Input: '?5:00'  Output: 1
+Example 2:  Input: '?3:00'  Output: 2
+Example 3:  Input: '1?:00'  Output: 9
+Example 4:  Input: '2?:00'  Output: 3
+Example 5:  Input: '12:?5'  Output: 5
+Example 6:  Input: '12:5?'  Output: 9
+
+=cut
+
+# NOTE: Input is by either default array or CL args. If inputting
+#       by CL args, input must be a space-separated sequence of
+#       one-or-more strings of the form '2?:17' which are capable
+#       of becoming valid times if the '?' is replaced with an
+#       appropriate digit.
+
+# NOTE: Output is to stdout and will be each input string
+#       followed by the highest-valued replacement for '?'
+#       which makes the string a valid time.
+
+use v5.32;
+
+sub valid
+{
+   return 1 if $_[0] =~ m/^\?[0-9]:[0-5][0-9]$/;
+   return 1 if $_[0] =~ m/^[0-2]\?:[0-5][0-9]$/;
+   return 1 if $_[0] =~ m/^(?:(?:[0-1][0-9])|(?:2[0-3])):\?[0-9]$/;
+   return 1 if $_[0] =~ m/^(?:(?:[0-1][0-9])|(?:2[0-3])):[0-5]\?$/;
+   return 0;
+}
+
+my %sub =
+(
+   0 => sub {if (substr($_[0], 1, 1) <= 3) {return 2} else {return 1}},
+   1 => sub {if (substr($_[0], 0, 1) <= 1) {return 9} else {return 3}},
+   3 => sub {return 5},
+   4 => sub {return 9}
+);
+
+# Default input:
+my @times = ('?5:00','?3:00','1?:00','2?:00','12:?5','12:5?');
+
+# Non-Default input:
+if ( scalar(@ARGV) > 0 ) {@times = @ARGV}
+
+for my $time (@times)
+{
+   if (!valid($time)) {say $time, ": ", "invalid";next}
+   my $idx = index $time, '?';
+   say $time, ": ", $sub{$idx}->($time);
+}
\ No newline at end of file
diff --git a/challenge-194/LoneWolfiNTj/perl/ch-2.pl b/challenge-194/LoneWolfiNTj/perl/ch-2.pl
new file mode 100755
index 0000000000..d57bb9737f
--- /dev/null
+++ b/challenge-194/LoneWolfiNTj/perl/ch-2.pl
@@ -0,0 +1,52 @@
+#! /usr/bin/env perl
+# PWCC Challenge 194 Task 2 Perl solution by Robbie Hatley
+
+=pod
+
+Task 2: Frequency Equalizer
+Submitted by: Mohammad S Anwar
+
+You are given a string made of alphabetic characters only, a-z. 
+Write a script to determine whether removing only one character 
+can make the frequency of the remaining characters the same.
+
+Example 1:  Input: 'abbc'     Output: 1
+Example 2:  Input: 'xyzyyxz'  Output: 1
+Example 3:  Input: 'xzxz'     Output: 0
+
+=cut
+
+# NOTE: Input is by either default array or CL args. If inputting
+#       by CL args, input must be a space-separated sequence of
+#       one-or-more strings of lower-case English letters.
+
+# NOTE: Output is to stdout and will be each input string
+#       followed by 0 or 1 depending on whether letter frequency
+#       can be equalized by removing one character.
+
+use v5.32;
+
+# Does an array consist of "all the same" elements?
+sub same {for (@_) {if ($_ != $_[0]) {return 0}} return 1}
+
+# Default inputs: 
+my @strings = ('abbc','xyzyyxz','xzxz');
+
+# Non-default inputs:
+if (scalar(@ARGV) > 0) {@strings = @ARGV}
+
+for my $string (@strings)
+{
+   # Get a reverse-sorted list of frequencies:
+   my @letters = split //, $string ;
+   my %freqs; ++$freqs{$_} for @letters;
+   my @keys = reverse sort {$freqs{$a}<=>$freqs{$b}} keys %freqs;
+   my @vals = map {$freqs{$_}} @keys;
+
+   # Remove one copy of the most-frequent letter:
+   --$vals[0];
+
+   # Are the letter frequencies now all the same?
+   if (same(@vals)) {say $string, ": ", 1}
+   else             {say $string, ": ", 0}
+}
\ No newline at end of file