Week 3335 solutios

5 files changed, 359 insertions, 4 deletions

diff --git a/challenge-335/bob-lied/README.md b/challenge-335/bob-lied/README.md
index 44956b4173..d3fba4ba1e 100644
--- a/challenge-335/bob-lied/README.md
+++ b/challenge-335/bob-lied/README.md
@@ -1,5 +1,5 @@
-# Solutions to weekly challenge 334 by Bob Lied
+# Solutions to weekly challenge 335 by Bob Lied
 
-## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-334/)
-## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-334/bob-lied)
-[Blog](https://dev.to/boblied/pwc-334-first-we-do-the-range-sum-then-we-take-manhattan-3n62)
+## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-335/)
+## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-335/bob-lied)
+[Blog Task 1](https://dev.to/boblied/pwc-335-common-characters-532p)
diff --git a/challenge-335/bob-lied/blog.txt b/challenge-335/bob-lied/blog.txt
new file mode 100644
index 0000000000..a50991bde1
--- /dev/null
+++ b/challenge-335/bob-lied/blog.txt
@@ -0,0 +1 @@
+https://dev.to/boblied/pwc-335-common-characters-532p
diff --git a/challenge-335/bob-lied/perl/TTTPlayer.pm b/challenge-335/bob-lied/perl/TTTPlayer.pm
new file mode 100644
index 0000000000..fd2973779a
--- /dev/null
+++ b/challenge-335/bob-lied/perl/TTTPlayer.pm
@@ -0,0 +1,43 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+#  
+#=============================================================================
+
+use v5.42;
+use feature 'class'; no warnings "experimental::class";
+
+class TTTPlayer
+{
+    field $name :param :reader;
+    field $bitmap = 0;
+
+    method move($r, $c) {
+        my $bit = ($r * 3) + $c;
+        $bitmap |= (1 << $bit);
+        return $self;
+    }
+
+    method hasWin() {
+        use feature 'keyword_any'; no warnings "experimental::keyword_any";
+
+        state @Win = ( 0b111000000, # Row 1
+                       0b000111000, # Row 2
+                       0b000000111, # Row 3
+                       0b100100100, # Column 1
+                       0b010010010, # Column 2
+                       0b001001001, # Column 3
+                       0b100010001, # Diagon l NW to SE
+                       0b001010100, # Diagonal NE to SW
+        );
+        return any { ($bitmap & $_ ) == $_ } @Win;
+    }
+
+    method asString() {
+        return sprintf("%s %0.9b", $name, $bitmap);
+    }
+}
+
+1;
diff --git a/challenge-335/bob-lied/perl/ch-1.pl b/challenge-335/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..23d1d365b6
--- /dev/null
+++ b/challenge-335/bob-lied/perl/ch-1.pl
@@ -0,0 +1,144 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 335 Task 1  Common Characters
+#=============================================================================
+# You are given an array of words. Write a script to return all characters
+# that are in every word in the given array including duplicates.
+# Example 1 Input: @words = ("bella", "label", "roller")
+#           Output: ("e", "l", "l")
+# Example 2 Input: @words = ("cool", "lock", "cook")
+#           Output: ("c", "o")
+# Example 3 Input: @words = ("hello", "world", "pole")
+#           Output: ("l", "o")
+# Example 4 Input: @words = ("abc", "def", "ghi")
+#           Output: ()
+# Example 5 Input: @words = ("aab", "aac", "aaa")
+#           Output: ("a", "a")
+#=============================================================================
+
+use v5.42;
+use feature 'keyword_all'; no warnings 'experimental::keyword_all';
+use List::Util qw/min/;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+my $logger;
+{
+    use Log::Log4perl qw(:easy);
+    Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
+            layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
+    $logger = Log::Log4perl->get_logger();
+}
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say '("', join('", "', common(\@ARGV)->@*), '")';
+
+#=============================================================================
+sub common($word)
+{
+    my @common;
+    for my $c ( split(//, shift @$word) )
+    {
+        if ( scalar(@$word) == grep /$c/, @$word )
+        {
+            push @common, $c;
+            $_ =~ s/$c// for @$word;
+        }
+    }
+    return \@common;
+}
+
+sub commonIndex($word)
+{
+    my @common;
+    for my $c ( split(//, shift @$word) )
+    {
+        if ( all { index($_, $c) != -1 } @$word )
+        {
+            push @common, $c;
+            $_ =~ s/$c// for @$word;
+        }
+    }
+    return \@common;
+}
+
+sub commonFreq($word)
+{
+    my %freq;
+    my @common;
+    for my $w ( $word->@* )
+    {
+        $freq{$w}{$_}++ for split(//, $w);
+    }
+
+    for my $letter ( keys $freq{$word->[0]}->%* )
+    {
+        my $count = min(map { $_->{$letter} // 0 } values %freq);
+        push @common, ($letter) x $count;
+    }
+    return [ sort @common ];
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( common( [qw(bella label roller)] ) , [ qw(e l l) ], "Example 1");
+    is( common( [qw(cool lock cook    )] ), [ qw(c o)   ], "Example 2");
+    is( common( [qw(hello world pole  )] ) , [ qw(l o)   ], "Example 3");
+    is( common( [qw(abd def ghi       )] ) , [           ], "Example 4");
+    is( common( [qw(aab aac aaa       )] ), [ qw(a a)   ], "Example 5");
+
+    is( commonIndex( [qw(bella label roller)] ), [ qw(e l l) ], "Example 1");
+    is( commonIndex( [qw(cool lock cook    )] ), [ qw(c o)   ], "Example 2");
+    is( commonIndex( [qw(hello world pole  )] ), [ qw(l o)   ], "Example 3");
+    is( commonIndex( [qw(abd def ghi       )] ), [           ], "Example 4");
+    is( commonIndex( [qw(aab aac aaa       )] ), [ qw(a a)   ], "Example 5");
+
+    is( commonFreq( [qw(bella label roller)] ), [ qw(e l l) ], "Example 1");
+    is( commonFreq( [qw(cool lock cook    )] ), [ qw(c o)   ], "Example 2");
+    is( commonFreq( [qw(hello world pole  )] ), [ qw(l o)   ], "Example 3");
+    is( commonFreq( [qw(abd def ghi       )] ), [           ], "Example 4");
+    is( commonFreq( [qw(aab aac aaa       )] ), [ qw(a a)   ], "Example 5");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    say 'With all common';
+    cmpthese($repeat, {
+            grep  => sub { common( [('xy') x 244] ) },
+            index => sub { commonIndex( [('xy') x 244] ) },
+            freq  => sub { commonFreq( [('xy') x 244] ) }
+        });
+
+    say 'With no common';
+    cmpthese($repeat, {
+            grep  => sub { common( [('aa' .. 'zz')] ) },
+            index => sub { commonIndex( [('aa' .. 'zz')] ) },
+            freq  => sub { commonFreq( [('aa' .. 'zz')] ) }
+        });
+
+    say 'With long strings';
+    my @word = ( 'a' x 1000 );
+    foreach ( 'a' .. 'z' ) { push @word, ($_ x 999) . 'a' }
+    cmpthese($repeat, {
+            grep  => sub { common( [ @word ] ) },
+            index => sub { commonIndex( [ @word ] ) },
+            freq  => sub { commonFreq( [ @word ] ) }
+        });
+}
diff --git a/challenge-335/bob-lied/perl/ch-2.pl b/challenge-335/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..2ba8659bf0
--- /dev/null
+++ b/challenge-335/bob-lied/perl/ch-2.pl
@@ -0,0 +1,167 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 335 Task 2  Find Winner
+#=============================================================================
+# You are given an array of all moves by the two players. Write a script
+# to find the winner of the TicTacToe game if found based on the moves
+# provided in the given array.
+# Example 1 Input: @moves = ([0,0],[2,0],[1,1],[2,1],[2,2])
+#           Output: A
+#   Game Board: [ A _ _ ]
+#               [ B A B ]
+#               [ _ _ A ]
+# Example 2 Input: @moves = ([0,0],[1,1],[0,1],[0,2],[1,0],[2,0])
+#           Output: B
+#   Game Board: [ A A B ]
+#               [ A B _ ]
+#               [ B _ _ ]
+# Example 3 Input: @moves = ([0,0],[1,1],[2,0],[1,0],[1,2],[2,1],[0,1],[0,2],[2,2])
+#           Output: Draw
+#   Game Board: [ A A B ]
+#               [ B B A ]
+#               [ A B A ]
+# Example 4 Input: @moves = ([0,0],[1,1])
+#           Output: Pending
+#   Game Board: [ A _ _ ]
+#               [ _ B _ ]
+#               [ _ _ _ ]
+# Example 5 Input: @moves = ([1,1],[0,0],[2,2],[0,1],[1,0],[0,2])
+#           Output: B
+#   Game Board: [ B B B ]
+#               [ A A _ ]
+#               [ _ _ A ]
+#=============================================================================
+
+use v5.42;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+my $logger;
+{
+    use Log::Log4perl qw(:easy);
+    Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
+            layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
+    $logger = Log::Log4perl->get_logger();
+}
+
+#=============================================================================
+# Solution 1: Procedural, obvious lookup of combinations
+#=============================================================================
+
+sub show($board)
+{
+    my $s = "\n";
+    for my $row ( $board->@* )
+    {
+        $s .= "[ ". join(' ', $row->@*) . " ]\n";
+    }
+    return $s;
+}
+
+sub getRow($board)
+{
+    return ( map { join('', $_->@*) } $board->@* );
+}
+
+sub getCol($board)
+{
+    my @column;
+    for my $col ( 0 .. 2 )
+    {
+        push @column, join('', map { $_->[$col] } $board->@*);
+    }
+    return @column;
+}
+
+sub getDiagonal($board)
+{
+    return ( join('', map { $board->[$_  ][$_] } 0, 1, 2),
+             join('', map { $board->[2-$_][$_] } 2, 1, 0) );
+}
+
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+my @MOVE = map { [split(',', $_)] } @ARGV;
+say findWinner(@MOVE);
+
+#=============================================================================
+sub findWinner(@move)
+{
+    my @board;
+    push @board, [ ('_') x 3 ] for 1 .. 3;
+    state @player = ('A', 'B');
+    my $turn = 0;
+
+    for my $m ( @move )
+    {
+        $board[$m->[0]][$m->[1]] = $player[$turn];
+        $turn = ($turn + 1) % 2;
+    }
+    $logger->debug( show(\@board) );
+
+    my @triple = ( getRow(\@board), getCol(\@board), getDiagonal(\@board) );
+    $logger->debug( "@triple" );
+    use feature 'keyword_any'; no warnings 'experimental::keyword_any';
+    if    ( any { $_ eq 'AAA' } @triple ) { return 'A'; }
+    elsif ( any { $_ eq 'BBB' } @triple ) { return 'B'; }
+    elsif ( scalar(@move) == 9 )          { return 'Draw'; }
+    else                                  { return "Pending"; }
+}
+
+#=============================================================================
+# Solution 2: Using a class for player positions and a bitmap
+#=============================================================================
+use FindBin qw/$Bin/; use lib "$FindBin::Bin";
+use TTTPlayer;
+
+sub findWinnerOO(@move)
+{
+    my @player = ( TTTPlayer->new(name => 'A'), TTTPlayer->new(name => 'B') );
+
+    for my ($i, $m) (indexed @move)
+    {
+        # Odd moves go to player A, even go to player B
+        my $p = $player[$i % 2];
+        if    ( $p->move(@$m)->hasWin() ) { return $p->name(); }
+    }
+    if   ( scalar(@move) == 9 )   { return 'Draw'; }
+    else                          { return "Pending"; }
+}
+
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( findWinner( [0,0],[2,0],[1,1],[2,1],[2,2]       ), 'A', "Example 1");
+    is( findWinner( [0,0],[1,1],[0,1],[0,2],[1,0],[2,0] ), 'B', "Example 2");
+    is( findWinner( [0,0],[1,1],[2,0],[1,0],[1,2],[2,1],[0,1],[0,2],[2,2]), 'Draw', "Example 3");
+    is( findWinner( [0,0],[1,1] ),                         'Pending', "Example 4");
+    is( findWinner( [1,1],[0,0],[2,2],[0,1],[1,0],[0,2] ), 'B',       "Example 5");
+
+    is( findWinnerOO( [0,0],[2,0],[1,1],[2,1],[2,2]       ), 'A', "Example 1 OO");
+    is( findWinnerOO( [0,0],[1,1],[0,1],[0,2],[1,0],[2,0] ), 'B', "Example 2 OO");
+    is( findWinnerOO( [0,0],[1,1],[2,0],[1,0],[1,2],[2,1],[0,1],[0,2],[2,2]), 'Draw', "Example 3 OO");
+    is( findWinnerOO( [0,0],[1,1] ),                         'Pending', "Example 4 OO");
+    is( findWinnerOO( [1,1],[0,0],[2,2],[0,1],[1,0],[0,2] ), 'B',       "Example 5 OO");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}