#!/usr/local/bin/perl -w 

use strict;

srand(time);

my $iters = 10;

my $player1 = \&player_random;
#my $player1 = \&player_good;
#my $player1 = \&player_tit_for_tat;

#my $player2 = \&player_random;
#my $player2 = \&player_good;
my $player2 = \&player_tit_for_tat;

my (@record1, @record2, $score1, $score2, $total_score1, $total_score2
+);

for (my $n = 0; $n < $iters; ++$n)
{
    my $ret1 = $player1->(\@record1, \@record2);
    my $ret2 = $player2->(\@record2, \@record1);

    ($score1, $score2) = calc_score($ret1, $ret2);

    $total_score1 += $score1;
    $total_score2 += $score2;

    push(@record1, $ret1);
    push(@record2, $ret2);
}

print_records(\@record1, \@record2);
print "Player1: $total_score1\nPlayer2: $total_score2\n";

#########################################
#
# Subroutines
#
#########################################


sub print_records
{
    my @record1 = @{$_[0]};
    my @record2 = @{$_[1]};

    for (my $n = 0; $n < @record1; ++$n)
    {
    print "$record1[$n] $record2[$n]\n";
    }
}

# H - hold out (be good)
# T - testify (betray)
#
sub calc_score
{
    my $move1 = $_[0];
    my $move2 = $_[1];
    my ($score1, $score2);
    
 SWITCH:
    {
    if ($move1 eq "T" && $move2 eq "T")
    {
        $score1 = 4;
        $score2 = 4;
        last SWITCH;
    }
    if ($move1 eq "T" && $move2 eq "H")
    {
        $score1 = 0;
        $score2 = 5;
        last SWITCH;
    }
    if ($move1 eq "H" && $move2 eq "T")
    {
        $score1 = 5;
        $score2 = 0;
        last SWITCH;
    }
    if ($move1 eq "H" && $move2 eq "H")
    {
        $score1 = 2;
        $score2 = 2;
        last SWITCH;
    }
    }

    return ($score1, $score2);
}


#
# Various players
#
# Arguments: player's past record and opponent's
#            past record
#
# Return: H or T
#

sub player_nice
{
    return "H";
}


sub player_random
{
    return "H" if rand() < 0.5;
    return "T";
}

sub player_tit_for_tat 
{
    my @my_record = @{$_[0]};
    my @his_record = @{$_[1]};

    return "H" unless @my_record;
    return $his_record[$#his_record];
}
[download]