Merge pull request #7241 from Util/branch-for-challenge-194

Add TWC 194 blog post and solutions by Bruce Gray (Raku and Perl)

6 files changed, 218 insertions, 0 deletions

diff --git a/challenge-194/bruce-gray/blog.txt b/challenge-194/bruce-gray/blog.txt
new file mode 100644
index 0000000000..bd83ca08a4
--- /dev/null
+++ b/challenge-194/bruce-gray/blog.txt
@@ -0,0 +1 @@
+https://blogs.perl.org/users/bruce_gray/2022/12/twc-194-bag-time.html
diff --git a/challenge-194/bruce-gray/perl/ch-1.pl b/challenge-194/bruce-gray/perl/ch-1.pl
new file mode 100644
index 0000000000..1b2893b703
--- /dev/null
+++ b/challenge-194/bruce-gray/perl/ch-1.pl
@@ -0,0 +1,24 @@
+use v5.36;
+use List::Util qw<first>;
+
+sub task1 ($s) {
+    state %VALID_TIMES = map { my $m = $_; map {; "$_:$m" => 1 } '00'..'23' } '00'..'59';
+
+    return first { $VALID_TIMES{ $s =~ s/\?/$_/r } } reverse 0..9;
+}
+
+
+my @tests = (
+    [ '?5:00', 1 ],
+    [ '?3:00', 2 ],
+    [ '1?:00', 9 ],
+    [ '2?:00', 3 ],
+    [ '12:?5', 5 ],
+    [ '12:5?', 9 ],
+);
+use Test::More;
+plan tests => 0+@tests;
+for (@tests) {
+    my ($in, $expected) = @{$_};
+    is task1($in), $expected, "task1($in) == $expected";
+}
diff --git a/challenge-194/bruce-gray/perl/ch-2.pl b/challenge-194/bruce-gray/perl/ch-2.pl
new file mode 100644
index 0000000000..ceb6a97835
--- /dev/null
+++ b/challenge-194/bruce-gray/perl/ch-2.pl
@@ -0,0 +1,45 @@
+use v5.36;
+use List::Util qw<uniq>;
+
+# Translation of my Raku solution.
+sub task2 ($s) {
+    my %h;
+    $h{$_}++ for split '', $s;
+    my @k = keys %h;
+
+    for my $k (@k) {
+        $h{$k}--;
+
+        my $c = 0 + grep { $_ != 0 } uniq values %h;
+
+        return 1 if $c == 0
+                 or $c == 1;
+
+        $h{$k}++;
+    }
+    return 0;
+}
+
+
+my @tests = (
+    [ 'abbc'    , 1 ], # Removing one alphabet 'b' will give us 'abc' where each alphabet frequency is the same.
+    [ 'xyzyyxz' , 1 ], # Removing 'y' will give us 'xzyyxz'.
+    [ 'xzxz'    , 0 ], # Removing any one alphabet would not give us string with same frequency alphabet.
+
+    # True if there is one of each character
+    [ 'abcdefg' , 1 ],
+    [ 'ab'      , 1 ],
+    [ 'a'       , 1 ],
+
+    [ 'aabbccdd' , 0 ],  # False if there is >one of each character; same of all:
+    [ 'aa'       , 1 ],  # True  if there is >one of each character; 1group     :
+
+    [ 'aaabbbcccc', 1 ],
+    [ 'aaabbbcc'  , 0 ],
+);
+use Test::More;
+plan tests => 0+@tests;
+for (@tests) {
+    my ($in, $expected) = @{$_};
+    is task2($in), $expected, "task2($in) == $expected";
+}
diff --git a/challenge-194/bruce-gray/raku/ch-1.raku b/challenge-194/bruce-gray/raku/ch-1.raku
new file mode 100644
index 0000000000..96cd41127b
--- /dev/null
+++ b/challenge-194/bruce-gray/raku/ch-1.raku
@@ -0,0 +1,23 @@
+sub is_time_valid ( Str $s --> Bool ) {
+    constant $valid_times = ( ^24 X ^60 ).map( *.fmt('%02d', ':') ).Set;
+    return $s ∈ $valid_times;
+}
+sub task1 ( Str $s --> UInt ) {
+    return (9…0).first: { $s.subst( '?', $_ ).&is_time_valid };
+}
+# See ch-1_compare.raku for alternate solutions
+
+
+constant @tests =
+    ( '?5:00', 1 ),
+    ( '?3:00', 2 ),
+    ( '1?:00', 9 ),
+    ( '2?:00', 3 ),
+    ( '12:?5', 5 ),
+    ( '12:5?', 9 ),
+;
+use Test;
+plan +@tests;
+for @tests -> ($in, $expected) {
+    is task1($in), $expected, "task1($in) == $expected";
+}
diff --git a/challenge-194/bruce-gray/raku/ch-1_compare.raku b/challenge-194/bruce-gray/raku/ch-1_compare.raku
new file mode 100644
index 0000000000..3169145504
--- /dev/null
+++ b/challenge-194/bruce-gray/raku/ch-1_compare.raku
@@ -0,0 +1,88 @@
+sub task1 ( Str $s --> UInt ) {
+    constant $OK_times = ( ^24 X ^60 ).map( *.fmt('%02d', ':') ).Set;
+
+    return (9…0).first: { $s.subst( '?', $_ ) ∈ $OK_times };
+}
+
+sub task1_fully_precalculated ( Str $s --> UInt ) {
+    constant %solution = gather for ( ^24 X ^60 ).map( *.fmt('%02d', ':') ) -> $t {
+        for 0,1,3,4 -> $pos {
+            my $was = $t.substr($pos, 1);
+            my $tt = $t;
+            $tt.substr-rw($pos, 1) = '?';
+            take $tt => +$was;
+        }
+    }
+
+    return %solution{$s} // die;
+}
+
+sub task1_regex_ternary ( Str $_ --> UInt ) {
+    return / ^ \?       <[0..3]> ':' \d \d $ / ?? 2
+        !! / ^ \?       <[4..9]> ':' \d \d $ / ?? 1
+        !! / ^ <[0..1]>       \? ':' \d \d $ / ?? 9
+        !! / ^ 2              \? ':' \d \d $ / ?? 3
+        !! / ^ \d             \d ':' \? \d $ / ?? 5
+        !! / ^ \d             \d ':' \d \? $ / ?? 9
+        !!                                        die;
+}
+
+sub is_time_valid_1 ( Str $s --> Bool ) { # same as my `task1`, but extracted.
+    constant $valid_times = ( ^24 X ^60 ).map( *.fmt('%02d', ':') ).Set;
+    return $s ∈ $valid_times;
+}
+sub is_time_valid_2 ( Str $_ --> Bool ) {
+    return /^ (<[0..9]> ** 2) ** 2 % ':' $/ && (
+        ( $0[0] ~~ ^24  && $0[1] ~~ ^60  )
+     # || ( $0[0] eq '24' && $0[1] eq '00' ) # Uncomment to make `24:00` OK.
+    );
+}
+sub is_time_valid_3 ( Str $s --> Bool ) {
+    # Alternate approach, condensed from the excellent code
+    # of 冯昶 (feng-chang) and Jan Krňávek (wambash) :
+    return ? try "{Date.today}T{$s}:00".DateTime;
+}
+sub task1_is_1 ( Str $s --> UInt ) { return (9…0).first: { $s.subst( '?', $_ ).&is_time_valid_1 } }
+sub task1_is_2 ( Str $s --> UInt ) { return (9…0).first: { $s.subst( '?', $_ ).&is_time_valid_2 } }
+sub task1_is_3 ( Str $s --> UInt ) { return (9…0).first: { $s.subst( '?', $_ ).&is_time_valid_3 } }
+
+constant @tests =
+    ( '?5:00', 1 ),
+    ( '?3:00', 2 ),
+    ( '1?:00', 9 ),
+    ( '2?:00', 3 ),
+    ( '12:?5', 5 ),
+    ( '12:5?', 9 ),
+;
+use Test;
+plan +@tests + 1;
+for @tests -> ($in, $expected) {
+    is task1($in), $expected, "task1($in) == $expected";
+}
+
+{
+    my @subs =
+        &task1,
+        &task1_fully_precalculated,
+        &task1_regex_ternary,
+        &task1_is_1,
+        &task1_is_2,
+        &task1_is_3,
+    ;
+
+    # (10*60)+( 3*60)+(24*10)+(24* 6) = 1164 elements in @all_inputs.
+    my @all_inputs = unique gather for ( ^24 X ^60 ).map( *.fmt('%02d', ':') ) -> $t {
+        take $t.subst(:nth($_), /\d/, '?') for 1..4;
+    }
+
+    my $failed = False;
+    for @all_inputs.sort -> $k {
+        my @a = @subs.map: { .($k) };
+        if @a[0] ne @a.all {
+            $failed = True;
+            note "Failed for Input: $k: ", @a.raku;
+            last; 
+        }
+    }
+    ok !$failed, "All subs agreed on all inputs";
+}
diff --git a/challenge-194/bruce-gray/raku/ch-2.raku b/challenge-194/bruce-gray/raku/ch-2.raku
new file mode 100644
index 0000000000..1cc57d2856
--- /dev/null
+++ b/challenge-194/bruce-gray/raku/ch-2.raku
@@ -0,0 +1,37 @@
+# Best compromise between performance, complexity, reducing chance to "get it wrong",
+# and likelihood of a maintenance programmer to reverse-engineer the original requirements.
+sub task2 ( Str $s --> Bool ) {
+    my BagHash $b = $s.comb.BagHash;
+    my @k = $b.keys;
+
+    for @k -> $k {
+        $b.remove: $k;
+        return True if $b.values.unique.elems == 0|1;
+        $b.add:    $k;
+    }
+    return False;
+}
+# See ch-2_compare.raku for alternate solutions
+
+
+constant @tests =
+    ( 'abbc'    , 1 ), # Removing one alphabet 'b' will give us 'abc' where each alphabet frequency is the same.
+    ( 'xyzyyxz' , 1 ), # Removing 'y' will give us 'xzyyxz'.
+    ( 'xzxz'    , 0 ), # Removing any one alphabet would not give us string with same frequency alphabet.
+
+    # True if there is one of each character
+    ( 'abcdefg' , 1 ),
+    ( 'ab'      , 1 ),
+    ( 'a'       , 1 ),
+
+    ( 'aabbccdd' , 0 ),  # False if there is >one of each character; same of all
+    ( 'aa'       , 1 ),  # True  if there is >one of each character; 1group
+    
+    ( 'aaabbbcccc', 1 ),
+    ( 'aaabbbcc'  , 0 ),
+;
+use Test;
+plan +@tests;
+for @tests -> ($in, $expected) {
+    is +task2($in), $expected, "task2($in) == $expected";
+}