(Perl) tic-tac-toe demo

gistfile1.txt

#!perl
use v5.42;
use List::Util qw(reduce);
use open qw(:std :utf8);

=encoding utf8

=head1 NAME

tic-tac-toe-winner.pl - decide if a game board shows a winning arrangement

=head1 SYNOPSIS

The first argument is the game board. Whitespace does not matter, and C<.>
notes an empty position (mandatory):

	% tic-tac-toe-winner.pl 'x o x  . x o  o o x'
	x wins

	% perl tic-tac-toe.pl '
		xox
		ooo
		x.x'
	o wins

=head1 DESCRIPTION

I saw Joe Marshall's tic-tac-toe interview question / vibe coding blog post
(L<https://funcall.blogspot.com/2026/09/when-i-did-interviews-for-google-one-of.html>)
and decided to try my hand at a solution before I read what his LLM came up with.

The trick with Tic Tac Toe is that you know every winning game board and there
aren't that many solutions. You have to check for 8 (or 16) different situations,
so you can be clever about that.

Most people might go for a data structure and walk it in various ways. That's
gross. It's easy to make mistakes with modulus math, you might have to use up
a bunch of memory you don't want to give up (well, maybe not in C). It's the
sort of knee-jerk solution that you reach for because you don't take a breath
before starting.

I had some other ideas.

=head2 Graphs

You can represent all of the winning combinations as paths on a graph, then prune
the tree of paths. For example, if the target side does not occupy the center square,
which is the node with the most paths, you can exclude all those paths. Then the
corner squares knock out various paths if not occupied. At the end, you see if any paths
are left. That still might be interesting.

=head2 Forests

Well, graphs in another way. There are certain starting positions that lead to
three in a row, so, start there and walk the trees. You don't have to check every
square as a starting position because they either can't be (the center) or they are
already included in another tree (so would be the leaves instead of the root).

=head2 Exhaustion

Just generate every board, categorize it, then hard-code it. I almost went
there since that is not that hard, but instead I built-in flexibility for
memoization so I can build that up run after run. I don't implement that
though, because I don't need every board configuration. I just need to know if
one of the eight winning situations exists.

=head2 Not exhausted, just a bit drowsy

I enumerated the winning positions, and built up a data structure from there.
As the program checks positions, it can remember what it has already evaluated.
This turns out to be nice because it allows the same solution to expand to bigger
game boards. I could probably take a step back in making that data structure
since we know what the positions will be (rows, columns, two diagonals).

In the graphs or forests solutions, I have to do more checks. I have to check
each starting position, and then several more. I reduce all of this ahead of time
by summing the position values (as their positions), and each winning combination
sums to a unique number.

I still check all eight situations because there can be two winning situations
(a row and column, or a diagonal and row or column). Once I've computed the
data structure, I do eight ANDs and a comparison. That isn't that interesting
here because the higher-level script does one game at a time.

=head1 Exit codes

=over 4

=item 1 - invalid game

=item 64 - x won

=item 65 - o won

=item 66 - draw

=back

=head1 AVAILABILITY

=head1 AUTHOR

brian d foy C<< <briandfoy@pobox.com> >>

=head1 COPYRIGHT

Copyright 2026, brian d foy C<< <bdfoy@cpan.org> >>

=cut

run(@ARGV) unless caller;

sub run (@args) {
	my( $game ) = @args;

	my $x_won = x_won($game);
	if( ! defined $x_won ) {
		warn "Invalid game!\n";
		exit(1);
		}
	elsif( $x_won ) {
		say "x wins";
		exit(64);
		}
	elsif( o_won($game) ) {
		say "o wins";
		exit(65);
		}
	# there should also be a branch for an incomplete game
	else {
		say "Draw!";
		exit(66);
		}
	}

=pod

	[ qw(0 1 2) ],   7
	[ qw(0 3 6) ],  73
	[ qw(0 4 8) ], 273
	[ qw(1 4 7) ], 146
	[ qw(2 4 6) ],  84
	[ qw(2 5 8) ], 292
	[ qw(3 4 5) ],  56
	[ qw(6 7 8) ], 448

=cut

BEGIN {
	my $DIM = 3;
	my $DIM_SQUARED = $DIM*$DIM;

	my @R = (0 .. $DIM - 1);

	# the winners are either 1) all same row 2) all the same column 3) diagonals
	# we can compute this for any dimension
	my @winners = map { [ $_, reduce { $a + $b } map { 1 << $_ } $_->@* ] }
		(
		( map { my $row = $_; [ map { $row*$DIM + $_            } @R ] } @R ),
		( map { my $col = $_; [ map {   $_*$DIM + $col          } @R ] } @R ),
							  [ map {   $_*$DIM + $_            } @R ],
							  [ map {   $_*$DIM + $DIM - $_ - 1 } @R ],
		);

	sub x_won ( $game ) {
		# we could persist the %memo results and load them later, eventually having
		# a completely expert system.
		state %memo = ();

		# the next time just gets the game string into the representation we want
		# x for x, o for o, and . for empty boxes. Everything else, such as spaces
		# and newlines, go away.
		$game = lc(trim($game));
		my $g = $game =~ s/[^xo.]//gr;

		# after all that reduction, do we have a valid board?
		# 1. There are exactly nine spots (should be . pad in the previous step?)
		# 2. The number of x's and o's are within 1 of each other
		return if $DIM_SQUARED != length $g;
		return if 1 < abs( $g =~ tr/x/x/ - $g =~ tr/o/o/ );

		# convert to binary string representation on the way to a Perl number
		$g =~ s/(.)/ $1 eq 'x' ? 1 : 0 /eg;
		$g = oct("0b$g"); # oct also does binary conversion too, so go figure

		unless( exists $memo{$g} ) {
			# a game can have more than one connected line, so save all of them
			$memo{$g} = [ grep { ($g & $_->[1]) == $_->[1] } @winners ];
			}

		return 0 + $memo{$g}->@*
		}

	sub o_won ( $game ) { my $G = $game =~ tr/xo/ox/r; x_won($G) }
}

__END__