Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
-------------------- README file begins: -------------------- The main program is go-arena.pl, and a sample client is in go-client.p +l. The interface is explain somewhat in the go-proto.txt, but I recommend + you just telnet'ing into the server, as that works well. I'll setup the s +erver over here for you all to play if you do not have perl available to you +. The idea behind all this is to have AI play each other to see who can +write a better AI. Or to put it better, to allow programmers a good arena t +o test their ideas on how well an AI can perform, in order to make programmer +s better at AI programming :) (which is a good thing). Anyway enjoy, send clients to me if you would like me to run tournamen +ts (until we have the server better setup to do so itself) my email addre +ss is gryn.garkin@mail.auburn.edu -Gryn -------------------- go-arena.pl file begins: -------------------- #!/usr/bin/perl -w use strict; use IO::Socket; use Getopt::Long; my $ver = "0.1.1a"; sub printhelp { print "This is the go-arena.pl program, it will accept connections t +o play\n"; print "a game of GO from clients which follow a simple text-line pro +tocol\n"; print "described in go-proto.txt\n"; print "Tt will only play one game, defaults to size 19, and spits th +e scoring\n"; print "information back to the terminal. (you can change the size b +y\n"; print "passing it as a parameter, and clients are also told if they\ +n"; print "won or not)\n"; print " --help,-h Help\n"; print " --size,-s Board size\n"; print " --port,-p Port to listen on (only if no --socket o +ption)\n"; print " --socket,-s Local domain socket (only local connec +tion)\n"; print " --komi,-k Set komi amount (2nd turn compensation\n +"; print " --debug Print debug info\n"; print " --verbose,-v Print more stuff\n"; exit; } my ( $help, $socket,$debug); my ( $size, $port, $komi, $verbose) = ( 19, 7179, 4.5, 0); GetOptions( "help|?" => \$help, "size|s=i" => \$size, "port|p=i" => \$port, "socket|d=s" => \$socket, "komi|k=f" => \$komi, "debug" => \$debug, "verbose|v+" => \$verbose ); if ($help or @ARGV) { printhelp; } srand; my $up = [ 0, -1 ]; my $down = [ 0, 1 ]; my $left = [ -1, 0 ]; my $right = [ 1, 0 ]; # global settings: # needs to be at least 3 my $histsize = 3; ###################################################################### # BOARD Type (functions etc) # (MOVE/POS type too) # $board is a ref to a hash, each hash value hold some aspect of a boa +rd state. # b = a 2d array that shows the positions of the stones with the follo +wing mapping: # 0 - nothing # 99 - nothing (but already counted, when doing final scoring)* # 1 - white stone # 2 - white stone* # -1 - black stone # -2 - black stone* # -99 - not on board # (note that * values are only present during intermediate board pr +ocessing) # m = number of valid moves made total # t = number of turns taken # f = free spaces left on the board # black = black's score # white = white's score # lm = the last move made (which created the current state) # lb = the previous board (if you apply the last move you would arrive # at the current state) # NOTE: the 'lb' hash element forms a linked list! A history of +the # game! Therefore, $histsize limits the maximum size of th +is # buffer, setting it to -1 will allow infinite boards -- ho +wever # for KO detection to work, we always store the last 2 boar +ds. # (after finding a valid move, check that board against two + boards # ago (i.e. $board->{'lb'}->{'lb'} ) ) # NOTE NOTE: Perl doesn't seem to throw away the memory, oh well. # A move or position type is simply a reference to a two element array # specifying the x and y location. A [-1,-1] indicates a pass, and [ +-2, -2] # means the client quit or disconnected. # Reset and clear a board sub newB { my $board; $board->{'m'} = 0; $board->{'t'} = 0; $board->{'f'} = $size * $size; $board->{'lm'} = undef; $board->{'lb'} = undef; $board->{'black'} = 0; $board->{'white'} = 0; @{$board->{'b'}} = (); for (my $y=0;$y<$size;$y++) { for (my $x=0;$x<$size;$x++) { set_board_val($board,[$y,$x],0); } } return $board; } sub board_copy { my $b1 = shift; my $recurse = shift || 0; my $b2; if (not $b1) { # undef, null return undef; } $b2->{'m'} = $b1->{'m'}; $b2->{'t'} = $b1->{'t'}; $b2->{'f'} = $b1->{'f'}; $b2->{'m'} = $b1->{'m'}; $b2->{'black'} = $b1->{'black'}; $b2->{'white'} = $b1->{'white'}; # these two should be the same. $b2->{'b'} = [ map { [ @{$_} ] } @{$b1->{'b'}} ]; # for (my $y = 0; $y < $size; $y++) { # $b2->{'b'}[$y] = [ @{$b1->{'b'}[$y]} ]; # } $b2->{'lm'} = $b2->{'lm'}; if ($recurse < $histsize) { $b2->{'lb'} = board_copy($b1->{'lb'},$recurse+1); } else { $b2->{'lb'} = undef; } return $b2; } # Returns true if two positions's are the same sub pos_equal { my ($p1, $p2) = @_; if ($p1->[0] == $p2->[0] and $p1->[1] == $p2->[1]) { return 1; } else { return 0; } } # Is move a pass? (i.e. (-1, -1) ) sub is_pass { my $move = shift; if (pos_equal($move, [ -1, -1 ])) { return 1; } else { return 0; } } # Add two positions together (e.g. add_dir($this,$up) ) sub add_dir { my ($pos, $dir) = @_; my $newpos = [ $pos->[0] + $dir->[0], $pos->[1] + $dir->[1] ]; return $newpos; } # Returns true if the position is within the board sub in_board { my $pos = shift; if ($pos->[0] >= 0 and $pos->[1] >= 0 and $pos->[0] < $size and $pos->[1] < $size) { return 1; } else { return 0; } } # Returns the value of the board at a position # (uses the key at the top of this section) sub board_val { my ($board, $pos) = @_; if (in_board($pos) == 1) { return $board->{'b'}[$pos->[1]][$pos->[0]]; } else { return -99; } } # Sets the board's value at a position sub set_board_val { my ($board, $pos, $val) = @_; if (in_board($pos) == 1) { $board->{'b'}[$pos->[1]][$pos->[0]] = $val; } } # pretty prints a board sub printB { my $board = shift; print "/-","--" x $size,"\\\n"; for (my $y=0;$y<$size;$y++) { print "| "; for (my $x=0;$x<$size;$x++) { print ". " if board_val($board,[$x,$y]) == 0; print "# " if board_val($board,[$x,$y]) == 99; print "% " if board_val($board,[$x,$y]) == 98; print "O " if board_val($board,[$x,$y]) == 1; print "X " if board_val($board,[$x,$y]) == -1; print "O)" if board_val($board,[$x,$y]) == 2; print "X<" if board_val($board,[$x,$y]) == -2; print "* " if board_val($board,[$x,$y]) ==-99; } print "|\n"; } print "\\-","--" x $size,"/\n"; } # prints a board (faster/smaller) sub printBsimp { my $board = shift; for (my $y=0;$y<$size;$y++) { print map {if ($_ == 0) {"."} elsif ($_ ==-1) {"X"} elsif ($_ == 1) {"O"} else {"?"}} @{$board->{'b'}[$y]}; print "\n"; } print ".\n"; } # pretty prints a position sub printP { my $pos = shift; print $pos->[0]," x ",$pos->[1],"\n"; } # checks to see if stone positions are the same sub board_equal { my ($b1, $b2) = @_; if (@{$b1->{'b'}} == @{$b2->{'b'}}) { return 1; } else { return 0; } } # End of BOARD, MOVE/POS section ###################################################################### # This processes a move on $board, returning if the move was valid, # and also the new board state. sub do_move { my ($orig_board, $move, $who) = @_; my $captured = 0; $orig_board->{'t'} += 1; my $board = board_copy($orig_board); $board->{'lb'} = $orig_board; $board->{'lm'} = $move; # we need to dec $orig_board->{'t'} if we find a valid move # A pass is always a valid move. also let quit messages be valid too if (is_pass($move) == 1 or pos_equal($move,[-2,-2]) == 1) { return (1,$board); } # The position must be free... if (board_val($board,$move) == 0) { # Now, process captures # (place stone, then see if up,down,left,right stones are captured +) set_board_val($board,$move,$who); for my $dir ($up,$down,$left,$right) { # if direction is an opponent's peice.. if (board_val($board,add_dir($move,$dir)) == $who*-1) { # if there is no life here, kill it, else refill it to orig va +lue. if (fill_life($board,add_dir($move,$dir),$who*-1,$who*-2) == 0 +) { $captured+=fill_count($board,add_dir($move,$dir),$who*-2,0); } else { fill_life($board,add_dir($move,$dir),$who*-2,$who*-1); } } } # if, after captures, the piece itself has no life, then it is sti +ll # an invalid move. if (fill_life($board,$move,$who,$who*2) == 0) { return (0,$orig_board); } else { fill_life($board,$move,$who*2,$who); } # KO checking, if last board state for this player is the same # as this board state, then KO prevents this move. # (also check to see if moves were the same, since this must # happen before KO -could- happen). if ($board->{'lb'} and $board->{'lb'}->{'lb'} and $board->{'lb'}-> +{'lb'}->{'lm'}) { print "KO detection enabled\n" if $debug; if (pos_equal($move,$board->{'lb'}->{'lb'}->{'lm'})) { print "Possible KO checking board states\n" if $debug; if (board_equal($board,$board->{'lb'}->{'lb'})) { print "KO!\n" if $debug; return (0,$orig_board); } } } $orig_board->{'t'} -= 1; $board->{'f'} -= 1; $board->{'f'} += $captured; $board->{'m'} += 1; $board->{'black'} += $captured if $who == -1; $board->{'white'} += $captured if $who == 1; return (1,$board); } else { return (0,$orig_board); } } sub tally_final_score { my $orig_board = shift; my ($black, $white) = (0,0); my (@s,@n,@b,@w) = ((),(),(),()); my $board = board_copy($orig_board); for (my $y = 0;$y < $size; $y++) { for (my $x = 0;$x < $size; $x++) { if (board_val($board,[$x,$y])==0) { my $owner = fill_owner($board, [$x,$y], 0, 99); push @s, [$x,$y] if $owner == 0; push @n, [$x,$y] if $owner == 99; push @b, [$x,$y] if $owner == -1; push @w, [$x,$y] if $owner == 1; } } } map { fill_count($board,$_,99,0) } @s; map { fill_count($board,$_,99,0) } @n; map { $black += fill_count($board,$_,99,0) } @b; map { $white += fill_count($board,$_,99,0) } @w; $board->{'black'} += $black; $board->{'white'} += $white; return $board; } # Returns 1 if position filled had life or not sub fill_life { my ($board, $pos, $from, $to) = @_; if (in_board($pos)) { if (board_val($board, $pos) == $from) { set_board_val($board, $pos, $to); # we put results of fill in temp array, so that the ||'s short # circuit logic does not stop the fill operation. probably could + use map my @f = ( fill_life($board, add_dir($pos, $up), $from, $to), fill_life($board, add_dir($pos, $down), $from, $to), fill_life($board, add_dir($pos, $left), $from, $to), fill_life($board, add_dir($pos, $right), $from, $to) ); return $f[0] || $f[1] || $f[2] || $f[3]; } else { if (board_val($board, $pos) == 0) { return 1; } else { return 0; } } } else { return 0; } } # Returns number of spaces filled sub fill_count { my ($board, $pos, $from, $to) = @_; if (in_board($pos)) { if (board_val($board, $pos) == $from) { set_board_val($board, $pos, $to); return 1 + fill_count($board, add_dir($pos, $up), $from, $to) + fill_count($board, add_dir($pos, $down), $from, $to) + fill_count($board, add_dir($pos, $left), $from, $to) + fill_count($board, add_dir($pos, $right), $from, $to); } else { return 0; } } else { return 0; } } # this function returns who owns an open space # Value | On Board | Passed as | Returned Owner # -1 | Black | | Black # 1 | White | | White # 0 | Blank | $from | SEKI # 99 | Blank (Tmp) | $to | None #-99 | Off Board | | -- sub fill_owner { my ($board, $pos, $from, $to) = @_; my $oval = board_val($board,$pos); if ($oval == -99) { return $to; } elsif ($oval == -1 or $oval == 1) { return $oval; } elsif ($oval == 99) { return 99; } else {# if ($oval == 0) { set_board_val($board,$pos,$to); my $owner = $to; my @neighbors = ( fill_owner($board, add_dir($pos, $up), $from, $to), fill_owner($board, add_dir($pos, $down), $from, $to), fill_owner($board, add_dir($pos, $left), $from, $to), fill_owner($board, add_dir($pos,$right), $from, $to)); for my $n (@neighbors) { if ($n == $from) { #SEKI (old) return $from; } elsif ($n == $to) { #NONE # Nothing to do } else { #Black or White if ($owner != $n and $owner != $to) { #SEKI (Initial detection +) # print "At: ";printP($pos); # print " Owner: $owner Neighbor: $n T/F: $to / $from\n"; return $from } else { # first or the same owner (black or white) $owner = $n; } } } return $owner; } } sub handshake { my ($client,$color) = @_; print $client "Welcome to the GO arena $ver\n"; print $client "The board is size $size\n"; while ($color == 0) { print $client "Please choose which color you would like to play as +:\n"; my $color_str = <$client>; return ("",0) if not defined $color_str; chomp $color_str; $color_str = lc $color_str; $color = -1 if $color_str =~ /black/; $color = 1 if $color_str =~ /white/; if ($color == 0) { print $client "Invalid color selection, please choose white or b +lack\n"; } } print $client "You are black\n" if $color == -1; print $client "You are white\n" if $color == 1; print $client "Please type OK to accept:\n"; my $line = <$client>; if (defined $line and $line =~ /^OK\b/) { print $client "Please enter a short identifier for yourself:\n"; my $id = <$client>; chomp $id; return ($id,$color); } else { return ("",0); } } sub get_move { my $client = shift; print $client "MOVE:\n"; my $line = <$client>; return [ -2, -2 ] if not defined($line); return [ -2, -2 ] if $line =~ /QUIT/; return [ -1, -1 ] if $line =~ /PASS/; $line =~ /(\d*) x (\d*)/; return [ $1, $2 ] if defined($1) and defined($2); return [ -1, -1 ]; } sub send_result { my ($client,$valid) = @_; select ($client); print "Valid move\n" if $valid; print "Invalid move\n" if not $valid; select STDOUT; } sub send_board { my ($client,$board) = @_; select ($client); print "Current board\n"; printBsimp($board); select STDOUT; } $|=1; my $sock; if (defined $socket) { print "Using domain $socket\n"; # yep, I know, very not secure. unlink $socket if defined $socket and -e $socket and $socket =~/\.so +ck$/; $sock = IO::Socket::UNIX->new(Type => SOCK_STREAM, Local => $socket, Listen => 5) or die "Can't create socket!"; } else { print "Using port $port\n"; $sock = IO::Socket::INET->new(LocalPort => $port, Listen => 5, Proto => 'tcp', Reuse => 1) or die "Can't create socket!"; } my $p; my $color = 0; for my $cnt (0..1) { $p->[$cnt]{'id'} = ""; while ($p->[$cnt]{'id'} eq "") { print "Waiting for First player..."; $p->[$cnt]{'sock'} = $sock->accept; print "Connected...Handshaking..."; ($p->[$cnt]{'id'},$p->[$cnt]{'color'}) = handshake($p->[$cnt]{'soc +k'},$color); print "Failed Handshake\n" if $p->[$cnt]{'id'} eq ""; } print "Got it!\n"; print "Player ",$cnt+1," ("; print "black" if $p->[$cnt]{'color'} == -1; print "white" if $p->[$cnt]{'color'} == 1; print ") connected as: ",$p->[$cnt]{'id'},"\n"; $color = $p->[$cnt]{'color'} * -1; } $|=0; # close off everything. undef $sock; unlink $socket if defined $socket and -e $socket and $socket =~/\.sock +$/; my $board = newB; print "Game started at $size x $size.\n"; $board->{'white'} += $komi; my $valid = 0; my $who = -1; my $lastmove = [ -2, -2 ]; my $move = [ -2, -2 ]; # -99 draw # 0 none # 1 White # -1 Black my $winner = 0; # -99 player quit # 0 none # 1 normal my $wintype = 0; my @socks; if ($p->[0]{'color'} == -1) { $socks[0] = $p->[0]{'sock'}; $socks[2] = $p->[1]{'sock'}; } else { $socks[0] = $p->[1]{'sock'}; $socks[2] = $p->[0]{'sock'}; } $|=1; my $test = $p->[0]{'sock'}; print $test "Starting game\n"; $test = $p->[1]{'sock'}; print $test "Starting game\n"; send_board($socks[$who+1],$board); while ($board->{'f'} > 0 and $winner == 0 and not (is_pass($lastmove) +and is_pass($move))) { if ($valid == 1) { $who *= -1; $lastmove = $move; send_board($socks[$who+1],$board); } $move = get_move($socks[$who+1]); if (pos_equal($move, [-2,-2])) { print "\nWhite player quit! -- Black wins!\n" if $who == 1; print "\nBlack player quit! -- White wins!\n" if $who ==-1; $winner = $who * -1; $wintype = -99; }; (print "$who : ",printP($move)) if $verbose == 2; ($valid,$board) = do_move($board,$move,$who); send_result($socks[$who+1],$valid); print "." if $valid and $verbose == 1; print "#" if not $valid and $verbose == 1; } $|=0; print "\n"; $board = tally_final_score($board); print "Score Black: ",$board->{'black'},"\n"; print "Score White: ",$board->{'white'},"\n"; print "Final board:\n"; printB($board) if $verbose; # if there wasn't already a winner determined (e.g. someone quit the g +ame) if ($winner == 0) { $winner = -99, $wintype = 1 if $board->{'black'} == $board->{'white' +}; $winner = -1, $wintype = 1 if $board->{'black'} > $board->{'white' +}; $winner = 1, $wintype = 1 if $board->{'black'} < $board->{'white' +}; } select $p->[0]{'sock'}; print "Draw, no winner\n" if $winner == -99; print "Black wins!\n" if $winner == -1; print "White wins!\n" if $winner == 1; select $p->[1]{'sock'}; print "Draw, no winner\n" if $winner == -99; print "Black wins!\n" if $winner == -1; print "White wins!\n" if $winner == 1; -------------------- go-client.pl file begins: -------------------- #!/usr/bin/perl -w use strict; use IO::Socket; my $address = shift; if (not $address) { print "This program connects to a GO server and plays, but only\n"; print "sends random moves in.\n"; print "Just needs one parameter, either a location or domain socket +name\n"; print "Example: ./go-client.pl localhost:7179 or ./go-client.pl go +-server.sock\n"; exit; } # multiplier on how many moves to make before giving up my $timeout = 2; my $server; if ($address =~ /\.sock$/ and -e $address) { $server = IO::Socket::UNIX->new(Type => SOCK_STREAM, Peer => $address); } else { if ($address =~/:/) { $server = IO::Socket::INET->new($address); } else { $server = IO::Socket::INET->new("$address:7179"); } } die "Can't connect to server!" unless $server; my $done = 0; my $line; my $size = 1; while ($done < $size*$size * ($timeout+0.1)) { while (defined ($line = <$server>) and not $line =~/:/) { if ($done == 0) { $line =~ /size (\d*)/; $size = $1 if defined $1; }; print $line if $done <= 1; }; last if not defined $line; print $line if $done <= 1; print $server "OK\n" if $done == 0; print $server "Random v1.0\n" if $done == 1; my $move = [ int (rand $size), int (rand $size) ]; if ($done < $size*$size * $timeout) { print $server $move->[0]," x ",$move->[1],"\n" if $done >1; print $move->[0]," x ",$move->[1],"\n" if $done >1; } else { print $server "PASS\n" if $done >1; print "PASS\n" if $done >1; } $done++; } print $server "QUIT\n"; -------------------- go-proto.txt file begins: -------------------- This text file describes the protocol used for a go-client to connect +and play a game on the go-server. Please forgive me if it's a horrid description. There are two phases to the protocol, the handshake, and the actual ga +me play. Additionally, any line ending with a colon is an indicator that the se +rver is requesting a response from the client. Handshake: The initial broadcast from the server appears like this: Welcome to the GO server 0.1 You are black The board is size 19 Please type OK to accept: The client is expected to reply with the string "OK" (followed by a ne +wline), the response is case sensitive. The client will then be asked to identify himself, this is for game lo +gging, and is not given to the opponent (at least not until the end of the ga +me). (e.g. 'Killer-GO-AI v0.2a (Adam Luter)'): Please enter a short identifier for yourself: After replying to this request, the server will start the game (there +may be a long delay while you wait for the other player to connect). Also of note, is that the server may ask you what color you want to be +, and appropriate response is black or white. Actual Game: The actual game playing starts with a board state declaration, and the +n a request for a move: Current board ................... ................... ................... ................... ................... ................... ................... ................... ................... ................... ................... ................... ................... ................... ................... ................... ................... ................... ................... . MOVE: Please note that the line with a single '.' is to indicate the end of +the board display. Black peices are represented as an 'X' and white as 'O +'. If there is some sort of processing error a '?' may appear on the board s +tate. The server does not check for these, and the client isn't really expec +ted to either, they are present only for debugging the server code. The move response should be in the form of: "number x number" such as +"2 x 3". Note that moves are zero based, so that "0 x 0" is the upper left corn +er. (if you send an improperly formated response, the server defaults to a + pass) Also, there are two special moves. The first is "PASS" which indicate +s the wish to pass your turn. If both players pass their turn, the game wil +l end. The game does not check for the number of valid moves left, so this is + the only terminating condition. It is recommended that your client time o +ut a game after some large number of moves, or realize an end game state. The other move "QUIT" indicates the client has quit for some reason. +This is merely done for politeness, and the server will handle a broken con +nection the same way as a "QUIT" response. When a move is sent, the server will reply with either invalid or vali +d move. If the move was invalid the client is allowed to try again indefinatel +y. This feature may be turned off in later versions, once clients have become +smart enough. When the game ends, the server will print to -its- display the score, +and if anyone quit, also who wins (which can be different from the score, if +someone quit). It will also communicate who won to the client. Note that the server runs on port 7179 by default, unless you change i +t. If you want to figure this out, the easiest way is to simply play by h +and with the command: telnet serversaddress 7179 this will allow you to play + against your own computer opponent, and also let you see how the text flow wor +ks. Enjoy.

In reply to GO Arena version 0.1a by gryng

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



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others pondering the Monastery: (11)
    As of 2014-08-30 13:03 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The best computer themed movie is:











      Results (293 votes), past polls