# Iterated Prisoner Dilemma Haskell implementation

A collegue and me implemented a simulator the iterated prisoner dilemma from game theory in haskell. We would appreciate any feedback on the quality of the code, how things could be worked out more efficiantly or elegantly.

The code file together with a tex file (along with the compiled PDF) in literate haskell style that explains the problem and all of the code can be found on GitHub.

I have included the code itself here too:

{-# LANGUAGE FlexibleInstances #-}

module Main where

import System.Random
import Data.List (nubBy, sortBy, intercalate)
import Data.Bifunctor (bimap)
import Data.Function (on)

main :: IO ()
main =  do
result <- startSimulation 100 3 100
print $show$ stats $snd result data Choice = Cooperate | Defect deriving (Eq, Show) type BattleResult = (Choice, Choice) -------------------------- TYPES -------------------------- type PlayerID = Int type Payment = Int type PlayerHist = [((Choice, Payment), (PlayerID, Choice))] data Player = Player { name :: String -- strategy name , playerID :: PlayerID , decide :: PlayerHist -> Choice , getPlayerHist :: PlayerHist } instance Show Player where show (Player n p _ o) = "Player { name: '" ++ n ++ "'" ++ ", playerID: " ++ (show p) ++ ", getPlayerHist: " ++ (show o) ++ "'}" instance Eq Player where (Player n _ _ _) == (Player n' _ _ _) = n == n' instance Eq (Int -> Player) where p1 == p2 = (p1 0) == (p2 0) instance Show (Int -> Player) where show p = show$ p 0

type Population      = [Player]

type RandList        = [Int]
type IterationResult = [Player]

-------------------------- DEFINITIONS --------------------------
payment :: BattleResult -> (Int, Int)
payment (Cooperate, Cooperate) = (3,3)
payment (Cooperate, Defect)    = (1,4)
payment (Defect, Cooperate)    = (4,1)
payment (Defect, Defect)       = (2,2)

defector :: Int -> Player
defector n = Player
"Defector"
n
(\_ -> Defect)
[]

cooperator :: Int -> Player
cooperator n = Player
"Cooperator"
n
(\_ -> Cooperate)
[]

tftDecide :: PlayerHist -> Choice
tftDecide []            = Cooperate
tftDecide ((_,(_,c)):_) = c

tft :: Int -> Player
tft n = Player
"TFT"
n
tftDecide
[]

rageDecide :: PlayerHist -> Choice
rageDecide [] = Cooperate
rageDecide l  = if (elem Defect . map getOpChoice $l) then Defect else Cooperate where getOpChoice = snd . snd rage :: Int -> Player rage n = Player "Yasha" n rageDecide [] playerTypes :: [Int -> Player] playerTypes = [defector, cooperator, tft, rage] generatePopulation :: [(Int->Player, Int)] -> Population generatePopulation = map (\(i,p) -> p i) . zip [1..] . intercalate [] . map (\(p,n) -> replicate n p) -------------------------- GAME LOGIC -------------------------- -- shuffled population iteration count runIteration :: Population -> Int -> IterationResult runIteration p i = undoPairs$ play i (makePairs p)

--      counter   shuffled list of battles
play :: Int ->    [(Player, Player)] ->    [(Player, Player)]
play 0 h        = h
play i p
| i < 0     = p
| otherwise = play (i-1) $newPlayers decisions where dec p = decide p$ getPlayerHist p
decisions  = zip p $map (bimap dec dec) p :: [((Player, Player), BattleResult)] newPlayers = map (\((p1,p2),cs@(c1,c2)) -> let (a1, a2) = payment cs in (p1{getPlayerHist = ((c1, a1),(playerID p2, c2)):(getPlayerHist p1)} ,p2{getPlayerHist = ((c2, a2),(playerID p1, c1)):(getPlayerHist p2)})) -- tournaments maxIterations initial Population for shuffling stats for tournaments with updated histories runGame :: Int -> Int -> ([[(Int->Player, Int)]], Population) -> RandList -> ([[(Int->Player, Int)]], Population) runGame _ maxIter res [] = res runGame 0 maxIter res _ = res runGame i maxIter res@(hist,ps) rs@(h:t) | i < 0 = res | otherwise = runGame (i-1) maxIter (iterStats:hist, newPopulation)$
drop (length iteration) t
where
getPayments = map (snd . fst) . getPlayerHist                                          :: Player -> [Payment]
iteration   = runIteration (shuffle rs ps) maxIter                                     :: Population
iterStats   = map (\p -> (p, sum .
map (sum . getPayments) .
filter (==(p 0)) $iteration) ) playerTypes :: [(Int->Player, Payment)] payments = sum . map snd$ iterStats                                                :: Int
newPopulationStats = map (\(p, s) -> (p, calcCount s payments (length ps))) iterStats  :: [(Int->Player, Payment)]
newPopulation      = generatePopulation newPopulationStats                             :: [Player]

startSimulation :: Int -> Int -> Int -> IO ([[(Int->Player, Int)]], Population)
startSimulation genSize tournaments iterations = do
g <- getStdGen
let gen = generatePopulation $map (\p-> (p, genSize div (length playerTypes))) playerTypes randList = randoms g putStrLn "Simulating Iterated prisoner" putStrLn$ "Population " ++ show (stats gen)
return $runGame tournaments iterations ([], gen) randList -------------------------- AUXILIARY -------------------------- shuffle :: RandList -> [a] -> [a] shuffle rands xs = let ys = take (length xs) rands in map fst$ sortBy (compare on snd) (zip xs ys)

makePairs :: [a] -> [(a,a)]
makePairs []       = []
makePairs [_]      = []
makePairs (h:h':t) = (h,h'):(makePairs t)

undoPairs :: [(a,a)] -> [a]
undoPairs [] = []
undoPairs ((a,b):t) = [a,b]++(undoPairs t)

stats :: Population -> [(String, Int)]
stats l = map (\p -> (name p, length $filter (\e->name e == name p) l))$
nubBy (\p1 p2 -> name p1 == name p2) l

-- tries to preserve the calculated amount for each player as close as possible
--           player payout       overall payout    population size
calcCount :: Int ->              Int ->            Int                -> Int
calcCount _ 0 _ = 0
calcCount _ _ 0 = 0
calcCount a g p = let a' = fromIntegral a
g' = fromIntegral g
p' = fromIntegral p
in round $a'/g'*p'  ## 1 Answer ## Design Overall I think you did a good job of separating concerns and keeping functions independent. One issue I had is that there are too many tuples instead of record types, so sometimes it's not obvious what you're dealing with, for example in getPayments = map (snd . fst) . getPlayerHist, it would be nice if instead of snd . fst it were getPayment . getFirstTuple. To do this you could replace: type PlayerHist = [((Choice, Payment), (PlayerID, Choice))]  with data FirstTuple = FirstTuple { getChoice :: Choice , getPayment :: Payment } data SecondTuple = SecondTuple { getOpponentID :: PlayerID , getOpponentChoice :: Choice } data GameResult = GameResult { getFirstTuple :: FirstTuple , getSecondTuple :: SecondTuple } type PlayerHist = [GameResult]  and ideally with more descriptive names than mine if possible. If dealing with the nested types gets too complicated you can look at using lens for simplifying this. In a couple of places you use [(Int->Player, Int)] to represent a list of players, where the second tuple item is the count of each player and the first item takes an ID and returns a player. I think you can just as easily use [Player] as your representation, and make the caller responsible for calling generatePopulation first. This would simplify some type signitures and make it easier to read, especially because it isn't immediately clear what [(Int->Player, Int)] is. ## Simplification In your generatePopulation function, you use intercalate [] . map on a list, which is equivalent to concatMap, which should be a bit simpler to understand. Notice that the types below are equivalent: Prelude Data.List> :t \f -> intercalate [] . map f \f -> intercalate [] . map f :: (a1 -> [a2]) -> [a1] -> [a2] Prelude Data.List> :t \f -> concatMap f \f -> concatMap f :: Foldable t => (a -> [b]) -> t a -> [b]  In the same function, you also use map followed by zip, with is the same thing as zipWith. Here's what I came up with for that: generatePopulation :: [(Int->Player, Int)] -> Population generatePopulation = zipWith (flip ($)) [1..] .
concatMap (\(f, count) -> replicate count f)


In shuffle , you could replace ys = take (length xs) rands with ys = zipWith const rands xs. This should do the same thing in 1 traversal instead of 2.
const is defined as const a b = a, so when you zip the two together you'll only take elements from the first list, rands. zip stops when the shorter list is exhausted so the length you'll be left with is length xs.
You can see some similar examples of this here.

• using records sounds like a good idea; i have (heard of but) never worked with lenses before; so i will definitely take a look at it now that there might be a good example for that :) Dec 15, 2019 at 17:30
• would it be considered bad design if i newtyped Int->Player (i kind of want to distinguish between the statistics list and the population; even though one could count on the user to call generatePopulation first Dec 15, 2019 at 17:31
• thanks for concatMap and showing the use of const both are awsome in that place; Dec 15, 2019 at 17:31
• You could newtype it and it might help if you can give it a meaningful name (playerWithId?). But I think it would reduce cognitive load if you can instead deal with Players as much as possible. In my eyes [Player] is much clearer than [(Int -> Player, Int)], so you can use the latter when you're generating it but I would opt to convert that to [Player] as soon as you can and pass that around to functions instead. Dec 15, 2019 at 19:21