#!/usr/bin/perl -wT # licence: GPL # author: Ian Hickson # initialise system use strict; # be anal about stuff use diagnostics; # enable fuller diagnostics of warnings use CGI; # Initialize Parameters my $query = new CGI; my $me = 'O'; my $you = 'X'; my $blank = '.'; my $meChar = 'O'; my $youChar = 'X'; my $size = ($query->param('size') or 3); $size = 3 unless $size =~ m/^[0-9]+$/; $size = 4 if $size > 4; my $algorithm = ($query->param('algorithm') or 1); my $maxDepth = ($query->param('maxDepth') or 6); $maxDepth = 6 unless $maxDepth =~ m/^[0-9]+$/; $maxDepth = 6 if $maxDepth =~ m/^[0-9]+$/ and $maxDepth > 5; my $debug = ($query->param('debug') or 0); my %cache; $| = 1; my $debugPre = $debug ? '' : 'display: none; '; warn "$ENV{REMOTE_ADDR} is playing tic-tac-toe on a ${size}x${size} board; algorithm=$algorithm, maxDepth=$maxDepth\n"; # print page print < Tic Tac Toe

Tic Tac Toe

EOF &play($query->param('move'), $query->param('row'), $query->param('cell'), $query->param('board')); my $sizes = ''; foreach (2..4) { $sizes .= " Start a new game.

Let me start a new game.

Mode: Search Depth (Hard Mode Only):

EOF # end # routines sub play { my($move, $row, $cell, $board) = @_; if (not defined($size)) { $size = 3; } my @board = &parse($board); if ($move) { if ($row and $cell) { @board = &processMove($row, $cell, $youChar, @board); } if (not &done(@board)) { @board = &makeMove(@board); } } my $done = &done(@board); if ($done eq $me) { print "

I win.

\n"; } elsif ($done eq $you) { print "

You win.

\n"; } elsif ($done) { print "

It's a draw.

\n"; } else { print "

Your turn!

\n"; } $board = &encode(@board); &paintBoard($done, $board, @board); } sub makeMove { my(@board) = @_; my($row, $cell) = &findSpot(@board); &processMove($row, $cell, $meChar, @board); return @board; } sub findSpot { if ($algorithm == 1) { return findSpotHard(@_); } else { return findSpotEasy(@_); } } sub processMove { my($row, $cell, $who, @board) = @_; if ($row > $size or $row < 1 or $cell > $size or $cell < 0) { die "row ($row) or cell ($cell) out of range ($size)"; } $board[$row-1]->[$cell-1] = $who; return @board; } sub parse { my($board) = @_; if ((not defined($board)) or (length($board) != $size*$size)) { $board = (($blank)x$size)x$size; } my @board = split(//o, $board); foreach (1..$size) { my @row; foreach (1..$size) { push(@row, shift(@board)); } push(@board, \@row); } return @board; } sub encode { my(@board) = @_; my $board = ''; foreach my $row (@board) { foreach my $cell (@$row) { $board .= $cell; } } return $board; } sub paintBoard { my($done, $board, @board) = @_; my $rowNum = 0; print " \n"; foreach my $row (@board) { $rowNum++; print " \n"; my $cellNum = 0; foreach my $cell (@$row) { $cellNum++; my $class = &getClass($rowNum, $cellNum, @board); $class = $class ? ' '.$class : ''; if ($cell eq $me) { print " \n"; } elsif ($cell eq $you) { print " \n"; } else { print " \n"; } } print " \n"; } print "
$meChar$youChar\n"; if (not $done) { &printForm($rowNum, $cellNum, $board); } print "
\n"; } sub printForm { my($row, $cell, $board) = @_; print "
\n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print "
\n"; } # EASY MODE #################################################################### sub findSpotEasy { my(@board) = @_; my @attempt; print " 
winning offence...
\n"; @attempt = &findObvious($me, @board); return (@attempt) if (@attempt); print " 
emergency defense...
\n"; @attempt = &findObvious($you, @board); return (@attempt) if (@attempt); print " 
meta defense...
\n"; @attempt = &findSemiObvious($you, @board); return (@attempt) if (@attempt); print " 
meta offense...
\n"; @attempt = &findSemiObvious($me, @board); return (@attempt) if (@attempt); my $rowNum; my $cellNum; print " 
obscure attacks...
\n"; $rowNum = 0; foreach my $row (@board) { $rowNum++; $cellNum = 0; foreach my $cell (@$row) { $cellNum++; @attempt = &checkSquare($rowNum, $cellNum, [$blank], [$blank, $me], [$you], [], $size, 2, @board); if (@attempt) { @attempt = &checkSquare($rowNum, $cellNum, [$blank], [$blank, $me, $you], [], [], $size, 3, @board); return (@attempt) if (@attempt); # .....x... -> O....x... } @attempt = &checkSquare($rowNum, $cellNum, [$blank], [$you, $me], [], [], $size-1, 1, @board); if (@attempt) { @attempt = &checkSquare($rowNum, $cellNum, [$blank], [$blank], [], [], $size, 2, @board); return (@attempt) if (@attempt); # O...X.... -> O...X...O -> O wins vs O...X.... O.O.X... -> draw } } } print " 
obscure defences...
\n"; # ........X -> ...O....X -> X..O....X -> draw vs ........X ....O...X-> O...O...X -> X wins $rowNum = 0; foreach my $row (@board) { $rowNum++; $cellNum = 0; foreach my $cell (@$row) { $cellNum++; @attempt = &checkSquare($rowNum, $cellNum, [$blank], [$blank], [], [], $size, 2, @board); if (not @attempt) { @attempt = &checkSquare($rowNum, $cellNum, [$blank], [$blank, $you], [], [$me], $size, 1, @board); return (@attempt) if (@attempt); } } } foreach my $possibilities (4, 3, 2, 1) { print " 
first square with at least $possibilities possibilities...
\n"; $rowNum = 0; foreach my $row (@board) { $rowNum++; $cellNum = 0; foreach my $cell (@$row) { $cellNum++; @attempt = &checkSquare($rowNum, $cellNum, [$blank], [$blank, $me], [], [], $size, $possibilities, @board); return (@attempt) if (@attempt); } } } # cannot win, go anywhere that blocks them print " 
Cannot win, looking to block...
\n"; $rowNum = 0; foreach my $row (@board) { $rowNum++; $cellNum = 0; foreach my $cell (@$row) { $cellNum++; @attempt = &checkSquare($rowNum, $cellNum, [$blank], [$you], [], [], 1, 1, @board); return (@attempt) if (@attempt); } } # cannot block (?!), go anywhere at all! print " 
Cannot even block, going in first free block...
\n"; $rowNum = 0; foreach my $row (@board) { $rowNum++; $cellNum = 0; foreach my $cell (@$row) { $cellNum++; return ($rowNum, $cellNum) if $board[$rowNum-1]->[$cellNum-1] eq $blank; } } die "No Spaces Left!"; } sub findObvious { my($target, @board) = @_; my $rowNum; my $cellNum; $rowNum = 0; foreach my $row (@board) { $rowNum++; $cellNum = 0; foreach my $cell (@$row) { $cellNum++; my @result = &checkSquare($rowNum, $cellNum, [$blank], [$target], [], [], $size-1, 1, @board); return @result if @result; } } return; } sub findSemiObvious { my($target, @board) = @_; my $rowNum; my $cellNum; $rowNum = 0; foreach my $row (@board) { $rowNum++; $cellNum = 0; foreach my $cell (@$row) { $cellNum++; my @result = &checkSquare($rowNum, $cellNum, [$blank], [$target, $blank], [], [$target eq $me ? $you : $me], $size, 2, @board); if (@result) { my @result = &checkSquare($rowNum, $cellNum, [$blank], [$target], [], [$target eq $me ? $you : $me], 1, 2, @board); return @result if @result; } } } return; } # HARD MODE #################################################################### sub findSpotHard { my(@board) = @_; my @scores; print "
\ntic-tac-toe algorithm\n";
    foreach my $rowNum (1..@board) {
        foreach my $cellNum (1..@{$board[$rowNum-1]}) {
            if ($board[$rowNum-1]->[$cellNum-1] eq $blank) {
                print "placing $me at $rowNum, $cellNum\n";
                my $score = &tryMove($rowNum, $cellNum, $me, $you, 1, ' |', &cloneBoard(@board));
                print " + sum of scores for $rowNum, $cellNum: $score\n";
                push(@scores, [$rowNum, $cellNum, $score]);
            }
        }
    }
    @scores = sort { $b->[2] <=> $a->[2] } @scores;
    print "
\n"; return ($scores[0]->[0], $scores[0]->[1]); } # performs a move sub tryMove { my($row, $cell, $a, $b, $depth, $prefix, @board) = @_; return 0 if ($depth > $maxDepth); my $encoded = &encode(@board); my $key = "$row|$cell|$a|$depth|$encoded"; if ($cache{$key}) { print "$prefix + FROM CACHE: $cache{$key} \n" if $debug; return $cache{$key}; } else { $board[$row-1]->[$cell-1] = $a; my $encodedAgain = &encode(@board); print "$prefix + state: $encodedAgain \n" if $debug; my $return = 0; my $result = &tryDone(@board); if ($result) { print "$prefix + end of the line, '$result' win " if $debug; if ($result eq $you) { # loss. $return = -1; } elsif ($result eq $me) { # win! $return = $size**($size*$size - $depth); } else { # draw... $return = 0; } print "($return)\n" if $debug; } else { my $score; loop: foreach my $rowNum (1..@board) { foreach my $cellNum (1..@{$board[$rowNum-1]}) { if ($board[$rowNum-1]->[$cellNum-1] eq $blank) { print "$prefix + placing $b at $rowNum, $cellNum\n" if $debug; my $newScore = (&tryMove($rowNum, $cellNum, $b, $a, $depth+1, "$prefix |", &cloneBoard(@board))); if ($b eq $me) { if ($newScore >= 1) { $return = $newScore; # we can win if they do whatever it was we suggested in the previous level last loop; } elsif ($newScore == 0) { # if we do this we'll draw $score = 0 if defined $score and $score < 0; } elsif ($newScore == -1) { $score = -1 unless defined($score); } else { die "negative score!"; } } else { if ($newScore == -1) { # we lose if they do this move $return = -1; # whatever move we last tried should never be done last loop; } else { if (defined $score) { $score += $newScore+1; } else { $score = $newScore+1; } } } } } } if ($return == 0 and defined($score)) { $return = $score; } print "$prefix ' ($return)\n" if $debug; } print "$prefix\n" if $debug; $cache{$key} = $return; return $return; } } sub cloneBoard { my(@board) = @_; my @newboard; foreach my $rowNum (1..@board) { my @newrow; foreach my $cellNum (1..@{$board[$rowNum-1]}) { push(@newrow, $board[$rowNum-1]->[$cellNum-1]); } push(@newboard, [@newrow]); } return @newboard; } sub tryDone { my(@board) = @_; # flatten the board my $flatRows; my $flatCells; my $flatDiag1; my $flatDiag2; foreach my $a (0..$size-1) { foreach my $b (0..$size-1) { $flatRows .= $board[$a]->[$b]; $flatCells .= $board[$b]->[$a]; } $flatRows .= '|'; $flatCells .= '|'; $flatDiag1 .= $board[$a]->[$a]; $flatDiag2 .= $board[$a]->[$size-$a-1]; } my $flat = "$flatRows$flatCells$flatDiag1|$flatDiag2"; my $yous = $you x $size; my $mes = $me x $size; return $you if $flat =~ /\Q$yous\E/o; return $me if $flat =~ /\Q$mes\E/o; return 0 if $flat =~ /[$blank$me]{$size}/o; return 0 if $flat =~ /[$blank$you]{$size}/o; return $blank; } # HELPER FUNCTIONS ############################################################# sub in { my($value, @allowedValues) = @_; foreach (@allowedValues) { die "no value!" unless $value; return 1 if $_ eq $value; } return 0; } sub done { my(@board) = @_; my $rowNum; my $cellNum; my @result; # any winners? $rowNum = 0; foreach my $row (@board) { $rowNum++; $cellNum = 0; foreach my $cell (@$row) { $cellNum++; @result = &checkSquare($rowNum, $cellNum, [$you], [$you], [], [], $size, 1, @board); return $you if @result; @result = &checkSquare($rowNum, $cellNum, [$me], [$me], [], [], $size, 1, @board); return $me if @result; } } # draw? $rowNum = 0; foreach my $row (@board) { $rowNum++; $cellNum = 0; foreach my $cell (@$row) { $cellNum++; @result = &checkSquare($rowNum, $cellNum, [$blank], [$you, $blank], [], [], $size, 1, @board); return 0 if @result; @result = &checkSquare($rowNum, $cellNum, [$blank], [$me, $blank], [], [], $size, 1, @board); return 0 if @result; } } return $blank; } sub getClass { my($row, $cell, @board) = @_; my @result; @result = &checkSquare($row, $cell, [$you], [$you], [], [], $size, 1, @board); return 'won' if @result; @result = &checkSquare($row, $cell, [$me], [$me], [], [], $size, 1, @board); return 'won' if @result; return ''; } sub checkSquare { my($rowNum, $cellNum, $directValues, $allowedValues, $disallowedValuesEverywhere, $disallowedValuesOnMatchingRows, $requiredCount, $requiredDifferentCount, @board) = @_; my $differentCount = 0; my $count; my $pos; if (&in($board[$rowNum-1]->[$cellNum-1], @$directValues)) { # horizontal $count = 0; foreach my $otherCell (@{$board[$rowNum-1]}) { if (&in($otherCell, @$disallowedValuesEverywhere)) { return; } if (&in($otherCell, @$disallowedValuesOnMatchingRows)) { $count = 0; last; } if (&in($otherCell, @$allowedValues)) { $count++; } } if ($count >= $requiredCount) { $differentCount++; } # vertical $count = 0; foreach my $otherRow (@board) { if (&in($otherRow->[$cellNum-1], @$disallowedValuesEverywhere)) { return; } if (&in($otherRow->[$cellNum-1], @$disallowedValuesOnMatchingRows)) { $count = 0; last; } if (&in($otherRow->[$cellNum-1], @$allowedValues)) { $count++; } } if ($count >= $requiredCount) { $differentCount++; } # diagonal nwse if ($rowNum == $cellNum) { $count = 0; $pos = 0; foreach my $otherRow (@board) { $pos++; if (&in($otherRow->[$pos-1], @$disallowedValuesEverywhere)) { return; } if (&in($otherRow->[$pos-1], @$disallowedValuesOnMatchingRows)) { $count = 0; last; } if (&in($otherRow->[$pos-1], @$allowedValues)) { $count++; } } if ($count == $requiredCount) { $differentCount++; } } # diagonal nesw if ($rowNum == $size-$cellNum+1) { $count = 0; $pos = 0; foreach my $otherRow (@board) { $pos++; if (&in($otherRow->[$size-$pos], @$disallowedValuesEverywhere)) { return; } if (&in($otherRow->[$size-$pos], @$disallowedValuesOnMatchingRows)) { $count = 0; last; } if (&in($otherRow->[$size-$pos], @$allowedValues)) { $count++; } } if ($count == $requiredCount) { $differentCount++; } } } if ($differentCount >= $requiredDifferentCount) { return ($rowNum, $cellNum); } else { return; } }