Merge pull request #7233 from boblied/master

W 194, bob-lied

3 files changed, 144 insertions, 2 deletions

diff --git a/challenge-194/bob-lied/README b/challenge-194/bob-lied/README
index c231e3a589..08e4900b33 100644
--- a/challenge-194/bob-lied/README
+++ b/challenge-194/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 138 by Bob Lied
+Solutions to weekly challenge 194 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-194/
diff --git a/challenge-194/bob-lied/perl/ch-1.pl b/challenge-194/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..7f69c52ca3
--- /dev/null
+++ b/challenge-194/bob-lied/perl/ch-1.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Perl Weekly Challenge, Week 194, Task 1: Digital Clock
+#=============================================================================
+# Copyright (c) 2022, Bob Lied
+#=============================================================================
+# 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: $time = '?5:00' Output: 1
+#   Since 05:00 and 15:00 are valid time and no other digits can fit in the
+#   missing place.
+# Example 2 Input: $time = '?3:00' Output: 2
+# Example 3 Input: $time = '1?:00' Output: 9
+# Example 4 Input: $time = '2?:00' Output: 3
+# Example 5 Input: $time = '12:?5' Output: 5
+# Example 6 Input: $time = '12:5?' Output: 9
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say replaceDigit($_) for @ARGV;
+
+sub replaceDigit($t)
+{
+    my $pos = index($t, "?");
+    if ( $pos < 0 )
+    {
+        warn "$t does not contain '?'";
+        return '?';
+    }
+
+    return 2 if ( $pos == 0 );
+    return 5 if ( $pos == 3 );
+    return 9 if ( $pos == 4 );
+
+    if ( $pos == 1 ) { return ( substr($t, 0, 1) eq "1" ) ? 9 : 3; }
+
+    warn "$t has '?' in strange place";
+    return '?';
+}
+
+sub runTest
+{
+    use Test::More;
+
+    is( replaceDigit("?3:00"), 2, "?3:00");
+    is( replaceDigit("1?:00"), 9, "?3:00");
+    is( replaceDigit("2?:00"), 3, "?3:00");
+    is( replaceDigit("12:?5"), 5, "?3:00");
+    is( replaceDigit("12:5?"), 9, "?3:00");
+
+    done_testing;
+}
+
diff --git a/challenge-194/bob-lied/perl/ch-2.pl b/challenge-194/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..0c9ad3360e
--- /dev/null
+++ b/challenge-194/bob-lied/perl/ch-2.pl
@@ -0,0 +1,80 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Perl Weekly Challenge Week 194, Task 2: Frequency Equalizer
+#=============================================================================
+# Copyright (c) 2022, Bob Lied
+#=============================================================================
+# 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: $s = 'abbc' Output: 1
+# removing one 'b' will give us 'abc' where each letter frequency is the same.
+# 
+# Example 2: Input: $s = 'xyzyyxz' Output: 1
+# since removing 'y' will give us 'xzyyxz'.
+#
+# Example 3: Input: $s = 'xzxz' Output: 0
+# since removing any one letter would not give us string with same frequency
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw/all/;
+use List::MoreUtils qw/frequency/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say canEqualize($_) for @ARGV;
+
+sub canEqualize($str)
+{
+    my $strlen = length($str);
+
+    if    ( $strlen == 0 ) { return 0; }
+    elsif ( $strlen == 1 ) { return 1; }
+    elsif ( $strlen == 2 ) { return 1; }
+
+    my %freq = List::MoreUtils::frequency( split(//, $str) );
+    my @byFrequency = sort { $freq{$b} <=> $freq{$a} } keys %freq;
+
+    # If there's only one letter
+    return 1 if @byFrequency == 1;
+
+    # Can only be equalized if the most frequent letter occurs
+    # once more than the rest, and all the rest are the same
+
+    #my $isPlusOne = ( $freq{$byFrequency[0]} == $freq{$byFrequency[1]} + 1 );
+    #my @slice = @byFrequency[2 .. $#byFrequency];
+    #my $isSame = List::Util::all { $freq{$_} == $freq{$byFrequency[1]} } @slice;
+    #return $isPlusOne && $isSame;
+    
+    my $can = ( $freq{$byFrequency[0]} == $freq{$byFrequency[1]} + 1 )
+           && List::Util::all { $freq{$_} == $freq{$byFrequency[1]} }
+                               @byFrequency[2 .. $#byFrequency];
+    return $can ? 1 : 0; # We want the numeric value, not undef or ''
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( canEqualize(""),        0, "EMPTY");
+    is( canEqualize("a"),       1, "a");
+    is( canEqualize("ab"),      1, "ab");
+    is( canEqualize("bb"),      1, "bb");
+    is( canEqualize("abbc"),    1, "abbc");
+    is( canEqualize("ffff"),    1, "ffff");
+    is( canEqualize("xyzyyxz"), 1, "xyzyyxz");
+    is( canEqualize("xzxz"),    0, "xzxz");
+    is( canEqualize("axxxz"),   0, "axxxz");
+
+    done_testing();
+}
+