Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Iterated prisoner's dilemma

by spurperl (Priest)
on Jul 30, 2002 at 13:58 UTC ( #186201=sourcecode: print w/ replies, xml ) Need Help??

Category: Fun stuff
Author/Contact Info spurperl at perlmonks.org
Description: A small script showing the Iterated prisoner's dilemma games. Allows to easily add subroutines and thy them against other algorithms.
#!/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];
}

Comment on Iterated prisoner's dilemma
Download Code
Re: Iterated prisoner's dilemma
by blakem (Monsignor) on Jul 30, 2002 at 20:32 UTC
    How does this guy fare?
    sub player_cheater { return 'password' if $_[0] eq 'secret'; my $password = ''; eval {$password = $player1->('secret')}; if ($password eq 'password') { $total_score1 += 50; } else { $total_score2 += 50; } return "T"; }

    -Blake

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://186201]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (8)
As of 2014-12-25 14:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (160 votes), past polls