Skip to main content
7 of 8
deleted 16 characters in body
Ton Hospel
  • 14.9k
  • 1
  • 22
  • 45

Perl, 147 bytes (non competing, takes more than 10 seconds per move)

Includes +4 for -0p

The program plays X. It will play a perfect game.

Input the board on STDIN, e.g.:

tictaclatin.pl
-X-O
-X--
X-X-
O--O
^D

The ouptut will be the same board with all X replaced by O and vice versa. The empty spots will be filled with a number indicating the result if X would play there, with 1 meaning the result will be a win, 2 a draw and 3 a loss. A finished game just returns the same position with the colors reversed.

In this example the output would be:

1O1X
1O33
O3O3
X33X

So the position is a win for X if he plays in the 3 spots along the top and the left. All other moves lose.

This confusing output is actually convenient if you want to know how the game continues after a move. Since the program always plays X you have to swap X and O to see the moves for O. Here for example it's pretty clear that X wins by playing in the top left, but what about if X plays in the third position along the top ? Just copy the output, put an O in place of the move you select and replace all other numbers by - again, so here:

-OOX
-O--
O-O-
X--X

Resulting in:

3XXO
3X33
X3X3
O33O

Obviously every move by O should lose, so how does he lose if he plays in the top left ? Again do this by putting O in the top left and replacing the digits by -:

OXXO
-X--
X-X-
O--O

Giving:

XOOX
1O33
O3O3
X33X

So X has only one way to go for his win:

XOOX
OO--
O-O-
X--X

Giving

OXXO
XX33
X3X3
O33O

The situation for O remains hopeless. It's easy to see now that every move allows X to immediately win. Let's at least try to go for 3 O's in a row:

OXXO
XX--
X-X-
O-OO

Giving:

XOOX
OO13
O3O3
X3XX

X plays the only winning move (notice that this makes XXXO along the third column:

XOOX
OOO-
O-O-
X-XX

Here the output is:

OXXO
XXX-
X-X-
O-OO

because the game was already finished. You can see the win on the third column.

The actual program tictaclatin.pl:

#!/usr/bin/perl -0p
y/XO/OX/,$@=-$@while$|-=/(@{[map{(O.".{$_}O"x3)=~s%O%Z|$`X$'|Z%gr}0,3..5]})(?{$@++})^|$/sx;$@<=>0||s%-%$_="$`O$'";$$_||=2+do$0%eg&&(/1/||/2/-1)

Applied to the empty board this evaluates 9506699 positions which takes 30Gb and 41 minutes on my computer. The result is:

2222
2222
2222
2222

So every starting move draws. So the game is a draw.

The extreme memory usage is mostly caused by the recursion using do$0. Using this 154 byte version using a plain function needs 3Gb and 11 minutes:

#!/usr/bin/perl -0p
sub f{y/XO/OX/,$@=-$@while$|-=/(@{[map{(O.".{$_}O"x3)=~s%O%Z|$`X$'|Z%gr}0,3..5]})(?{$@++})^|$/sx;$@<=>0||s%-%$_="$`O$'";$$_||=2+&f%eeg&&(/1/||/2/-1)}f

which is more bearable (but still too much, something must still be leaking memory).

Combining a number of speedups leads to this 160 byte version (5028168 positions, 4 minutes and 800M for the empty board):

#!/usr/bin/perl -0p
sub f{y/XO/OX/,$@=-$@while$|-=/(@{[map{(O.".{$_}O"x3)=~s%O%Z|$`X$'|Z%gr}0,3..5]})(?{$@++})^|$/osx;$@<=>0||s%-%$_="$`O$'";$a{$_}//=&f+1or return 1%eeg&&/1/-1}f

That last one uses 0 for a win (don't confuse with O), 1 for a draw and 2 for a loss. The output of this one is also more confusing. It fills in the winning move for X in case of a win without color swap, but if the input game was already won is still does the color swap and does not fill in any move.

All versions of course get faster and use less memory as the board fills up. The faster versions should generate a move in under 10 seconds as soon as 2 moves have been made.

In principle this 146 byte version should also work:

#!/usr/bin/perl -0p
y/XO/OX/,$@=-$@while/(@{[map{(O.".{$_}O"x3)=~s%O%Z|$`X$'|Z%gr}0,3..5]})(?{$@++})^/sx,--$|;$@<=>0||s%-%$_="$`O$'";$$_||=2+do$0%eg&&(/1/||/2/-1)

but on my machine it triggers a perl bug and dumps core.

All versions will in principle still work if the 6 byte position caching done by $$_||= is removed but that uses so much time and memory that it only works for almost filled boards. But in theory at least I have a 140 byte solution.

If you put $\= (cost: 3 bytes) just before the $@<=>0 then each output board will be followed by the status of the whole board: 1 for X wins, 0 for draw and -1 for loss.

Here is an interactive driver based on the fastest version mentioned above. The driver has no logic for when the game is finished so you have to stop yourself. The golfed code knows though. If the suggested move returns with no - replaced by anything the game is over.

#!/usr/bin/perl
sub f{
    if ($p++ % 100000 == 0) {
        local $| = 1;
        print ".";
    }
y/XO/OX/,$@=-$@while$|-=/(@{[map{(O.".{$_}O"x3)=~s%O%Z|$`X$'|Z%gr}0,3..5]})(?{$@++})^|$/osx;$@<=>0||s%-%$_="$`O$'";$a{$_}//=&f+1or return 1%eeg&&/1/-1}

# Driver
my $tomove = "X";
my $move = 0;
@board = ("----\n") x 4;
while (1) {
    print "Current board after move $move ($tomove to move):\n  ABCD\n";
    for my $i (1..4) {
        print "$i $board[$i-1]";
    }
    print "Enter a move like B4, PASS (not a valid move, just for setup) or just press enter to let the program make suggestions\n";
    my $input = <> // exit;
    if ($input eq "\n") {
        $_ = join "", @board;
        tr/OX/XO/ if $tomove eq "O";
        $p = 0;
        $@="";
        %a = ();
        my $start = time();
        my $result = f;
        if ($result == 1) {
            tr/OX/XO/ if $tomove eq "O";
            tr/012/-/;
        } else {
            tr/OX/XO/ if $tomove eq "X";
            tr/012/123/;
        }
        $result = -$result if $tomove eq "O";
        my $period = time() - $start;
        print "\nSuggested moves (evaluated $p positions in $period seconds, predicted result for X: $result):\n$_";
        redo;
    } elsif ($input =~ /^pass$/i) {
        # Do nothing
    } elsif (my ($x, $y) = $input =~ /^([A-D])([1-4])$/) {
        $x = ord($x) - ord("A");
        --$y;
        my $ch = substr($board[$y],$x, 1);
        if ($ch ne "-") {
            print "Position already has $ch. Try again\n";
            redo;
        }
        substr($board[$y],$x, 1) = $tomove;
    } else {
        print "Cannot parse move. Try again\n";
        redo;
    }
    $tomove =~ tr/OX/XO/;
    ++$move;
}
Ton Hospel
  • 14.9k
  • 1
  • 22
  • 45