-- Accompanying Haskell code for paper: -- -- Title: Selection Equilibria of Higher-Order Games -- Authors: Jules Hedges -- Paulo Oliva -- Evguenia Shprits -- Viktor Winschel -- Philipp Zahn -- -- Tested on GHC 7.10 -- Submitted to PADL 2017 import Prelude hiding (max) import Data.List (nub, maximumBy) -- List the elements of an enum -- We assume that x is finite, so this list is finite elements :: (Enum x) => [x] elements = enumFrom (toEnum 0) -- Quantifiers and selection functions -- The returned lists must be nonempty and finite type Q r x = (x -> r) -> [r] type S r x = (x -> r) -> [x] -- Higher-order games -- Invariant: If (n, es, q) is a game, then es has length n, and q xs is meaningful only when xs has length n. type Game r x = (Int, [S r x], [x] -> r) -- Enumeration of all possible strategies with n players -- (sequence is n-fold cartesian product for the list monad) strategies :: (Enum x) => Int -> [[x]] strategies n = sequence (replicate n elements) -- Examples of quantifiers and selection functions max :: (Enum x) => (r -> r -> Ordering) -> Q r x max order p = [maximumBy order (map p elements)] argmax :: (Enum x, Eq r) => (r -> r -> Ordering) -> S r x argmax order p = [x | x <- elements, p x == maximum] where maximum = maximumBy order (map p elements) fix :: (Eq x, Enum x) => S x x fix p = if null fixpoints then elements else fixpoints where fixpoints = [x | x <- elements, x == p x] -- Overline operators overlineS :: (Eq r) => S r x -> Q r x overlineS e p = nub [p x | x <- e p] overlineQ :: (Enum x, Eq r) => Q r x -> S r x overlineQ phi p = [x | x <- elements, p x `elem` phi p] -- Unilateral maps unilateral :: Int -> ([x] -> r) -> [x] -> x -> r unilateral i q xs x' = q [xs' j | j <- [0 .. n-1]] where xs' j | (j == i) = x' | (otherwise) = xs!!j n = length xs -- Testing deviation of individual players deviatesQ :: (Eq r) => Game r x -> [x] -> Int -> Bool deviatesQ (_, es, q) xs i = not (q xs `elem` overlineS (es!!i) (unilateral i q xs)) deviatesS :: (Eq x) => Game r x -> [x] -> Int -> Bool deviatesS (_, es, q) xs i = not (xs!!i `elem` (es!!i) (unilateral i q xs)) -- Equilibrium testing -- Return either Right () indicating equilibrium, or a nonempty list of players who prefer to deviate equilibriumQ :: (Eq r) => Game r x -> [x] -> Either [Int] () equilibriumQ g@(n, _, _) xs = if null deviates then Right () else Left deviates where deviates = [i | i <- [0 .. n-1], deviatesQ g xs i] equilibriumS :: (Eq x) => Game r x -> [x] -> Either [Int] () equilibriumS g@(n, _, _) xs = if null deviates then Right () else Left deviates where deviates = [i | i <- [0 .. n-1], deviatesS g xs i] -- The voting game data X = A | B deriving (Eq, Ord, Enum, Show) maj :: [X] -> X maj [A,A,_] = A maj [A,_,A] = A maj [_,A,A] = A maj [_,_,_] = B -- Orderings with A > B, B > A respectively order1, order2 :: X -> X -> Ordering order1 = flip compare order2 = compare -- Two examples from selection 3.1 game1, game2 :: Game X X game1 = (3, [argmax order1, argmax order1, argmax order2], maj) game2 = (3, [argmax order1, fix, fix], maj) -- Coordination game game3 :: Game X X game3 = (3, [fix, fix, fix], maj) {- Example usage, to verify tables from the paper: 1. Calculating deviating players in game1 with respect to quantifier equilibrium, for each of the 9 possible strategies Rigth () indicates an equilibrium, i.e. no players wish to deviate We can see that there are three equilibrium strategies, namely [A,A,A], [A,A,B] and [B,B,B] *Games Games> mapM_ print \$ (zip ((strategies 3) :: [[X]]) \$ map (equilibriumQ game1) (strategies 3)) ([A,A,A],Right ()) ([A,A,B],Right ()) ([A,B,A],Left [2]) ([A,B,B],Left [1]) ([B,A,A],Left [2]) ([B,A,B],Left [0]) ([B,B,A],Left [0,1]) ([B,B,B],Right ()) 2. Calculating deviating player in game2 with respect to selection equilibrium. In this case there are four equilibrium strategy profiles. *Games Games> mapM_ print \$ (zip ((strategies 3) :: [[X]]) \$ map (equilibriumS game2) (strategies 3)) ([A,A,A],Right ()) ([A,A,B],Left [2]) ([A,B,A],Left [1]) ([A,B,B],Right ()) ([B,A,A],Right ()) ([B,A,B],Left [0,1]) ([B,B,A],Left [0,2]) ([B,B,B],Right ()) 3. In the full coordination game3 one can see that there are only two selection equilibrium, but all 9 strategies are in quantifier equilibrium. *Games Games> mapM_ print \$ (zip ((strategies 3) :: [[X]]) \$ map (equilibriumS game3) (strategies 3)) ([A,A,A],Right ()) ([A,A,B],Left [2]) ([A,B,A],Left [1]) ([A,B,B],Left [0]) ([B,A,A],Left [0]) ([B,A,B],Left [1]) ([B,B,A],Left [2]) ([B,B,B],Right ()) *Games Games> mapM_ print \$ (zip ((strategies 3) :: [[X]]) \$ map (equilibriumQ game3) (strategies 3)) ([A,A,A],Right ()) ([A,A,B],Right ()) ([A,B,A],Right ()) ([A,B,B],Right ()) ([B,A,A],Right ()) ([B,A,B],Right ()) ([B,B,A],Right ()) ([B,B,B],Right ()) -}