Marienbad

Marienbad.

Nim is a mathematical game of strategy in which two players take turns removing (or "nimming") objects from distinct heaps or piles. On each turn, a player must remove at least one object, and may remove any number of objects provided they all come from the same heap. Depending on the version being played, the goal of the game is either to avoid taking the last object or to take the last object.

There are lots of different versions of Nim, one of the best known is the Marienbad game, so called because having been played in the French New Wave film Last Year at Marienbad (1961). In this variant, there are 4 heaps (rows) with 1, 3, 5 and 7 objects (actually matches). The players may take any number of matches they want (at least one) but all from the same row. The player, who takes the last match, looses. Game variants, where the last object looses, are sometimes called Misere variants. If you are interested in details about these games, here the Wikipedia links for Nim and Marienbad (German Wiki).

My Marienbad online application.

My Marienbad online application is a Perl CGI implementation of my Marienbad desktop application that you may freely download from the Lazarus/Free Pascal Programming section of my site. The application is for 1 human player, who plays against the computer. You may choose the type of game (Nim play: Last match wins, or Misere play: Last match looses), the player who begins (the computer, or you), as well as the computer playing strength. There are three strength levels available:

Novice: The computer makes all random moves, including at the end of the game (may be seen as if it did not remember if the last match wins or looses).
Intermediate: At the first half of the game (i.e. until half of the initial number of matches has been taken), the computer plays randomly or not (1 random move out of 3); in the second half, it plays at full strength.
Expert: The computer plays at full strength, i.e. if there is a possibility to win the game, it will always win.

To play the game, set the wanted game parameters and push the Start button. If the computer has to make the first move, it does it. Now it's your turn. Enter the number of matches, that you want to nim in the input field at the right of the heap, from which you want to nim, then push Play. The computer moves automatically after you have done so. If the game is over, push New to prepare for a new one, change the game parameters, if you want so, and push Start to begin the new game.

Use the following link to start the online application.

The Marienbad Perl script.

Marienbad is a Perl CGI application, user input validity check, input field focusing, and display of the winner message being done by Javascript. The validity check is done by a function called when the submit button of the HTML form is pushed. This function, displaying a message if the input isn't ok, returns a Boolean: If it is true, the Perl script is called, otherwise, nothing happens (concerning the Javascript code of this function, cf. below). The code for the field focusing and the winning message display is directly included into the website, generated by the Perl script. Use the following links to download the Marienbad application (HTML, Javascript and Perl sources) resp. to show the Marienbad Perl source code.

#!C:/Programs/Strawberry/win64/perl/bin/perl.exe -I"."

##### Nim: Marienbad variant #####

use strict; use warnings;
use CGI;
use CGI::Carp "fatalsToBrowser";

