Perl, 147 octets (non concurrent, prend plus de 10 secondes par coup)
Comprend +4 pour -0p
Le programme joue X. Il jouera un jeu parfait.
Entrez la carte sur STDIN, par exemple:
tictaclatin.pl
-X-O
-X--
X-X-
O--O
^D
La ouptut sera la même carte avec tous Xremplacés par Oet vice versa. Les emplacements vides seront remplis d'un nombre indiquant le résultat si X y jouerait, ce qui 1signifie que le résultat sera une victoire, 2un match nul et 3une défaite. Un jeu terminé renvoie simplement la même position avec les couleurs inversées.
Dans cet exemple, la sortie serait:
1O1X
1O33
O3O3
X33X
La position est donc une victoire Xs'il joue aux 3 places en haut et à gauche. Tous les autres coups perdent.
Cette sortie déroutante est en fait pratique si vous voulez savoir comment le jeu continue après un coup. Puisque le programme est toujours joué, Xvous devez échanger Xet Ovoir les mouvements O. Ici, par exemple, il est assez clair que l'on Xgagne en jouant en haut à gauche, mais qu'en est-il s'il Xjoue en troisième position en haut? Copiez simplement la sortie, mettez un Oà la place du mouvement que vous sélectionnez et remplacez tous les autres numéros par -, alors voici:
-OOX
-O--
O-O-
X--X
Résultant en:
3XXO
3X33
X3X3
O33O
Évidemment, chaque coup Odoit perdre, alors comment perd-il s'il joue en haut à gauche? Faites de nouveau ceci en mettant Oen haut à gauche et en remplaçant les chiffres par -:
OXXO
-X--
X-X-
O--O
Donnant:
XOOX
1O33
O3O3
X33X
X n'a donc qu'une seule voie à suivre pour sa victoire:
XOOX
OO--
O-O-
X--X
Donnant
OXXO
XX33
X3X3
O33O
La situation Oreste désespérée. Il est facile de voir maintenant que chaque mouvement permet Xde gagner immédiatement. Essayons au moins d'aller chercher 3 O d'affilée:
OXXO
XX--
X-X-
O-OO
Donnant:
XOOX
OO13
O3O3
X3XX
Xjoue le seul coup gagnant (notez que cela fait le XXXOlong de la troisième colonne:
XOOX
OOO-
O-O-
X-XX
Ici, la sortie est:
OXXO
XXX-
X-X-
O-OO
parce que le jeu était déjà terminé. Vous pouvez voir la victoire sur la troisième colonne.
Le programme actuel 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)
Appliqué au tableau vide, il évalue 9506699 positions, ce qui prend 30 Go et 41 minutes sur mon ordinateur. Le résultat est:
2222
2222
2222
2222
Donc, chaque coup de départ est nul. Le jeu est donc un match nul.
L'utilisation extrême de la mémoire est principalement causée par la récursivité utilisant do$0. L'utilisation de cette version de 154 octets à l'aide d'une fonction simple nécessite 3 Go et 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
ce qui est plus supportable (mais toujours trop, quelque chose doit encore fuir la mémoire).
La combinaison d'un certain nombre d'accélérations conduit à cette version de 160 octets (5028168 positions, 4 minutes et 800M pour le plateau vide):
#!/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
Ce dernier utilise 0pour une victoire (ne pas confondre avec O), 1pour un match nul et 2pour une défaite. La sortie de celui-ci est également plus déroutante. Il remplit le coup gagnant pour X en cas de victoire sans changement de couleur, mais si le jeu d'entrée a déjà été gagné, le changement de couleur continue et ne remplit aucun coup.
Toutes les versions deviennent bien sûr plus rapides et utilisent moins de mémoire lorsque la carte se remplit. Les versions plus rapides devraient générer un coup en moins de 10 secondes dès que 2 ou 3 coups ont été effectués.
En principe, cette version de 146 octets devrait également fonctionner:
#!/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)
mais sur ma machine, il déclenche un bogue perl et vide le noyau.
Toutes les versions fonctionneront en principe toujours si la mise en cache de position de 6 octets effectuée par $$_||=est supprimée mais qui utilise tellement de temps et de mémoire qu'elle ne fonctionne que pour les cartes presque remplies. Mais en théorie au moins, j'ai une solution de 140 octets.
Si vous mettez $\=(coût: 3 octets) juste avant, $@<=>0chaque carte de sortie sera suivie par le statut de la carte entière: 1pour les Xvictoires, 0pour le match nul et -1pour la perte.
Voici un pilote interactif basé sur la version la plus rapide mentionnée ci-dessus. Le conducteur n'a aucune logique pour la fin du jeu, vous devez donc vous arrêter. Le code golfé le sait cependant. Si le coup suggéré revient sans être -remplacé par quoi que ce soit, la partie est terminée.
#!/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;
}