Perl, 147 bytes (no compite, toma más de 10 segundos por movimiento)
Incluye +4 para -0p
El programa juega X. Jugará un juego perfecto.
Ingrese la placa en STDIN, por ejemplo:
tictaclatin.pl
-X-O
-X--
X-X-
O--O
^D
La salida será la misma placa con todos Xreemplazados por Oy viceversa. Los espacios vacíos se llenarán con un número que indica el resultado si X jugaría allí, lo que 1significa que el resultado será una victoria, 2un empate y 3una derrota. Un juego terminado solo devuelve la misma posición con los colores invertidos.
En este ejemplo, la salida sería:
1O1X
1O33
O3O3
X33X
Entonces, la posición es una victoria Xsi juega en los 3 lugares a lo largo de la parte superior e izquierda. Todos los demás movimientos pierden.
Este resultado confuso es realmente conveniente si quieres saber cómo continúa el juego después de un movimiento. Como el programa siempre se reproduce, Xdebes intercambiar Xy Over los movimientos O. Aquí, por ejemplo, está bastante claro que Xgana jugando en la parte superior izquierda, pero ¿qué pasa si Xjuega en la tercera posición en la parte superior? Simplemente copie el resultado, coloque un Olugar en el movimiento que seleccione y reemplace todos los demás números de -nuevo, así que aquí:
-OOX
-O--
O-O-
X--X
Resultando en:
3XXO
3X33
X3X3
O33O
Obviamente, cada movimiento Odebe perder, entonces, ¿cómo pierde si juega en la esquina superior izquierda? Nuevamente, haga esto colocando Oen la esquina superior izquierda y reemplazando los dígitos por -:
OXXO
-X--
X-X-
O--O
Dando:
XOOX
1O33
O3O3
X33X
Entonces X solo tiene un camino por recorrer para su victoria:
XOOX
OO--
O-O-
X--X
Dando
OXXO
XX33
X3X3
O33O
La situación para Osigue siendo desesperada. Es fácil ver ahora que cada movimiento permite Xganar de inmediato. Al menos intentemos hacer 3 O seguidas:
OXXO
XX--
X-X-
O-OO
Dando:
XOOX
OO13
O3O3
X3XX
Xjuega el único movimiento ganador (observe que esto se realiza XXXOen la tercera columna:
XOOX
OOO-
O-O-
X-XX
Aquí la salida es:
OXXO
XXX-
X-X-
O-OO
porque el juego ya estaba terminado. Puedes ver la victoria en la tercera columna.
El programa actual 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)
Aplicado al tablero vacío, esto evalúa 9506699 posiciones que toman 30Gb y 41 minutos en mi computadora. El resultado es:
2222
2222
2222
2222
Por lo tanto, cada movimiento inicial se basa. Entonces el juego es un empate.
El uso extremo de la memoria es causado principalmente por el uso recurrente do$0. El uso de esta versión de 154 bytes que utiliza una función simple necesita 3Gb y 11 minutos:
#!/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
que es más soportable (pero aún demasiado, algo debe estar perdiendo memoria).
La combinación de varias aceleraciones conduce a esta versión de 160 bytes (5028168 posiciones, 4 minutos y 800M para el tablero vacío):
#!/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
El último se usa 0para ganar (no confundir con O), 1para empatar y 2para perder. La salida de este también es más confusa. Completa el movimiento ganador para X en caso de una victoria sin cambio de color, pero si el juego de entrada ya fue ganado, todavía cambia el color y no completa ningún movimiento.
Todas las versiones, por supuesto, se vuelven más rápidas y usan menos memoria a medida que la placa se llena. Las versiones más rápidas deberían generar un movimiento en menos de 10 segundos tan pronto como se hayan realizado 2 o 3 movimientos.
En principio, esta versión de 146 bytes también debería funcionar:
#!/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)
pero en mi máquina activa un error perl y vuelca el núcleo.
En principio, todas las versiones seguirán funcionando si $$_||=se elimina el almacenamiento en caché de la posición de 6 bytes, pero eso consume tanto tiempo y memoria que solo funciona para tableros casi llenos. Pero, en teoría, al menos tengo una solución de 140 bytes.
Si coloca $\=(costo: 3 bytes) justo antes de $@<=>0cada placa de salida, le seguirá el estado de toda la placa: 1para Xvictorias, 0para empates y -1para pérdidas.
Aquí hay un controlador interactivo basado en la versión más rápida mencionada anteriormente. El controlador no tiene lógica para cuando finaliza el juego, por lo que debes detenerte. Sin embargo, el código de golf lo sabe. Si el movimiento sugerido regresa sin ser -reemplazado por nada, el juego ha terminado.
#!/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;
}