Perl, 147 byte (tidak bersaing, membutuhkan lebih dari 10 detik per gerakan)
Termasuk +4 untuk -0p
Program diputar X
. Ini akan memainkan game yang sempurna.
Masukkan papan pada STDIN, misalnya:
tictaclatin.pl
-X-O
-X--
X-X-
O--O
^D
Ouptut akan menjadi papan yang sama dengan semua X
digantikan oleh O
dan sebaliknya. Bintik-bintik kosong akan diisi dengan angka yang mengindikasikan hasil jika X akan bermain di sana, yang 1
artinya hasilnya adalah menang, 2
seri, dan 3
kalah. Game yang telah selesai hanya mengembalikan posisi yang sama dengan warna yang dibalik.
Dalam contoh ini, hasilnya adalah:
1O1X
1O33
O3O3
X33X
Jadi posisinya adalah kemenangan karena X
dia bermain di 3 tempat di bagian atas dan kiri. Semua gerakan lainnya kalah.
Output membingungkan ini sebenarnya nyaman jika Anda ingin tahu bagaimana permainan berlanjut setelah pindah. Karena program selalu dimainkan, X
Anda harus menukar X
dan O
melihat pergerakannya O
. Di sini misalnya cukup jelas bahwa X
menang dengan bermain di kiri atas, tetapi bagaimana jika X
bermain di posisi ketiga sepanjang atas? Cukup salin output, letakkan O
di tempat langkah yang Anda pilih dan ganti semua angka lainnya -
lagi, jadi di sini:
-OOX
-O--
O-O-
X--X
Yang menghasilkan:
3XXO
3X33
X3X3
O33O
Tentunya setiap gerakan O
harus kalah, jadi bagaimana dia bisa kalah jika dia bermain di kiri atas? Sekali lagi lakukan ini dengan meletakkan O
di kiri atas dan mengganti digit dengan -
:
OXXO
-X--
X-X-
O--O
Memberi:
XOOX
1O33
O3O3
X33X
Jadi X hanya memiliki satu cara untuk meraih kemenangannya:
XOOX
OO--
O-O-
X--X
Memberi
OXXO
XX33
X3X3
O33O
Situasi untuk O
tetap tanpa harapan. Sangat mudah untuk melihat sekarang bahwa setiap gerakan memungkinkan X
untuk segera menang. Mari kita setidaknya mencoba untuk mendapatkan 3 O berturut-turut:
OXXO
XX--
X-X-
O-OO
Memberi:
XOOX
OO13
O3O3
X3XX
X
memainkan satu-satunya langkah yang menang (perhatikan bahwa ini dilakukan di XXXO
sepanjang kolom ketiga:
XOOX
OOO-
O-O-
X-XX
Di sini hasilnya adalah:
OXXO
XXX-
X-X-
O-OO
karena permainannya sudah selesai. Anda dapat melihat kemenangan di kolom ketiga.
Program aktual 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)
Diterapkan ke papan kosong ini mengevaluasi posisi 9506699 yang memakan waktu 30Gb dan 41 menit di komputer saya. Hasilnya adalah:
2222
2222
2222
2222
Jadi setiap langkah awal menarik. Jadi game ini seri.
Penggunaan memori ekstrim sebagian besar disebabkan oleh penggunaan rekursi do$0
. Menggunakan versi 154 byte ini menggunakan fungsi sederhana membutuhkan 3Gb dan 11 menit:
#!/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
yang lebih tertahankan (tapi masih terlalu banyak, sesuatu pasti masih bocor memori).
Menggabungkan sejumlah speedup mengarah ke versi 160 byte ini (posisi 5028168, 4 menit dan 800M untuk papan kosong):
#!/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
Yang terakhir digunakan 0
untuk menang (jangan bingung dengan O
), 1
untuk seri dan 2
untuk kekalahan. Hasil yang satu ini juga lebih membingungkan. Ia mengisi langkah kemenangan untuk X jika menang tanpa swap warna, tetapi jika game input sudah dimenangkan masih melakukan swap warna dan tidak mengisi langkah apa pun.
Semua versi tentu saja menjadi lebih cepat dan menggunakan lebih sedikit memori saat papan terisi. Versi yang lebih cepat akan menghasilkan gerakan dalam waktu kurang dari 10 detik segera setelah 2 atau 3 gerakan dilakukan.
Pada prinsipnya, versi 146 byte ini juga harus berfungsi:
#!/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)
tetapi pada mesin saya itu memicu bug perl dan dump inti.
Semua versi pada prinsipnya akan tetap berfungsi jika caching posisi 6 byte yang dilakukan $$_||=
dihapus tetapi menggunakan begitu banyak waktu dan memori sehingga hanya berfungsi untuk papan yang hampir penuh. Namun secara teori setidaknya saya punya solusi 140 byte.
Jika Anda menempatkan $\=
(biaya: 3 byte) tepat sebelum $@<=>0
papan output maka masing-masing akan diikuti oleh status seluruh papan: 1
untuk X
menang, 0
untuk menarik dan -1
untuk kerugian.
Ini adalah driver interaktif berdasarkan versi tercepat yang disebutkan di atas. Pengemudi tidak memiliki logika untuk kapan permainan selesai sehingga Anda harus menghentikan diri sendiri. Kode golf tahu. Jika langkah yang disarankan kembali tanpa -
diganti oleh apa pun, permainan telah berakhir.
#!/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;
}