Merge pull request #12546 from wlmb/challenges

Solve PWC335

3 files changed, 76 insertions, 0 deletions

diff --git a/challenge-335/wlmb/blog.txt b/challenge-335/wlmb/blog.txt
new file mode 100644
index 0000000000..a06ecc83b0
--- /dev/null
+++ b/challenge-335/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2025/08/18/PWC335/
diff --git a/challenge-335/wlmb/perl/ch-1.pl b/challenge-335/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..367a355bf8
--- /dev/null
+++ b/challenge-335/wlmb/perl/ch-1.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 335
+# Task 1:  Common Characters
+#
+# See https://wlmb.github.io/2025/08/18/PWC335/#task-1-common-characters
+use v5.36;
+use List::Util qw(min);
+die <<~"FIN" unless @ARGV;
+    Usage: $0 W1 W2...
+    to show characters common to all words W1 W2...
+    FIN
+my @words;
+for(@ARGV){                                                 # count letters in each word
+    my %letters;
+    $letters{$_}++ for split "", $_;
+    push @words, {%letters}
+}
+my %result=%{$words[0]};                                    # check letters in first word
+for my $letter(keys %result){
+    $result{$letter}=min map{$_->{$letter}//0} @words
+}
+say "@ARGV -> ", map {"$_ " x $result{$_}}
+                 sort {$a cmp $b} keys %result;
diff --git a/challenge-335/wlmb/perl/ch-2.pl b/challenge-335/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..6d7084c7d2
--- /dev/null
+++ b/challenge-335/wlmb/perl/ch-2.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 335
+# Task 2:  Find Winner
+#
+# See https://wlmb.github.io/2025/08/18/PWC335/#task-2-find-winner
+use v5.36;
+use feature qw(try);
+use PDL;
+die <<~"FIN" unless @ARGV;
+    Usage: $0 G1 G2...
+    to find the winner in the tic tac toe game Gi.
+    Each game is a string with the format
+    "[[X0 Y0][X1 Y1]...]"
+    where Xi Yi are the coordinates of the ith move, in the range 0..2.
+    Even numbered moves correspond to player A and odd to player B.
+    FIN
+my @players=map {"Player $_"}  qw(A B);
+my $result;
+for(@ARGV){
+    try {
+	my $moves=pdl($_);
+	die "Wrong shape. Expected array of 2D vectors: $_"
+	    unless $moves->dim(0)==2;  # each move should be 2D vector
+	die "Wrong move. Expected 0<=coordinate<=2: $_"
+	    unless 0 <= $moves->min && $moves->max <= 2;
+	die "Repeated moves are invalid: $_"
+	    unless $moves->uniqvec->dim(1)==$moves->dim(1);
+	my $length=$moves->dim(1);   # length of game
+	my $last=1-$length%2;        # last player
+	$result = "Pending", next if $length < 5; # game was too short
+	$result = $players[$last], next if
+	    win(
+		$moves->slice(":,$last:-2:2")   # previous moves of last player
+		-$moves->slice(":,-1")       # with respect to last move
+	    );
+	$result = "Draw", next
+	    if $moves->dim(1)==9;   # finished game without a winner
+	$result= "Pending";         # unfinished game
+    } catch($e) {
+	say $e;
+	undef $result;
+    }
+} continue{
+    say "$_ -> $result" if defined $result;
+}
+sub win($relative){ # moves by one player relative to last
+    my $length=$relative->dim(1);
+    return (($relative->slice("(0)")*$relative->slice("(1),*")
+	     - $relative->slice("(1)")*$relative->slice("(0),*")) # compute determinants
+	    ==0)->sum  # count zeroes
+	> $length;     # win if larger than the trivial number
+}