Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
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; }

In reply to Re: A simple game AI that learns (Connect Four) by chipmunk
in thread A simple game AI that learns by Falkkin

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • 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.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others romping around the Monastery: (7)
As of 2024-03-28 12:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found