A number of people have expressed an interest in assisting in the growth of SDG by either submitting games or working on AI code. This page is an attempt to clarify how this can be done.
I will first start with AI coding, as this is entirely different from creating a new game. If you wish to add/improve on an existing game's AI, no actual coding is required. The AI algorithms used at SDG expect that each board position can be reduced to a single numerical score for each player. The AI then searches all the possible positions and selects the move that will result in the highest overall score. To work on an AI, simply visit the wiki page for the game in question and add/update the AI section and provide for me a detailed algorithm as to how to reduce a given position to a numerical value (positive, negative, integer, floating-point, whatever). I will then translate this into the appropriate Perl code and you can test it out!
There are still caveats, however. The main one being that some games generate a prohibitively large game tree that is simply unfeasible to parse. The most obvious example is Homeworlds. The list of possible moves for each turn is immense and extremely difficult to process with any alacrity. Pikemen also poses a similar problem. That said, I warmly welcome any input as to AI creation and improvement.
The first thing to realize is that I did not originally design SDG with a third-party-friendly API. Unfortunately, it will take some time, and lots of back-and-forth between you and I, before things start working. That said, I am very excited to work with interested parties in the designing of new games. I am completely open to any questions or concerns you may have. Feel free to contact me.
All that is required of you is to code a working Games::AlphaBeta::Pos object. This object I then take and “plug in” to the overall framework. I will do my very best to explain how this is to be done. I will include below extracts from existing code to illustrate. If things are not clear, please contact me.
package Mygame::Pos; use base Games::AlphaBeta::Position; use strict; use Image::Magick; my $datadir = ''; my $imgdatadir = '';
This is basically what should appear at the top of your Pos object. The variables $datadir and $imgdatadir point to static directories on the server where you can store whatever data your game ends up needing (stock images and the like). This is also where you can declare any other variables and information globally needed by your object. It should be noted that you may create as many auxilliary objects as you need for your game. Simply use them at the top of your Pos object.
package Homeworlds::Pos; use base Games::AlphaBeta::Position; use lib '/home/html/games/lib'; use strict; use Image::Magick; use Homeworlds::Ship; use Homeworlds::System::Home; use Homeworlds::System::Peripheral; use YAML qw(Dump DumpFile Load LoadFile); my $rootdir = '/home/html/games/'; my $datadir = $rootdir.'data/homeworlds/'; my $imgdatadir = $rootdir.'data/images/homeworlds/'; my $imgdir = $rootdir.'HTML/images/games/'; my @seats = qw(N S E W); my %perspective = (N=>{N=>'S', E=>'W', S=>'N', W=>'E'}, E=>{N=>'E', E=>'S', S=>'W', W=>'N'}, S=>{N=>'N', E=>'E', S=>'S', W=>'W'}, W=>{N=>'W', E=>'N', S=>'E', W=>'S'}); my %rotation = (N=>180, E=>90, S=>0, W=>270); my %techtype = qw(Y propulsion G construction B conversion R weapons); my %colorname = qw(Y yellow G green B blue R red); my %colorabbrev = qw(YELLOW Y GREEN G BLUE B RED R); my %seat2name = qw(N North E East S South W West);
sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = $class->SUPER::new() || return undef; $self->player('Player1'); return $self; }
This is the bare minimum constructor. At the very least it must call Games::AlphaBeta::Pos::new(), set the current player, and return the blessed object. This is not a very useful object, however. Here is also where you would devise a way to represent the game board and any other state variables you might need. Here are some RL examples:
sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = $class->SUPER::new() || return undef; $self->{board} = {}; #seed board $self->{board}->{a1} = 'R'; $self->{board}->{c1} = 'B2'; $self->{board}->{e1} = 'R'; $self->{board}->{g1} = 'B2'; $self->{board}->{b2} = 'B2'; $self->{board}->{d2} = 'R'; $self->{board}->{f2} = 'B2'; $self->{board}->{h2} = 'R'; $self->{board}->{b8} = 'R2'; $self->{board}->{d8} = 'B'; $self->{board}->{f8} = 'R2'; $self->{board}->{h8} = 'B'; $self->{board}->{a7} = 'B'; $self->{board}->{c7} = 'R2'; $self->{board}->{e7} = 'B'; $self->{board}->{g7} = 'R2'; $self->player('R'); return $self; }
This example shows the $variant variable. Variants are given full names like International or Expert Mode and can be passed to your object by the framework. Do with them what you will!
sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = $class->SUPER::new() || return undef; my ($variants) = @_; $self->{international} = 0; if ( (defined $variants) && (ref($variants) eq 'ARRAY') ) { foreach my $variant (@$variants) { if ($variant =~ /^international/i) { $self->{international} = 1; } } } $self->{score}->{B} = 0; $self->{score}->{R} = 0; $self->{stacks} = []; $self->{lastpoint} = undef; $self->{board} = {}; #seed board #blue my @ranks = qw(2 4 6); my @files = qw(a c e g); if ($self->{international}) { push @ranks, 8; push @files, 'i'; } foreach my $col (@files) { foreach my $row (@ranks) { push @{$self->{board}->{$col.$row}}, 'R'; } } #red @ranks = qw(3 5 7); @files = qw(b d f h); if ($self->{international}) { push @ranks, 9; push @files, 'j'; } foreach my $col (@files) { foreach my $row (@ranks) { push @{$self->{board}->{$col.$row}}, 'B'; } } $self->player('R'); return $self; }
This routine is expected to return a list of all legal moves for a given player in the current position. If you ever want an AI for your game, this routine is required. If, however, an AI is truly impossible (a la Homeworlds) then this routine can be omitted. Even so, the findmoves() routine can make your life infinitely easier. If you have a working findmoves() routine then your apply() can forego all error checking. Pikemen is an example of a game for which an AI is unfeasible, but generating a list of moves is trivial, so why not make your life easier?!
This excerpt introduces two(2) home-rolled convenience routines. These are not provided by Games::AlphaBeta nor by the larger SDG framework. You are expected to write whatever routines you need, appropriate to your coding style. The routines in question are getOccupied() which returns a list of occupied cells, and nextCell() which takes a starting location and direction and returns the next cell (or undef if at the edge of the board).
The other issue that comes up here is the shuffling of the move list that occurs at the end of the excerpt. This is really only necessary if you plan on implementing an AI. As discussed above, the AI algorithm reduces all board positions to a single numerical value. Often, multiple moves will result in the same score. In this case, the first move encountered will be selected. If you never randomize your list of legal moves, then the AI will always select the same move given the same position. This is generally undesireable.
sub findmoves { my ($self, $player) = @_; $player = $self->player() if (! defined $player); my $color = $self->{players}->[$player]; my %moves = (); foreach my $cell (@{$self->getOccupied()}) { my ($currColor, $size, $dir) = ($self->{board}->{$cell} =~ /^([RGBY])([123])(NE|NW|SE|SW|N|E|S|W|U)$/); next if ($currColor ne $color); #reorientation only foreach my $newdir (@dirs) { next if ($dir eq $newdir); $moves{$cell."($newdir)"} = 1; } #movement/captures if ($dir ne 'U') { my $next = $cell; while (1) { #POSSIBLE INFINITE LOOP SITUATION $next = nextCell($next, $dir) || last; if (exists $self->{board}->{$next}) { my $piece = $self->{board}->{$next}; my ($nextColor, $nextSize, $nextDir) = ($piece =~ /^([RGBY])([123])(NE|NW|SE|SW|N|E|S|W|U)$/); last if ($nextColor eq $color); #can't capture your own pieces last if ( ($nextDir eq 'U') && ($size <= $nextSize) ); my $move = $cell.'x'.$next; $moves{$move} = 1; foreach my $newdir (@dirs) { next if ($dir eq $newdir); $moves{$move."($newdir)"} = 1; } last; } else { my $move = $cell.'-'.$next; $moves{$move} = 1; foreach my $newdir (@dirs) { next if ($dir eq $newdir); $moves{$move."($newdir)"} = 1; } } } } } my @moves = keys %moves; use Algorithm::Numerical::Shuffle; @moves = Algorithm::Numerical::Shuffle::shuffle(@moves); return wantarray ? @moves : \@moves; }
sub findmoves { my ($self) = @_; my %moves = (); if ($self->{turnnum} > 4) { foreach my $col ('A'..'D') { foreach my $row (1..4) { my $cell = $col.$row; next if (exists $self->{board}->{$cell}); next if (! $self->hasAdj($cell)); $moves{'b'.$cell} = 1; $moves{'w'.$cell} = 1; } } } else { foreach my $col ('A'..'D') { foreach my $row (1..4) { my $cell = $col.$row; next if (exists $self->{board}->{$cell}); next if ($self->hasAdj($cell)); $moves{'b'.$cell} = 1; $moves{'w'.$cell} = 1; } } } my @moves = keys %moves; use Algorithm::Numerical::Shuffle; @moves = Algorithm::Numerical::Shuffle::shuffle(@moves); return wantarray ? @moves : \@moves; }
The apply() routine is the heart of your game. This routine takes a given move, updates the position, and decides who's turn it is next. As mentioned before, if you have a working findmoves() then this routine does not need to do any error checking. Otherwise, you will have to verify the given input and be prepared to provide useful errors. There are a number of ways you can provide feedback to the framework and it really depends on the type of game you are writing. The way I do it is to simply store the result of the move in some arbitrary variable (in my case lastresult) and then the game board code can query that and output the appropriate chat message. Perl's axim, however, is There Is More Than One Way To Do It and I am of course open to different solutions if you would like to do something different.
This is one of the simplest apply() routines we have, I think.
sub apply { my ($self, $move, $player) = @_; $player = $self->player() if (! defined $player); my ($color, $cell) = ($move =~ /^([bw])([A-D][1-4])$/); $self->{lastpoint} = undef; #place the piece $self->setCell($cell, $color); $self->{stash}--; #flip surrounding pieces foreach my $dir (@dirs) { my $next = nextCell($cell, $dir) || next; $self->flipCell($next); } #check for harvest $self->{lastresult} = $self->harvest($player); return 1; }
This shows a possible way to handle more complex notation.
sub apply { my ($self, $move, $color) = @_; $color = $self->player() if (! defined $color); return undef if (! defined $move); my @moves = split(/\//, $move); # undef: unrecognized move # move: successful move # transpose: successful transposition # bear-off: successful bear-off # crown: successful crown my $result = []; foreach my $move (@moves) { my ($src, $type, $target) = ($move =~ /^([a-h][1-8])([\-\~\+])(([a-h][1-8])|(\(off\)))$/); return undef if (! defined $src); if ($type eq '-') { #move if ($target eq '(off)') { if ($self->{board}->{$src} eq $color.'2') { $self->{board}->{$src} = $color; } else { delete $self->{board}->{$src}; } push @$result, ['bear-off', $src]; } else { my $piece = $self->{board}->{$src}; $self->{board}->{$target} = $piece; delete $self->{board}->{$src}; push @$result, ['move', $src, $target]; } } elsif ($type eq '~') { #transpose $self->{board}->{$src} = $color; $self->{board}->{$target} = $color.'2'; push @$result, ['transpose', $src, $target]; } elsif ($type eq '+') { #crown delete $self->{board}->{$src}; $self->{board}->{$target} = $color.'2'; push @$result, ['crown', $src, $target]; } } if (scalar(@$result) > 0) { $self->player($oppColor{$color}); } $self->{lastresult} = $result; }
This is the most complicated example. This apply() routine has to do all the error checking as well. Don't be surprised if the following makes no sense to you. I doesn't to me either half the time
sub apply { my ($self, $movesArray, $seat) = @_; $seat = $self->{players}->[$self->player()] if (! defined $seat); return undef if ( (! defined $movesArray) || (ref($movesArray) ne 'ARRAY') || (scalar(@$movesArray) != 2) ); my ($username, $moves) = @$movesArray; #my $moves = $movesArray->[1]; #my $username = $movesArray->[0]; return undef if ( (! defined $moves) || (ref($moves) ne 'ARRAY') || (scalar(@$moves) == 0) ); $self->{lastelimination} = undef; my $result = []; my $errors = []; my %actions = qw(free 1 R 0 G 0 B 0 Y 0); my $globalActions = 0; MOVE: foreach my $move (@$moves) { last if (scalar(@$errors) > 0); next if ($move =~ /^\s*$/); my ($cmd, @args) = split(/\s+/, $move); $cmd = lc($cmd); if ($cmd eq 'homeworld') { if (! canAct(\%actions)) { push @$errors, "You have no more actions."; last MOVE; } if (exists $self->{systems}->{home}->{$seat}) { push @$errors, "You already have a homeworld!"; last MOVE; } my ($star1, $star2, $ship, $override) = @args; $star1 = uc($star1); $star2 = uc($star2); $ship = uc($ship); my $name = $username; #if ( (! defined $name) || ($name !~ /^[A-Za-z][A-Za-z0-9\_\-\']{1,14}$/) ) { # push @$errors, "You must provide a name from 2-15 characters long using the characters [A-Za-z0-9_-']."; # last MOVE; #} if (exists $self->{systems}->{all}->{$name}) { push @$errors, "A system has already been mapped with the name $name."; last MOVE; } foreach my $star ($star1, $star2, $ship) { if (! $self->takeStash($star)) { push @$errors, "There are no $star pieces left in the stash to take."; last MOVE; } } my $system = Homeworlds::System::Home->new($name, [$star1, $star2], $seat) || (push @$errors, "The System object could not be created."); my $shipObj = Homeworlds::Ship->new(split(//, $ship), $seat) || (push @$errors, "The Ship object could not be created."); #check for standard beginner errors if ( (! defined $override) || ($override ne '*') ) { #too small of a starting ship my $smallship = 0; $smallship = 1 if ($ship !~ /3$/); #less than 3 distinct colours my $fewcolors = 0; my %colors = (); foreach my $var ($star1, $star2, $ship) { my ($color, $size) = split(//, $var); $colors{uc($color)} = 1; } $fewcolors = 1 if (scalar(keys %colors) < 3); #same star size my $samestars = 0; my %sizes = (); foreach my $var ($star1, $star2) { my ($color, $size) = split(//, $var); $sizes{$size} = 1; } $samestars = 1 if (scalar(keys %sizes) < 2); #no green or yellow my $wrongtech = 0; $wrongtech = 1 if ( (! exists $colors{Y}) || (! exists $colors{G}) ); if ($smallship) { push @$errors, "It is very important to start with a size 3 ship! To override this check, please append an asterisk (*) to the end of the 'homeworld' command (eg. homeworld y1 b2 g2 *)."; last MOVE; } elsif ($wrongtech) { push @$errors, "It is very important that your homeworld have access to Yellow and Green technologies! To override this check, please append an asterisk (*) to the end of the 'homeworld' command (eg. homeworld r1 b2 r3 *)."; last MOVE; } elsif ($fewcolors) { push @$errors, "It is very important to include 3 different colours in your homeworld! To override this check, please append an asterisk (*) to the end of the 'homeworld' command (eg. homeworld y1 y2 g3 *)."; last MOVE; } elsif ($samestars) { push @$errors, "It is very important that your starting stars be different sizes! To override this check, please append an asterisk (*) to the end of the 'homeworld' command (eg. homeworld y1 b1 g3 *)."; last MOVE; } } if ( (defined $system) && (defined $shipObj) ) { if (! $system->addShip($shipObj)) { push @$errors, "The ship cannot dock in that system."; last MOVE; } if (! $self->addSystem($system)) { push @$errors, "The Position object did not accept the System."; last MOVE; } push @$result, $seat2name{$seat}." seat has established a Homeworld."; } } elsif ($cmd eq 'discover') { if (! canAct(\%actions, 'Y')) { push @$errors, "You have no more actions."; last MOVE; } my ($ship, $fromSystem, $star, $newName) = @args; $ship = uc($ship); $star = uc($star); if ( (! defined $newName) || ($newName !~ /^[A-Za-z][A-Za-z0-9\_\-]{1,14}$/) ) { push @$errors, "You must provide a name from 2-15 characters long using the characters [A-Za-z0-9_-]."; last MOVE; } #does the System exist? my $from = $self->getSystem($fromSystem); if (! defined $from) { push @$errors, "The ".ucfirst(lc($fromSystem))." system does not exist."; last MOVE; } #does the Ship exist? if (! $from->existsShip($ship.$seat)) { push @$errors, "You do not own the ship $ship in the ".$from->name()." system."; last MOVE; } #does the user have access to Yellow? if (! $from->hasColor('Y', $seat)) { if ( (! $globalActions) || (! $from->isOccupied($seat)) ) { push @$errors, "You do not have access to propulsion technology (YELLOW) in this sector."; last MOVE; } } #are the systems connected my $connected = 1; foreach my $existingStar (@{$from->stars()}) { my ($newSize) = ($star =~ /(\d)$/); my ($existingSize) = ($existingStar =~ /(\d)$/); if ($newSize == $existingSize) { $connected = 0; last; } } if (! $connected) { push @$errors, "These systems are not connected."; last MOVE; } #is name valid? if ( (! defined $newName) || ($newName !~ //) ) { push @$errors, "The name you provided for the newly discovered system is invalid. It must be no longer than 15 characters and can only contain [A-Za-z0-9_-']."; last MOVE; } if (exists $self->{systems}->{all}->{$newName}) { push @$errors, "A system has already been mapped with the name $newName."; last MOVE; } #are there sufficient pieces in the stash if (! $self->takeStash($star)) { push @$errors, "There are insufficient $star pieces in the stash."; last MOVE; } my $newSystem = Homeworlds::System::Peripheral->new($newName, $star); if (! defined $newSystem) { push @$errors, "The System object could not be created."; last MOVE; } if (! $from->moveShip($ship.$seat, $newSystem)) { push @$errors, "The ship could not be moved."; last MOVE; } if ($self->addSystem($newSystem)) { push @$result, $seat2name{$seat}."'s ship $ship discovered a new star system! It has been named $newName."; } else { push @$errors, "The new System object could not be created."; last MOVE; } } elsif ($cmd eq 'move') { if (! canAct(\%actions, 'Y')) { push @$errors, "You have no more actions."; last MOVE; } my ($ship, $fromSystem, $toSystem) = @args; $ship = uc($ship); #do the Systems exist? my $from = $self->getSystem($fromSystem); if (! defined $from) { push @$errors, "The ".ucfirst(lc($fromSystem))." system does not exist."; last MOVE; } my $to = $self->getSystem($toSystem); if (! defined $to) { push @$errors, "The ".ucfirst(lc($toSystem))." system does not exist."; last MOVE; } #does the Ship exist? if (! $from->existsShip($ship.$seat)) { push @$errors, "You do not own a ship $ship in the ".$from->name()." system."; last MOVE; } #does the user have access to Yellow? if (! $from->hasColor('Y', $seat)) { if ( (! $globalActions) || (! $from->isOccupied($seat)) ) { push @$errors, "You do not have access to propulsion technology (YELLOW) in this sector."; last MOVE; } } #are the systems connected my $connected = 1; STARCHECK: foreach my $existingStar (@{$from->stars()}) { foreach my $newStar (@{$to->stars()}) { my ($newSize) = ($newStar =~ /(\d)$/); my ($existingSize) = ($existingStar =~ /(\d)$/); if ($newSize == $existingSize) { $connected = 0; last STARCHECK; } } } if (! $connected) { push @$errors, "These systems are not connected."; last MOVE; } if (! $from->moveShip($ship.$seat, $to)) { push @$errors, "The ship could not be moved."; last MOVE; } push @$result, $seat2name{$seat}." moved their $ship ship from ".$from->name()." to ".$to->name()."."; } elsif ($cmd eq 'construct') { if (! canAct(\%actions, 'G')) { push @$errors, "You have no more actions."; last MOVE; } my ($ship, $inSystem) = @args; $ship = uc($ship); #does the System exist? my $system = $self->getSystem($inSystem); if (! defined $system) { push @$errors, "The ".ucfirst(lc($inSystem))." system does not exist."; last MOVE; } #does the user have access to Green? if (! $system->hasColor('G', $seat)) { if ( (! $globalActions) || (! $system->isOccupied($seat)) ) { push @$errors, "You do not have access to construction yards (GREEN) in this sector."; last MOVE; } } #does the player already have a ship of that colour in the system? my ($color, $size) = split(//, $ship); if ( (! $system->existsShip($color.'1'.$seat)) && (! $system->existsShip($color.'2'.$seat)) && (! $system->existsShip($color.'3'.$seat)) ) { push @$errors, "To build a new ship you must already control one of the same colour ($color)."; last MOVE; } #are there sufficient pieces in the stash if (! $self->takeStash($color.$size)) { push @$errors, "There are insufficient $color$size pieces in the stash."; last MOVE; } #did the player choose the smallest size available in that colour? if ( ($size == 2) && ($self->hasStash($color.'1')) ) { push @$errors, "You must choose the smallest available $color piece."; last MOVE; } elsif ( ($size == 3) && ( ($self->hasStash($color.'1')) || ($self->hasStash($color.'2')) ) ) { push @$errors, "You must choose the smallest available $color piece."; last MOVE; } #create the ship my $objShip = Homeworlds::Ship->new($color, $size, $seat); if (! defined $objShip) { push @$errors, "Unable to create Ship object."; last MOVE; } #dock it if (! $system->addShip($objShip)) { push @$errors, "The new ship was unable to dock in the ".$system->name()." system."; last MOVE; } push @$result, $seat2name{$seat}." created a $ship ship in the ".$system->name()." system."; } elsif ($cmd eq 'trade') { if (! canAct(\%actions, 'B')) { push @$errors, "You have no more actions."; last MOVE; } my ($oldShip, $newShip, $inSystem) = @args; $oldShip = uc($oldShip); $newShip = uc($newShip); #does the System exist? my $system = $self->getSystem($inSystem); if (! defined $system) { push @$errors, "The ".ucfirst(lc($inSystem))." system does not exist."; last MOVE; } #does the user have access to Blue? if (! $system->hasColor('B', $seat)) { if ( (! $globalActions) || (! $system->isOccupied($seat)) ) { push @$errors, "You do not have access to salvage yards (BLUE) in this sector."; last MOVE; } } #are the ships the same size my ($oldColor, $oldSize) = split(//, $oldShip); my ($newColor, $newSize) = split(//, $newShip); if ($newSize != $oldSize) { push @$errors, "You can only trade-in ships of the same size."; last MOVE; } #are there sufficient pieces in the stash if (! $self->takeStash($newShip)) {