my $cgi = new CGI;
print "Content-Type: text/html\n\n";
print '<!DOCTYPE html>', "\n\n";
my $app_dir = "C:\\Programs\\Apache24\\htdocs\\computing\\website\\applications"; Change this to your own application directory!
my $lastmatch; my $firstmove; my $level;
my @initialmatches; my @matches; my @playerrowmatches;
$initialmatches[0] = 1; $initialmatches[1] = 3; $initialmatches[2] = 5; $initialmatches[3] = 7;
my $playerrow = -1; my $playermatches = 0; my $computerrow = -1; my $computermatches = 0;
# Get parameters from 'calling' webpage and determine next button-push action
my %params = $cgi->Vars;
my $action = lc($params{'action'});
$action = 'init' unless ($action);
if ($action eq 'init' or $action eq 'new' or $action eq 'start' or $action eq 'play') {
my $nextaction;
if ($action eq 'init' or $action eq 'new') {
# Prepare for a new game
if ($action eq 'init') {
# Defaults at first run
$lastmatch = 'winner'; $firstmove = 'player'; $level = 1;
}
else {
# Keeping settings from previous game
$lastmatch = $params{'hlastmatch'}; $firstmove = $params{'hfirstmove'}; $level = $params{'hlevel'};
}
@matches = @initialmatches;
$nextaction = 'start';
}
else {
if ($action eq 'start') {
# Start a new game (with parameters set by user)
$lastmatch = $params{'lastmatch'}; $firstmove = $params{'firstmove'}; $level = $params{'level'};
@matches = @initialmatches;
}
else {
# Play the game
$lastmatch = $params{'hlastmatch'}; $firstmove = $params{'hfirstmove'}; $level = $params{'hlevel'};
$matches[0] = $params{'hmatches1'}; $matches[1] = $params{'hmatches2'};
$matches[2] = $params{'hmatches3'}; $matches[3] = $params{'hmatches4'};
$playerrowmatches[0] = $params{'player1'}; $playerrowmatches[1] = $params{'player2'};
$playerrowmatches[2] = $params{'player3'}; $playerrowmatches[3] = $params{'player4'};
for (my $i=0; $i < 4; $i++) {
if ($playerrowmatches[$i]) {
$playerrow = $i; $playermatches = $playerrowmatches[$i];
}
}
}
$nextaction = 'play';
}
# XSS protection: Potential risk characters removal and variable check (better being to careful than not enough...)
$lastmatch = 'winner' unless ($lastmatch eq 'looser');
$firstmove = 'player' unless ($firstmove eq 'computer');
$level = 1 unless ($level == 2 or $level == 3);
for (my $i=0; $i < 4; $i++) {
$matches[$i] =~ s/[^0-7]//g;
$playerrowmatches[$i] =~ s/[^1-7]//g;
}
$playerrow =~ s/[^1-4]//g;
$playermatches =~ s/[^1-7]//g;
# Do action, depending on the actual button caption ('Start' or 'Play')
my $winner = '';
if ($action eq 'start' or $action eq 'play') {
if ($action eq 'start') {
# If the computer has to move first, do the move (otherwise just generate the webpage)
if ($firstmove eq 'computer') {
($computerrow, $computermatches) = computerMove(\@matches, $lastmatch, $level);
$matches[$computerrow] -= $computermatches;
}
}
else {
# Determine matches remaining after player's move. If all matches have been taken, the game is over
# Otherwise, do computer's move
$matches[$playerrow] -= $playermatches;
my $remaining = $matches[0] + $matches[1] + $matches[2] + $matches[3];
if ($remaining == 0) {
# No match remaining: Player has taken last match
if ($lastmatch eq 'winner') {
$winner = 'The player takes the last match and wins!';
}
else {
$winner = 'The player takes the last match and looses!';
}
}
else {
# One or more matches remaining: Do computer's move
($computerrow, $computermatches) = computerMove(\@matches, $lastmatch, $level);
$matches[$computerrow] -= $computermatches;
my $remaining = $matches[0] + $matches[1] + $matches[2] + $matches[3];
if ($remaining == 0) {
# No match remaining: Computer has taken last match
if ($lastmatch eq 'winner') {
$winner = 'The computer takes the last match and wins!';
}
else {
$winner = 'The computer takes the last match and looses!';
}
}
}
}
if ($winner) {
# If game is over, next action will be preparation for a new game
$nextaction = 'new';
}
}
# Read template HTML file
my $template = "$app_dir\\marienbad.template.html";
open(my $input, "<", $template)
or die "Can't open template file $template: $!";
my @lines = <$input>;
close($input);
# Create the webpage, printing the template, replacing all #-tags by the actual values
my $matchcount = 0;
foreach my $line (@lines) {
chomp($line);
if ($line) {
if (substr($line, 0, 1) eq '#') { # A '#' at beginning of line indicates that line contains a tag
$line = substr($line, 1);
if ($line =~ /#checked1a#/) {
# Last match = Winner radio button
if ($lastmatch eq 'winner') {
$line =~ s/#checked1a#/checked="checked"/;
}
else {
$line =~ s/#checked1a#//;
}
}
elsif ($line =~ /#checked1b#/) {
# Last match = Looser radio button
if ($lastmatch eq 'looser') {
$line =~ s/#checked1b#/checked="checked"/;
}
else {
$line =~ s/#checked1b#//;
}
}
elsif ($line =~ /#checked2a#/) {
# First move = Computer radio button
if ($firstmove eq 'computer') {
$line =~ s/#checked2a#/checked="checked"/;
}
else {
$line =~ s/#checked2a#//;
}
}
elsif ($line =~ /#checked2b#/) {
# First move = Player radio button
if ($firstmove eq 'player') {
$line =~ s/#checked2b#/checked="checked"/;
}
else {
$line =~ s/#checked2b#//;
}
}
elsif ($line =~ /#selected1#/) {
# Computer strength = Novice
if ($level == 1) {
$line =~ s/#selected1#/selected="selected"/;
}
else {
$line =~ s/#selected1#//;
}
}
elsif ($line =~ /#selected2#/) {
# Computer strength = Intermediate
if ($level == 2) {
$line =~ s/#selected2#/selected="selected"/;
}
else {
$line =~ s/#selected2#//;
}
}
elsif ($line =~ /#selected3#/) {
# Computer strength = Expert
if ($level == 3) {
$line =~ s/#selected3#/selected="selected"/;
}
else {
$line =~ s/#selected3#//;
}
}
elsif ($line =~ /#visible\d\d#/) {
# Show actual matches (by hiding those already taken)
for (my $i=1; $i <= 4; $i++) {
for (my $j=1; $j <= $initialmatches[$i - 1]; $j++) {
my $visible = 'style="visibility:';
my $matchvisible = '#visible' . $i . $j . '#';
if ($line =~ /$matchvisible/) {
if ($j <= $matches[$i - 1]) {
$visible .= 'visible"';
}
else {
$visible .= 'hidden"';
}
$line =~ s/$matchvisible/$visible/;
}
}
}
}
elsif ($line =~ /#computer\d#/) {
# Number of matches taken by the computer
for (my $i=1; $i <= 4; $i++) {
my $rowcomputer = '#computer' . $i . '#';
if ($line =~ /$rowcomputer/) {
if ($computerrow == $i - 1) {
$line =~ s/$rowcomputer/$computermatches/;
}
else {
$line =~ s/$rowcomputer//;
}
}
}
}
elsif ($line =~ /#player\d#/) {
# Number of matches taken by the player
for (my $i=1; $i <= 4; $i++) {
my $rowplayer = '#player' . $i . '#';
if ($line =~ /$rowplayer/) {
$line =~ s/$rowplayer//;
}
}
if ($nextaction eq 'play') {
# During play, the input field must be accessible for user input
$line =~ s/#readonly#//;
$line =~ s/#bold#/bold/;
}
else {
# Do not allow user input if the game isn't actually running
$line =~ s/#readonly#/readonly="readonly"/;
$line =~ s/#bold#//;
}
}
elsif ($line =~ /#button#/) {
# Action button caption
my $button = ucfirst($nextaction);
$line =~ s/#button#/$button/; # set button caption to next action
}
elsif ($line =~ /#hlastmatch#/) {
# Hidden save field for last match rule
$line =~ s/#hlastmatch#/$lastmatch/;
}
elsif ($line =~ /#hfirstmove#/) {
# Hidden save field for game beginner
$line =~ s/#hfirstmove#/$firstmove/;
}
elsif ($line =~ /#hlevel#/) {
# Hidden save field for computer strength
$line =~ s/#hlevel#/$level/;
}
elsif ($line =~ /#hmatches\d#/) {
# Hidden save field for number of matches in each row (after there have been matches taken)
for (my $i=1; $i <= 4; $i++) {
my $rowremaining = '#hmatches' . $i . '#';
if ($line =~ /$rowremaining/) {
$line =~ s/$rowremaining/$matches[$i - 1]/;
}
}
}
elsif ($line =~ /#playerhrow#/) {
# Hidden save field for row from which player took matches
$line =~ s/#hplayerhrow#/$playerrow/;
}
elsif ($line =~ /#hplayermatches#/) {
# Hidden save field for number of matches taken by the player
$line =~ s/#hplayermatches#/$playermatches/;
}
elsif ($line =~ /#js#/) {
# Add Javascript code to perform some action when the page is displayed
my $js;
if ($nextaction eq 'play' and $winner eq '') {
# Javascript to focus the first player input field in row with matches left
my $first = 1;
while ($matches[$first - 1] == 0) {
$first++;
}
my $playerfiled = 'player' . $first;
$js = "<script>document.getElementById('$playerfiled').focus();</script>";
}
elsif ($winner ne '') {
# Javascript to pop-up a message, telling who wins/looses the game
$js = "<script>alert('$winner');</script>";
}
else {
$js = '';
}
$line =~ s/#js#/$js/;
}
}
# Print file-line (with tags replaced) to webpage
unless ($line =~ /#/) {
print "$line\n";
}
}
}
}

