Iterated Prisoner's Dilemma

ipd.clj

(defn prisoner [name strategy]
  {:name name :strategy strategy :moves '() :scores '() :total-score 0})

(defn defect [moves] (conj moves 0))

(defn coop [moves] (conj moves 1))

(defn AlwaysDefect [mover opponent]
  (defect mover))

(defn AlwaysCooperate [mover opponent]
  (coop mover))

(defn AlwaysRandom [mover opponent]
  (conj mover (rand-int 2)))

(defn game [& prisoners]
  (map (fn [mover opponent]
         (->> (map :moves [mover, opponent])
              (apply (:strategy mover))
              (assoc mover :moves)))
        prisoners
        (reverse prisoners)))

(defn iterated-game [iterations & prisoners]
  (reduce (fn [ps _] (apply game ps))
          prisoners
          (range 0 iterations)))

(def scores {[1 0] 0
             [0 0] 1
             [1 1] 3
             [0 1] 5})

(defn compute-scores [prisoners moves]
  (map (fn [prisoner moves]
         (let [point (get scores moves)
               scores (:scores prisoner)
               total (:total-score prisoner)]
           (assoc prisoner
             :scores (conj scores point)
             :total-score (+ total point))))
       prisoners
       [moves (reverse moves)]))

(defn total-scores [& prisoners]
  (let [move-pairs (->> (map :moves prisoners)
                        (apply interleave)
                        (partition 2))]
    (reduce compute-scores prisoners move-pairs)))

(->> [(prisoner :a AlwaysCooperate) (prisoner :b AlwaysDefect)]
 (apply iterated-game 2)
 (apply total-scores)
 (map :total-score))

ipd.go

package main

import (
	"fmt"
	"math/rand"
	"time"
)

type Move uint

const Cooperate = 1

const Defect = 0

type Prisoner struct {
	Name       string
	Moves      []Move
	Scores     []uint
	TotalScore uint64

	Strategy
}

type Strategy interface {
	Move(opponent Prisoner) Move
}

type scoreTuple [2]Move

var ScoreMatrix = map[scoreTuple]uint{
	scoreTuple{1, 0}: 0,
	scoreTuple{0, 0}: 1,
	scoreTuple{1, 1}: 3,
	scoreTuple{0, 1}: 5,
}

type AlwaysDefect struct{}
type AlwaysCooperate struct{}
type AlwaysRandom struct{}

func (s AlwaysDefect) Move(opponent Prisoner) Move {
	return Defect
}

func (s AlwaysCooperate) Move(opponent Prisoner) Move {
	return Cooperate
}

func (s AlwaysRandom) Move(opponent Prisoner) Move {
	if rand.Intn(1) == 1 {
		return Cooperate
	} else {
		return Defect
	}
}

type Game struct {
	Prisoners [2]Prisoner
}

func (g *Game) Play(times int) {
	for i := 0; i < times; i++ {
		a := &g.Prisoners[0]
		b := &g.Prisoners[1]

		aMove := a.Move(*b)
		bMove := b.Move(*a)

		a.Moves = append(a.Moves, aMove)
		b.Moves = append(b.Moves, bMove)

		aScore := computeScore(aMove, bMove)
		bScore := computeScore(bMove, aMove)

		a.Scores = append(a.Scores, aScore)
		b.Scores = append(b.Scores, bScore)

		a.TotalScore += uint64(aScore)
		b.TotalScore += uint64(bScore)
	}
}

func computeScore(a, b Move) uint {
	score := ScoreMatrix[scoreTuple{a, b}]

	return score
}

func main() {
	rand.Seed(time.Now().UTC().UnixNano())

	a := Prisoner{Name: "a", Strategy: new(AlwaysCooperate)}
	b := Prisoner{Name: "b", Strategy: new(AlwaysDefect)}

	g := Game{Prisoners: [2]Prisoner{a, b}}

	g.Play(2)

	fmt.Println("Prisoner A (AlwaysCooperate):", g.Prisoners[0].TotalScore)
	fmt.Println("Prisoner B (AlwaysDefect)   :", g.Prisoners[1].TotalScore)
}

ipd.hs

import Text.Show.Functions

data Move = Cooperate | Defect
  deriving (Show)

type Moves = [Move]

type Strategy = Moves -> Moves -> Move

data Prisoner = Prisoner
    { name     :: String
    , strategy :: Strategy
    , moves    :: Moves
    , scores   :: [Int]
    , total    :: Int
    } deriving (Show)

newPrisoner :: String -> Strategy -> Prisoner
newPrisoner name strategy =
  Prisoner {name=name,moves=[],scores=[],total=0,strategy=strategy}

alwaysCooperate :: Strategy
alwaysCooperate _ _ = Cooperate

alwaysDefect :: Strategy
alwaysDefect _ _ = Defect

score :: (Move, Move) -> Int
score (Cooperate, Defect)    = 0
score (Defect, Defect)       = 1
score (Cooperate, Cooperate) = 3
score (Defect, Cooperate)    = 5

reverseMoves :: (Move, Move) -> (Move, Move)
reverseMoves moves = (snd moves, fst moves)

computeScores :: [Prisoner] -> (Move, Move) -> [Prisoner]
computeScores prisoners moves =
  map (\(prisoner, moves) ->
    let currentScores = scores prisoner
        currentTotal = total prisoner
        thisScore = score moves
    in prisoner { scores = thisScore : currentScores, total = currentTotal + thisScore })
  [(head prisoners, moves), (last prisoners, reverseMoves moves)]

playGame :: [Prisoner] -> [Prisoner]
playGame prisoners =
  map (\(mover, opponent) ->
    let myMoves = moves mover
        move = strategy mover myMoves (moves opponent)
    in mover { moves = move : myMoves } )
  (zip prisoners $ reverse prisoners)

game :: Int -> [Prisoner] -> [Prisoner]
game iterations prisoners =
  let withMoves = foldl (\prisoners _ -> playGame prisoners) prisoners [1..iterations]
      mvs = zip (moves $ head withMoves) (moves $ last withMoves)
  in foldl computeScores withMoves mvs

main =
  print $ game 1 [newPrisoner "a" alwaysCooperate, newPrisoner "b" alwaysDefect]

I won.

Can you run through this scenario? https://www.youtube.com/watch?v=p3Uos2fzIJ0

The point of this refactoring is that your Prisoner infrastructure is basically for the convenience of a tournament organizer. The core game functionality looks like this:

import Data.Tuple( swap )
import Data.List( foldl' )

-- basic structure is like this:
data Decision = Cooperate | Defect
type Move = (Decision, Decision)
type Score = (Integer, Integer)

-- Newest moves in History are at the head
-- Probably more convenient for Strategies with narrow time windows
type History = [Move]

-- Strategies assume they play for the first player (so 'map fst History' = my moves)
type Strategy = History -> Decision

sum :: Score -> Score
(a1, a2) `sum` (b1, b2) = (a1 + b1, a2 + b2)

score :: Move -> Score
score (Cooperate, Defect)    = (0, 5)
score (Defect, Defect)       = (1, 1)
score (Cooperate, Cooperate) = (3, 3)
score (Defect, Cooperate)    = (5, 0)

scoreGame :: History -> Score 
scoreGame = foldl' sum (0, 0) . map score

runGame :: History -> Strategy -> Strategy -> History 
runGame hist s1 s2 = moves : runGame (moves : hist) s1 s2 
  where 
    moves = (s1 hist, s2 $ map swap hist)

play :: Integer -> Strategy -> Strategy -> History
play iters = take iters . runGame []

main = print . scoreGame . play $ 1 (const Cooperate) (const Defect)