Perl, 147 ไบต์ (ไม่ใช่การแข่งขันใช้เวลามากกว่า 10 วินาทีต่อการเคลื่อนไหว)
รวมถึง +4 สำหรับ -0p
Xละครโปรแกรม มันจะเล่นเกมที่สมบูรณ์แบบ
ใส่บอร์ดบน STDIN เช่น:
tictaclatin.pl
-X-O
-X--
X-X-
O--O
^D
ouptut จะเป็นบอร์ดเดียวกันโดยXแทนที่ด้วยOและในทางกลับกัน จุดที่ว่างเปล่าจะเต็มไปด้วยตัวเลขที่ระบุผลลัพธ์ถ้า X เล่นที่นั่นพร้อมกับ1ความหมายผลลัพธ์จะชนะ2การเสมอและ3การสูญเสีย เกมที่เล่นเสร็จแล้วจะกลับมาอยู่ในตำแหน่งเดิมโดยที่สีกลับด้าน
ในตัวอย่างนี้ผลลัพธ์จะเป็น:
1O1X
1O33
O3O3
X33X
ดังนั้นตำแหน่งคือการชนะXถ้าเขาเล่นใน 3 จุดตามด้านบนและด้านซ้าย การเคลื่อนไหวอื่น ๆ ทั้งหมดจะแพ้
ผลลัพธ์ที่สับสนนี้สะดวกจริง ๆ ถ้าคุณต้องการทราบว่าเกมดำเนินต่อไปอย่างไรหลังจากย้าย เนื่องจากโปรแกรมมักจะเล่นXคุณต้องสลับXและจะเห็นการเคลื่อนไหวสำหรับO Oตัวอย่างเช่นที่นี่ค่อนข้างชัดเจนว่าXชนะโดยการเล่นที่มุมบนซ้าย แต่ถ้าXเล่นในตำแหน่งที่สามตามด้านบนล่ะ เพียงแค่คัดลอกเอาท์พุทOแทนที่การเคลื่อนไหวที่คุณเลือกและแทนที่หมายเลขอื่นทั้งหมด-อีกครั้งดังนั้นที่นี่:
-OOX
-O--
O-O-
X--X
ที่เกิดขึ้นใน:
3XXO
3X33
X3X3
O33O
เห็นได้ชัดว่าทุกการเคลื่อนไหวโดยOควรสูญเสียดังนั้นเขาจะสูญเสียถ้าเขาเล่นในมุมบนซ้ายได้อย่างไร ทำสิ่งนี้อีกครั้งโดยใส่Oที่ด้านบนซ้ายและแทนที่ตัวเลขด้วย-:
OXXO
-X--
X-X-
O--O
ให้:
XOOX
1O33
O3O3
X33X
ดังนั้น X มีทางเดียวเท่านั้นที่จะชนะเขาได้:
XOOX
OO--
O-O-
X--X
ให้
OXXO
XX33
X3X3
O33O
สถานการณ์Oยังคงสิ้นหวัง ตอนนี้มันเป็นเรื่องง่ายที่จะเห็นว่าทุกการเคลื่อนไหวอนุญาตให้Xชนะได้ทันที อย่างน้อยก็ลองทำ 3 โอต่อเนื่องกัน:
OXXO
XX--
X-X-
O-OO
ให้:
XOOX
OO13
O3O3
X3XX
Xเล่นการย้ายที่ชนะเท่านั้น (โปรดสังเกตว่าสิ่งนี้ทำXXXOตามคอลัมน์ที่สาม:
XOOX
OOO-
O-O-
X-XX
นี่คือผลลัพธ์:
OXXO
XXX-
X-X-
O-OO
เพราะเกมเสร็จแล้ว คุณสามารถเห็นชัยชนะในคอลัมน์ที่สาม
โปรแกรมจริง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)
นำไปใช้กับบอร์ดว่างนี้ประเมินตำแหน่ง 9506699 ซึ่งใช้เวลา 30Gb และ 41 นาทีบนคอมพิวเตอร์ของฉัน ผลลัพธ์คือ:
2222
2222
2222
2222
ดังนั้นการเริ่มต้นทุกครั้งจึงเกิดขึ้น ดังนั้นเกมคือการจับฉลาก
do$0ใช้หน่วยความจำมากส่วนใหญ่จะเกิดจากการเรียกซ้ำโดยใช้ การใช้ 154 ไบต์รุ่นนี้โดยใช้ฟังก์ชั่นธรรมดาต้องใช้ 3G และ 11 นาที:
#!/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
ซึ่งสามารถรับได้มากขึ้น (แต่ก็ยังมากเกินไป
การรวมจำนวนการเร่งความเร็วจำนวนมากจะนำไปสู่เวอร์ชัน 160 ไบต์ (5028168 ตำแหน่ง, 4 นาทีและ 800M สำหรับบอร์ดว่างเปล่า):
#!/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
อันสุดท้ายใช้0สำหรับการชนะ (อย่าสับสนO) 1สำหรับการเสมอและ2การแพ้ การส่งออกของอันนี้ก็สับสนมากขึ้น มันเติมในการย้ายที่ชนะสำหรับ X ในกรณีที่ชนะโดยไม่มีการสลับสี แต่ถ้าเกมอินพุตได้รับรางวัลแล้วก็ยังคงเป็นการสลับสีและไม่เติมเต็มในการเคลื่อนไหวใด ๆ
ทุกรุ่นได้เร็วขึ้นและใช้หน่วยความจำน้อยลงเมื่อบอร์ดเต็ม เวอร์ชันที่เร็วขึ้นควรสร้างการเคลื่อนไหวภายใน 10 วินาทีทันทีที่มีการเคลื่อนไหว 2 หรือ 3 ครั้ง
โดยหลักการแล้ว 146 byte version ควรใช้งานได้:
#!/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)
แต่ในเครื่องของฉันมันทำให้เกิดข้อผิดพลาดของ Perl และทิ้งแกน
โดยหลักการแล้วเวอร์ชันทั้งหมดจะยังคงทำงานหากการแคชตำแหน่ง 6 ไบต์ที่ทำโดย$$_||=ถูกลบออกไป แต่ใช้เวลาและหน่วยความจำมากจนใช้ได้กับแผงวงจรเกือบเต็ม แต่ในทางทฤษฎีอย่างน้อยฉันก็มีวิธีแก้ปัญหา 140 ไบต์
หากคุณใส่$\=(ราคา: 3 ไบต์) ก่อนหน้า$@<=>0บอร์ดผลลัพธ์แต่ละบอร์ดจะตามด้วยสถานะของบอร์ดทั้งหมด: 1สำหรับXผู้ชนะ, 0เสมอและ-1เสมอ
นี่คือไดร์เวอร์แบบโต้ตอบตามรุ่นที่เร็วที่สุดที่กล่าวถึงข้างต้น คนขับไม่มีเหตุผลเมื่อเกมสิ้นสุดดังนั้นคุณต้องหยุดตัวเอง รหัส golfed รู้ว่า หากการย้ายที่แนะนำส่งกลับโดยไม่มีการ-แทนที่ด้วยสิ่งใดเกมจะจบลง
#!/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;
}