##### Do the computer's move (depending on actual last-match-rule and strength level) #####

sub computerMove {
my ($ref_matches, $lastmatch, $level) = @_;
my @matches = @$ref_matches;
my $computerrow; my $computermatches;
# Computer move, depending on playing strength selected
if ($level == 3) {
# Expert: Always playing the winning move (if there is any, of course)
($computerrow, $computermatches) = computerWinningMove(\@matches, $lastmatch);
}
else {
# Computer not playing at full strength (making mistakes by making more or less often a random move)
my $matchrows = 0; my $onematchrows = 0;
for (my $i=0; $i < 4; $i++) {
unless ($matches[$i] == 0) {
$matchrows++; # rows with 1 or more matches left
if ($matches[$i] == 1) {
$onematchrows++; # rows with exactly 1 match left
}
}
}
if ($level == 1) {
# Beginner: Random move, except if there is one single row with one or more matches left
if ($matchrows == 1) {
($computerrow, $computermatches) = computerWinningMove(\@matches, $lastmatch);
}
else {
($computerrow, $computermatches) = computerRandomMove(\@matches);
}
}
else {
# Intermediate: 50% random moves at the begin of the game, full strength play at the end of the game
if ($matchrows <= 2 or $matchrows == $onematchrows) {
# End of the game, if there are only 1 or 2 rows left OR if all rows contain one single match
($computerrow, $computermatches) = computerWinningMove(\@matches, $lastmatch);
}
else {
# Not end of the game: Random choice between winning and random move
if (int(rand(2)) == 0) {
($computerrow, $computermatches) = computerRandomMove(\@matches);
}
else {
($computerrow, $computermatches) = computerWinningMove(\@matches, $lastmatch);
}
}
}
}
return ($computerrow, $computermatches);
}

