#!/usr/bin/env perl
use strict;
use warnings;

use Game::Theory::TwoPersonMatrix;

# Set the number of moves
my $n = shift || 100;

# A Prisoner's Dilemma
my $g = Game::Theory::TwoPersonMatrix->new(
    # Payoff table for the row player
    payoff1 => [ [3, 0],   # 1
                 [5, 1] ], # 2
    # Payoff table for the column player (opponent)
    #             1  2
    payoff2 => [ [3, 5],
                 [0, 1] ],
);

# Initial strategies
my %strategy = (
    1 => cooperate(),
    2 => cooperate(),
#    1 => defect(),
#    2 => defect(),
#    1 => random(),
#    2 => random(),
);

my ( $player, $opponent, @moves );

for ( 1 .. $n )
{
    # Each player makes a move
    my ($play) = $g->play(%strategy);

    # The strategies are encoded in the key
    push @moves, (keys %$play)[0];

    # Update the score for each player
    my ($p) = values %$play;
    $player   += $p->[0];
    $opponent += $p->[1];

    # Set next strategies
    %strategy = (
#        1 => cooperate(),
#        2 => cooperate(),
#        1 => defect(),
#        2 => defect(),
#        1 => random(),
#        2 => random(),
#        1 => tit_for_tat(\@moves)->{1},
#        2 => tit_for_tat(\@moves)->{2},
        1 => tit_for_two_tats(\@moves)->{1},
        2 => tit_for_two_tats(\@moves)->{2},
    );
}

print "Player = $player, Opponent = $opponent\n";

sub random { return { 1 => 0.5, 2 => 0.5 } }

sub cooperate { return { 1 => 1, 2 => 0 } }

sub defect { return { 1 => 0, 2 => 1 } }

sub tit_for_tat {
    my $moves = shift;
    my ( $strat1, $strat2 ) = split /,/, $moves->[-1];
    return {
        1 => {
            1 => ( $strat2 == 1 ? 1 : 0 ),
            2 => ( $strat2 == 2 ? 1 : 0 ),
        },
        2 => {
            1 => ( $strat1 == 1 ? 1 : 0 ),
            2 => ( $strat1 == 2 ? 1 : 0 ),
        },
    }
}

sub tit_for_two_tats {
    my $moves = shift;

    return tit_for_tat($moves) if @$moves == 1;

    my ( $strat1, $strat2 ) = split /,/, $moves->[-1];
    my ( $strat3, $strat4 ) = split /,/, $moves->[-2];
    # Defect if the opponent has defected twice in a row
    # Otherwise use tit_for_tat
    return {
        1 => {
            1 => ( $strat2 == 2 && $strat4 == 2 ? 0 : ( $strat2 == 1 ? 1 : 0 ) ),
            2 => ( $strat2 == 2 && $strat4 == 2 ? 1 : ( $strat2 == 2 ? 1 : 0 ) ),
        },
        2 => {
            1 => ( $strat1 == 2 && $strat3 == 2 ? 0 : ( $strat1 == 1 ? 1 : 0 ) ),
            2 => ( $strat1 == 2 && $strat3 == 2 ? 1 : ( $strat1 == 2 ? 1 : 0 ) ),
        },
    }
}
