I've created a ConnectFour.pm (based on TicTacToe.pm) so that your AI can learn to play
Connect Four.
I found that the Defensive strategy is not effective for Connect Four; it barely managed to beat Random more times than it lost. So, I created an Offensive.pm, which gives priority to winning states and ignores losses and ties (the opposite of Defensive.pm). That strategy is doing much better; after about 15,000 games it beat Random more than twice as often as it lost to Random, although 2/3 of the games were ties. I figure it's still got a lot of learning to do.
I then created an OffenseDefense.pm, which combines the behaviors of Offensive and Defensive; wins get rated up, losses get rated down. This strategy so far has produced essentially identical results to Offensive.pm; it remains to be seen whether rating losses in addition to wins will give any advantage.
I also include below mainc4.pl, which is really just main.pl using the new modules. However, I renamed the memory file, because 'player-1-memory.txt' really is not descriptive. :)
### ConnectFour.pm
package ConnectFour;
use integer;
use strict;
# A class that implements a game of Connect Four
#
# A board has 7 columns and 6 rows. When indexed by X and Y position,
# X is the primary index. When indexed by a single number, position N
# corresponds to X = N%width, Y = N/width.
# Each Connect Four state is represented as a 42-character string
# where each character in the string corresponds to position N on the
# board. The character is a "0" if that square is empty, "1" if that
# square has a mark by the current player, and "2" if that square has
# a mark by the current player's opponent.
# Constructor.
sub new {
my $class = shift;
my $width = 7;
my $height = 6;
my $self = {
width => $width,
height => $height,
board => [ map [(0) x $height], 1 .. $width],
top => [ (0) x $width ],
moves_made => 0,
player => int(rand(2) + 1),
};
bless $self, $class;
return $self;
}
# Plays an entire game of Connect Four. Takes in references to two
# "player" objects; it alternates between these objects, asking each
# for a move, until the game is over. At the end of the game, it
# notifies each player of the result of the game, and returns the
# result. 0 is a tie, 1 and 2 are wins by player 1 and player 2,
# respectively.
sub play {
my ($self, $p1, $p2) = @_;
my $result = undef;
until (defined $result) {
if (current_player($self) == 1) {
$result = $self->request_move($p1);
} else {
$result = $self->request_move($p2);
}
$self->switch_player();
}
if ($result == 1) {
$p1->win();
$p2->lose();
} elsif ($result == 2) {
$p2->win();
$p1->lose();
} else {
$p1->tie();
$p2->tie();
}
return $result;
}
# Takes in a reference to a player object, and requests (through the
# player's make_make() method) that the player make a move.
#
# BUG: We send the player a list of the valid moves (actually, a list
# of the valid states that the player can currently put the board
# into), but never check to see whether the player actually made a
# valid move. It's assumed that we have honest (and
# correctly-programmed) players, which is probably a bad assumption to
# make.
sub request_move {
my ($self, $ai) = @_;
my $move = $ai->make_move($self->valid_states());
$self->{board}[$move][$self->{top}[$move]] = $self->current_player()
+;
$self->{"moves_made"}++;
return $self->check_for_win($move, $self->{top}[$move]++);
}
# Checks to see if the game has been won.
# Returns 1 or 2 if player 1 or 2 has won, undef otherwise.
#
# This sub is horribly non-optimized, but it works.
sub check_for_win {
my $self = shift;
my($move_x, $move_y) = @_;
return undef if ($self->{moves_made} < 7);
my $player = $self->current_player();
my $win = 0;
X:
for my $x (-1, 0, 1) {
Y:
for my $y (-1, 0, 1) {
next if $x == 0 and $y == 0;
my($pos_x, $pos_y) = ($move_x, $move_y);
for my $d (1..3) {
$pos_x += $d * $x;
$pos_y += $d * $y;
next Y if $pos_x < 0 or $pos_x >= $self->{width};
next Y if $pos_y < 0 or $pos_y >= $self->{height};
next Y if $self->{board}[$pos_x][$pos_y] != $player;
}
$win = $player;
last X;
}
}
if ($win) {
return $player;
} elsif ($self->{"moves_made"} == $self->{width} * $self->{height})
+{
return 0;
} else {
return undef;
}
}
# Returns a list of the currently-valid moves.
sub valid_moves {
my $self = shift;
my @valid_moves =
grep $self->{top}[$_] < $self->{height},
0 .. $self->{width} - 1;
return @valid_moves;
}
# Returns the current player (1 or 2).
sub current_player {
my $self = shift;
return $self->{player};
}
# Switches the current player.
sub switch_player {
my $self = shift;
if ($self->{player} == 1) {
$self->{player} = 2;
} else {
$self->{player} = 1;
}
}
# Returns a string representation of the current state of the board.
# The Nth character in the string corresponds to square X = N%width,
# Y = N/width.
# The current player is always denoted as "1", its opponent "2",
# and an empty space "0".
sub current_state {
my $self = shift;
my $current_state = join("", map @$_, @{ $self->{board} });
# If the current player is 2, swap the 1's and 2's in the board stat
+e.
if (current_player($self) == 2) {
$current_state =~ tr/12/21/;
}
return $current_state;
}
# Returns a reference to a hash of the states that the current player
# can legally put the board into. The keys of the hash are the states
# themselves; the values are the moves required to put the board into
# each state.
sub valid_states {
my $self = shift;
my $current_state = current_state($self);
my %valid_states;
my @valid_moves = $self->valid_moves();
foreach my $move_x (@valid_moves) {
my $valid_state = $current_state;
my $move_y = $self->{top}[$move_x];
substr($valid_state, ($move_y * $self->{width} + $move_x), 1) = 1;
$valid_states{$valid_state} = $move_x;
}
return \%valid_states;
}
1;
### Offensive.pm
package Offensive;
# A class implementing an "offensive" AI game player. The offensive
# player considers all states that have led to wins as "good" and
# makes no preference between a loss and a tie.
#
# Adapting this player to a different game should be incredibly easy;
# the game just has to send in a list of valid states and call the
# appropriate win(), lose(), or tie() method at the end of the game.
use Memory;
@Offensive::ISA = ("Memory");
# Constructor
sub new {
my $class = shift;
my $self = Memory::new($class);
return $self;
}
# Do nothing if the result of a game was a loss or a tie, except clear
# the "states" entry.
sub lose { delete $_[0]->{"states"}; }
sub tie { delete $_[0]->{"states"}; }
# If we win, increase the priorities of all states that we put the
# game into. States which occurred toward the end of the game are
# weighted as "more good" than states which occurred at the
# beginning.
sub win {
my $self = shift;
my @states = @{$self->{"states"}};
my $score = 32;
while (@states) {
my $state = pop(@states);
$self->modify($state, $score);
$score /= 2;
}
delete $self->{"states"};
}
# Uses Memory.pm's get_best_state() method to find and return the best
# move out of those provided in the @$valid_states array.
#
# Keeps track of the moves it's made during this game, such that it
# can modify their values accordingly at the end of the game.
sub make_move {
my ($self, $valid_states) = @_;
my @valid_states = (keys %$valid_states);
my $best_state = $self->get_best_state(\@valid_states);
push @{$self->{"states"}}, $best_state;
return $valid_states->{$best_state};
}
1;
### OffenseDefense.pm
package OffenseDefense;
# A class implementing an "offensive/defensive" AI game player. The
# offensive/defensive player considers all states that have led to
# wins as "good", all states that have led to losses as "bad", and all
# states that have led to ties as "neutral".
#
# Adapting this player to a different game should be incredibly easy;
# the game just has to send in a list of valid states and call the
# appropriate win(), lose(), or tie() method at the end of the game.
use Memory;
@OffenseDefense::ISA = ("Memory");
# Constructor
sub new {
my $class = shift;
my $self = Memory::new($class);
return $self;
}
# Do nothing if the result of a game was a tie, except clear the
# "states" entry.
sub tie { delete $_[0]->{"states"}; }
# If we win or lose, adjust the priorities of all states that we put
# the game into; up for a win, down for a loss.
sub win { $_[0]->adjust(+32) }
sub lose { $_[0]->adjust(-32) }
# Adjust all the states that we put the game into, based on the
# specified priority. States which occurred toward the end of the
# game are weighted as "more good/bad" than states which occurred at
# the beginning.
sub adjust {
my $self = shift;
my $score = shift;
my @states = @{$self->{"states"}};
while (@states) {
my $state = pop(@states);
$self->modify($state, $score);
$score /= 2;
}
delete $self->{"states"};
}
# Uses Memory.pm's get_best_state() method to find and return the best
# move out of those provided in the @$valid_states array.
#
# Keeps track of the moves it's made during this game, such that it
# can modify their values accordingly at the end of the game.
sub make_move {
my ($self, $valid_states) = @_;
my @valid_states = (keys %$valid_states);
my $best_state = $self->get_best_state(\@valid_states);
push @{$self->{"states"}}, $best_state;
return $valid_states->{$best_state};
}
1;
### mainc4.pl
#!/usr/bin/perl
# Driver program for Connect Four games. Plays a (basically) infinite
# number of games, dying gracefully when interrupted. Prints out the
# results so far, at every 100 games. Also handles loading and saving
# of player memories.
use strict;
use integer;
use ConnectFour;
use Offensive;
use Random;
$SIG{INT} = \&sig_handler;
$| = 1;
my $mem = 'c4-off.mem';
my @record = (0, 0, 0);
my $p1 = Offensive->new();
my $p2 = Random->new();
$p1->load($mem);
my $dead = 0;
my $num_games = 0;
until ($dead) {
$num_games++;
my $ttt = ConnectFour->new();
my $result = $ttt->play($p1, $p2);
$record[$result]++;
if ($num_games % 100 == 0) {
print "\n($num_games) $record[1]/$record[2]/$record[0]\n";
}
}
$p1->save($mem);
print "Player 1 memory saved OK.\n";
sub sig_handler {
print "\nCaught INT signal... shutting down.\n";
$dead = 1;
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.