# Computer random move #

sub computerRandomMove {
my ($ref_matches) = @_;
my @matches = @$ref_matches;
my $row; my $taken;
# Choose a random row
do {
$row = int(rand(4));
} while ($matches[$row] == 0);
# Choose a random number of matches (preference for 1 or 2 matches)
my $r = int(rand(3));
if ($r == 0) {
# Take 1 match
$taken = 1;
}
elsif ($r == 1) {
# Take 2 matches
if ($matches[$row] < 2) {
$taken = 1 # can't take 2 matches if there is only 1!
}
else {
$taken = 2;
}
}
else {
# Randomly take between 1 and 5 matches
do {
$taken = int(rand(5)) + 1;
} while ($taken > $matches[$row]); # can't take more matches than there are in the row!
}
return ($row, $taken);
}

# Computer winning move #

sub computerWinningMove {
# If no winning move can be found, the procedure calls ComputerRandomMove for this move
my ($ref_matches, $last) = @_;
my @matches = @$ref_matches;
my $row; my $taken;
# If the Misere variant is played, check if the standard or the end-of-game algorithm has to be used
my $endGame = 0; my $moreThanOnes = 0; my $ones = 0;
if ($last eq 'looser') {
for (my $i = 0; $i < 4; $i++) {
if ($matches[$i] > 1) {
$moreThanOnes++; # rows with more than 1 match
}
if ($matches[$i] == 1) {
$ones++; # rows with exactly 1 match (used by the end-of-game algorithm)
}
}
# The end-of-game algorithm has to be used if there is only 1 row with more than 1 match left
if ($moreThanOnes <= 1) {
$endGame = 1;
}
}
# End-of-game algorithm (to be used only with Misere variant)
if ($endGame) {
$row = -1;
# Take the matches from the row with more than 1 match
for (my $i = 0; $i < 4; $i++) {
if ($matches[$i] > 1) {
$row = $i;
}
}
if ($row == -1) {
# If there isn't such a row, choose a random one and take the 1 match left in that row
do {
$row = int(rand(4));
} while ($matches[$row] == 0);
$taken = 1;
}
else {
# In the row with more than 1 match:
# - Take all matches, if the number of rows with 1 match is odd
# - Take all matches, but 1, if the number of rows with 1 match is even
if ($ones % 2 == 0) {
$taken = $matches[$row] - 1;
}
else {
$taken = $matches[$row];
}
}
}
# Standard algorithm (always applicable with Nim variant)
else {
# For code simplicity, the algorithm takes a random number of matches from a random row and checks if this is a winning move
# This procedure is continued until a winning move has been found or if the loop counter exceeds 1000 (play of random move in this case)
my $win = 0; my $loop = 0;
do {
$loop++;
my @matches2 = @matches;
my @array = (0, 0, 0, 0);
my @matchesBin = (\@array, \@array, \@array);
my @nimSums = (0, 0, 0);
do {
$row = int(rand(4)); # random row (must contain at least 1 match)
} while ($matches2[$row] == 0);
$taken = int(rand($matches2[$row])) + 1; # random number of matches (between 1 and total in the row)
# Standard Nim algrithm:
# For the matches left after this move has been made, transform the number of matches per row to binary (x*4 + y*2 + z*1),
# then calculate the Nim sums for 1, 2 and 4
# If all Nim sums are even numbers, this move will win the game
$matches2[$row] -= $taken; # matches present, after (!) this move has been made
# Transform number of matches to binary
for (my $i = 0; $i < 4; $i++) {
my $n = $matches2[$i];
if ($n >= 4) {
$matchesBin[$i][0] = 1;
$n -= 4;
}
if ($n >= 2) {
$matchesBin[$i][1] = 1;
$n -= 2;
}
if ($n == 1) {
$matchesBin[$i][2] = 1;
}
}
# Calculate the Nim sums
for (my $j = 0; $j < 3; $j++) {
for (my $i = 0; $i < 4; $i++) {
if ($matchesBin[$i][$j] == 1) {
$nimSums[$j]++;
}
}
}
# Check if the move is a winning one
$win = 1;
for (my $j = 0; $j < 3; $j++) {
if ($nimSums[$j] % 2 == 1) { # if there is one Nim sum that is an odd number, this move does not win
$win = 0;
}
}
} while (!$win and $loop < 1000); # try to find a winning move for a maximum number of times
# If there has no winning move been found, suppose there isn't any and make a random move
# This is perhaps not 100% sure, because theoratically even after 1000 trials, the winning move could be missed
# To get rid of this theoratically possible issue, checking if there actually is a winning move would have to be done
if ($loop >= 1000) {
($row, $taken) = computerRandomMove(\@matches);
}
}
return ($row, $taken);
}

Using Javascript to check user input.

The function checkinput() checks the number of matches taken by the player being a valid number that is less than or equal to the number of matches actually available on the heap from which the player wants to take some match(es). If the user input is valid, the function returns true and the Perl script is called. Please, note that my knowlege of Javascript is more than limited, thus my code might look strange to "real Javascript programmers". The only thing that matters to me, is that it works as I want it to work... Use the following link to show the Marienbad - checkinput() Javascript code.

Note: The call to the Javascript function checkinput() is implemented in the HTML file (i.e. the template used by Perl to generate the game website) by adding an onSubmit method to the HTML form definition. The effect of this is that the Perl script (coded as value of the action attribute), will only be called if the function result is true. Here the HTML describing the form object:

If you find this page helpful or if you like my Marienbad web application, please, support me and this website by signing my guestbook.

Computing: Website and Database Programming

Marienbad.