(*************************)
(*
*)
(* preliminary functions *)
(*
*)
(*************************)
(*
*)
(* logical operations on matrices *)
(*
*)
matrixAnd[list_]:= MapThread[And, list, Depth[list]-2];
matrixOr[list_]:= MapThread[Or, list, Depth[list]-2];
logicalmatrixmult[g_,h_]:=
Map[#>0 &,
Map[If[#,1,0]&,g,{2}].Map[If[#,1,0]&,h,{2}], {2}];
logicalident:= Map[#==1&, IdentityMatrix[z], {2}];
logicalzero:= Table[False, {z},{z}];
(*
*)
(* all nonempty subsets of {1,2,..,i} *)
(*
*)
nonemptysubsets[i_]:= Table[
Flatten[Position[Reverse[IntegerDigits[j,2]],1]],{j,1,2^i-1}];
(****************************)
(*
*)
(* initialization procedure *)
(*
*)
(****************************)
initialize:= ClearAll[n, z, preferences, effective, outcomes,
activecoalitions, coalpref, dirdom, inddom, inddomident, u,
ord,
num, name, payoff];
(************************************)
(*
*)
(* main
procedure *)
(*
*)
(*
inputs:
*)
(* n, z, preferences, effective *)
(*
*)
(* returns
the lcs *)
(*
*)
(************************************)
lcs:=Block[{i},
(*
*)
(* find the coalitions which have *)
(* nonempty effectiveness relations *)
(*
*)
activecoalitions=
Select[nonemptysubsets[n],
Apply[Or,Flatten[effective[#]]]&];
(*
*)
(* define coalitional preferences *)
(*
*)
coalpref[s_]:= coalpref[s]= matrixAnd[ preferences[[s]] ];
(*
*)
(* compute direct dominance relation *)
(*
*)
dirdomproc[s_]:= matrixAnd[ {coalpref[s], effective[s]} ];
dirdom= matrixOr[ Map[dirdomproc, activecoalitions] ];
(*
*)
(* compute indirect dominance relation *)
(*
*)
inddomproc2[s_, g_]:=
matrixAnd[{logicalmatrixmult[effective[s],g], coalpref[s]}];
inddomproc1[g_]:=
matrixOr[Prepend[Map[inddomproc2[#,g]&, activecoalitions],
g]];
inddom= FixedPoint[inddomproc1,dirdom];
(*
*)
(* compute union of indirect dominance *)
(* relation and the identity relation *)
(*
*)
inddomident= matrixOr[{inddom, logicalident}];
(*
*)
(* given a set x of presumably
stable *)
(* outcomes, the deviation of coalition s *)
(* from a to d is not deterred if
the *)
(* deviation is feasible, and all outcomes *)
(* either do not indirectly dominate d *)
(*
or are preferred by s over a *)
(*
*)
unstableproc3[x_,a_,d_,s_]:= effective[s][[a,d]] &&
matrixAnd[
Map[Not[inddomident[[d,#]]] ||
coalpref[s][[a,#]]&, x]];
(*
*)
(* given a set x of presumably stable *)
(* outcomes, the deviation from a to d *)
(* will not happen if each coalition *)
(*
is deterred *)
(*
*)
stableproc2[x_,a_,d_]:=
matrixAnd[Map[Not[unstableproc3[x,a,d,#]]&,
activecoalitions]];
(*
*)
(* given a set x of presumably stable *)
(* outcomes, the outcome a is stable *)
(* if every deviation is deterred *)
(*
*)
stableproc1[x_,a_]:=
matrixAnd[ Map[stableproc2[x,a,#]&,
Table[i,{i,1,z}] ] ];
(*
*)
(* given a set x of presumably stable *)
(* outcomes, f[x] is the set
of *)
(* outcomes
which are stable *)
(*
*)
f[x_]:= Select[x, stableproc1[x, #]&];
(*
*)
(* the lcs is the largest *)
(* fixed point of f *)
(*
*)
FixedPoint[f, Table[i,{i,1,z}]]
];
(*******************************)
(*
*)
(* convenient input procedures *)
(* for general
games *)
(*
*)
(*******************************)
(*
*)
(* basic setup procedure *)
(*
*)
setup[i_,list_]:= Block[{},
n=i;
outcomes=list;
(* a list of the names of outcomes *)
z=Length[outcomes];
(* make preference and effectivness *)
(*
relations null *)
preferences= Table[False, {n},{z},{z}];
Scan[Block[{},effective[#]=Table[False,{z},{z}]]&,
nonemptysubsets[n]];
(* functions which
translate *)
(* between outcome names and numbers *)
name[exp_]:= Map[outcomes[[#]]&, exp, {-1}];
num[exp_]:= Map[Position[outcomes,#][[1,1]]&, exp,
{-1}];
];
(*
*)
(* convert utility representation *)
(* to preference
relations *)
(*
*)
u2preferences:= Block[{i,j,k},
preferences= Table[ u[name[j]][[i]] <u[name[k]][[i]],
{i,1,n},{j,1,z},{k,1,z}];
];
(*
*)
(* convert preference order representation *)
(*
to preference relations *)
(*
*)
ord2preferences:= Block[{i,j,k},
preferences= Table[
Position[ord[i],name[j]][[1,1]]<
Position[ord[i],name[k]][[1,1]],
{i,1,n},{j,1,z},{k,1,z}];
];
(*
*)
(* input: player i *)
(* prefers b to a *)
(*
*)
lt[i_][a_,b_]:= preferences[[i,num[a],num[b]]]=True;
(*
*)
(* input: coalition coal *)
(* can move from a to b *)
(*
*)
to[coal_][a_,b_]:= Block[{temp}, temp=effective[coal];
temp[[num[a],num[b]]]=True; effective[coal]=temp;];
(*
*)
(* input: coalition coal *)
(* can move from a to b *)
(* and from b to a *)
(*
*)
btwn[coal_][a_,b_]:= Block[{}, to[coal][a,b]; to[coal][b,a];];
(*
*)
(* input: coalition coal *)
(* can move from any outcome *)
(* to outcomes in list *)
(*
*)
fromanywhere[coal_, list_]:= Block[{i},
effective[coal]= Transpose[Table[ If[MemberQ[list,name[i]],
Table[True,{z}], Table[False,{z}]],
{i,1,z}]];];
(*
*)
(* input: players decide *)
(* by majority rule *)
(*
*)
majorityrule:= Scan[Block[{},
effective[#]=Table[True,{z},{z}]]&,
Select[nonemptysubsets[n],
Length[#]>Quotient[n,2]&]];
(****************************************)
(*
*)
(* strategic form game input procedures *)
(*
*)
(****************************************)
(*
*)
(* individual contingent threats: *)
(* input strategy sets and utility *)
(* profiles in lexicographic order *)
(*
*)
indivcontthreats[stratsets_,ulist_]:=
Block[{i,j,k,comp,singletoncoalitions},
n= Length[stratsets];
outcomes= Flatten[Apply[Outer,
Prepend[stratsets, List]],n-1];
z= Length[outcomes];
(* functions which
translate *)
(* between outcome names and numbers *)
name[exp_]:= Map[outcomes[[#]]&, exp,
{-1}];
num[exp_]:=
Map[Position[outcomes,#][[1,1]]&, exp, {-2}];
(* generate preference and *)
(* effectiveness relations *)
preferences= Table[
ulist[[j,i]]<ulist[[k,i]],
{i,1,n},{j,1,z},{k,1,z}];
singletoncoalitions=
Select[nonemptysubsets[n], Length[#]==1&];
Scan[Block[{},effective[#]=Table[False,{z},{z}]]&,
nonemptysubsets[n]];
Scan[Block[{},comp=Complement[Table[i,{i,1,n}],#];
effective[#]=Table[name[i][[comp]]===name[j][[comp]],
{i,1,z},{j,1,z}];]&, singletoncoalitions];
];
(*
*)
(* coalitional contingent threats: *)
(* input strategy sets and utility *)
(* profiles in lexicographic order *)
(*
*)
coalcontthreats[stratsets_,ulist_]:=
Block[{i,j,k,comp,singletoncoalitions},
n= Length[stratsets];
outcomes= Flatten[Apply[Outer,
Prepend[stratsets, List]],n-1];
z= Length[outcomes];
(* functions which
translate *)
(* between outcome names and numbers *)
name[exp_]:= Map[outcomes[[#]]&, exp,
{-1}];
num[exp_]:=
Map[Position[outcomes,#][[1,1]]&, exp, {-2}];
(* generate preference and *)
(* effectiveness relations *)
preferences= Table[
ulist[[j,i]]<ulist[[k,i]],
{i,1,n},{j,1,z},{k,1,z}];
Scan[Block[{},comp=Complement[Table[i,{i,1,n}],#];
effective[#]=Table[name[i][[comp]]===name[j][[comp]],
{i,1,z},{j,1,z}];]&, nonemptysubsets[n]];
];
(***************************************)
(*
*)
(* examples: how to use the program *)
(*
*)
(* (the same game is shown throughout) *)
(*
*)
(***************************************)
(*
*)
(* Can input n, z, preferences, effective directly *)
(*
*)
initialize;
n=3;
z=3;
preferences={
(* player 1's preference relation *)
{{False,True,True}, {False,False,True},
{False,False,False}},
(* player 2's preference relation *)
{{False,False,True}, {True,False,True},
{False,False,False}},
(* player 3's preference relation *)
{{False,True,True}, {False,False,True},
{False,False,False}}
};
(* {1,2}'s effectiveness relation *)
effective[{1,2}]=
{{False,True,False}, {True,False,False},
{False,False,False}};
(* {3}'s effectiveness relation *)
effective[{3}]=
{{False,False,False}, {False,False,True},
{False,True,False}};
(* other coalitions can't do anything *)
effective[{1}]=
{{False,False,False}, {False,False,False},
{False,False,False}};
effective[{2}]=
{{False,False,False}, {False,False,False},
{False,False,False}};
effective[{1,3}]=
{{False,False,False}, {False,False,False},
{False,False,False}};
effective[{2,3}]=
{{False,False,False}, {False,False,False},
{False,False,False}};
lcs
{3}
(*
*)
(* It's easier to use convenient *)
(* input
procedures *)
(*
*)
initialize;
setup[3,{a,b,c}];
a~lt[1]~b; b~lt[1]~c; a~lt[1]~c; (* specify preference
relations *)
b~lt[2]~a; b~lt[2]~c; a~lt[2]~c;
a~lt[3]~b; b~lt[3]~c; a~lt[3]~c;
a~btwn[{1,2}]~b;
(* specify effectiveness relations *)
b~btwn[{3}]~c;
lcs
{3}
(*
*)
(* Can specify preferences using utility profiles *)
(*
*)
initialize;
setup[3,{a,b,c}];
u[a]={1,1,2}; (*
utility profiles for each of the outcomes *)
u[b]={2,0,0};
u[c]={3,2,1};
u2preferences; (* convert utility representation
to preferences *)
a~btwn[{1,2}]~b;
b~btwn[{3}]~c;
name[lcs] (* output names, not numbers, of
outcomes in the lcs *)
{c}
(*
*)
(* Can specify preferences using *)
(* linear preference ordering *)
(*
*)
initialize;
setup[3,{a,b,c}];
ord[1]={a,b,c};
(* each player's preference ordering *)
ord[2]={b,a,c};
ord[3]={a,b,c};
ord2preferences; (* convert order representation
to preferences *)
a~btwn[{1,2}]~b;
b~btwn[{3}]~c;
name[lcs]
{c}
(********************************)
(*
*)
(* examples in the dissertation *)
(*
*)
(********************************)
(*
*)
(* Example in "How to compute the
LCS
*)
(* when the number of outcomes is finite", page 14 *)
initialize;
setup[2,{a,b,c,d}];
ord[1]={a,b,c,d}; ord[2]={d,a,b,c};
ord2preferences;
a~to[{1}]~b; b~to[{2}]~c; c~to[{1}]~d; d~to[{2}]~a; a~to[{1,2}]~c;
name[lcs]
{c}
(*
*)
(* Condorcet "paradox", page 16 *)
initialize;
setup[3,{a,b,c}];
ord[1]={a,b,c}; ord[2]={c,a,b}; ord[3]={b,c,a};
ord2preferences;
a~to[{1,2}]~b; b~to[{1,3}]~c; c~to[{2,3}]~a;
name[lcs]
{a, b, c}
(*
*)
(* The LCS versus the stable set, pages 16--17 *)
initialize;
setup[2,{a,b,c}];
ord[1]={a,c,b}; ord[2]={a,b,c};
ord2preferences;
a~to[{1}]~b; b~to[{2}]~c;
name[lcs]
{c}
initialize;
setup[2,{a,b,c}];
ord[1]={c,a,b}; ord[2]={a,b,c};
ord2preferences;
a~to[{1}]~b; b~to[{2}]~c;
name[lcs]
{a, c}
(*
*)
(* Figure 2. The stable set is arbitrary, page 19 *)
initialize;
setup[3,{123, 231, 312, 124, 210, 120, 211}];
u[123]={1,2,3}; u[231]={2,3,1}; u[312]={3,1,2};
u[124]={1,2,4}; u[210]={2,1,0}; u[120]={1,2,0}; u[211]={2,1,1};
u2preferences;
123~to[{1,2}]~231; 231~to[{1,3}]~312; 312~to[{2,3}]~123;
312~to[{3}]~124; 124~to[{1}]~210; 210~to[{2}]~120;
120~to[{1}]~211; 211~to[{2}]~124;
name[lcs]
{123, 231, 312, 124, 210, 120, 211}
(*
*)
(* Figure 3. The LCS predicts one of the *)
(* three Nash equilibria, page
21 *)
initialize;
setup[4,{"(1a,2a,3a,4a)", "(1b,2b,3a,4a)", "(1a,2a,3b,4b)"}];
u["(1a,2a,3a,4a)"]={3,3,1,1};
u["(1b,2b,3a,4a)"]={2,2,3,3};
u["(1a,2a,3b,4b)"]={1,1,2,2};
u2preferences;
"(1a,2a,3a,4a)"~btwn[{1,2}]~"(1b,2b,3a,4a)";
"(1b,2b,3a,4a)"~btwn[{1,2,3,4}]~"(1a,2a,3b,4b)";
"(1a,2a,3b,4b)"~btwn[{3,4}]~"(1a,2a,3a,4a)";
name[lcs]
{(1b,2b,3a,4a)}
(*
*)
(* Figure 4. No stable set exists
but *)
(* the LCS predicts a unique outcome, page 23 *)
initialize;
indivcontthreats[{{"1a","1b","1c"},{"2a","2b"},{"3a","3b"}},
{{1,1,4},
{0,7,1},
{0,0,0},
{6,6,5},
(* *)
{2,2,6},
{0,0,0},
{3,3,7},
{0,0,0},
(* *)
{0,0,0},
{0,0,0},
{4,4,2},
{5,5,3}}
];
(* put utility profiles in lexicographic order:
u(1a,2a,3a), u(1a,2a,3b), u(1a,2b,3a), u(1a,2b,3b),
u(1b,2a,3a), u(1b,2a,3b), etc. *)
name[lcs]
{{1a, 2b, 3b}}
(*
*)
(* Figure 5. The stable set is misleading, page 23 *)
initialize;
indivcontthreats[{{"1a","1b"},{"2a","2b"}},
{{3,3}, {2,2},
{0,0}, {1,1}}
];
name[lcs]
{{1a, 2a}}
(*
*)
(* The Prisoners' Dilemma, page 24 *)
initialize;
indivcontthreats[{{"Cooperate","Defect"},{"Cooperate","Defect"}},
{{3,3}, {0,4},
{4,0}, {1,1}}
];
name[lcs]
{{Cooperate, Cooperate}, {Defect, Defect}}
(*
*)
(* Figure 6. Strict, not all, Nash equilibria *)
(* are contained in the LCS, page
25 *)
initialize;
indivcontthreats[{{"1a","1b","1c"},{"2a","2b","2c"}},
{{1,1}, {0,0}, {0,0},
{1,1}, {2,2}, {0,0},
{0,0}, {0,0}, {3,3}}
];
name[lcs]
{{1b, 2b}, {1c, 2c}}
(*
*)
(* Figure 7. The LCS makes the sharpest prediction, page 26 *)
initialize;
indivcontthreats[{{"1a","1b"},{"2a","2b","2c"}},
{{3,3}, {0,0}, {0,4},
{5,0}, {4,2}, {0,0}}
];
name[lcs]
{{1b, 2b}}
(*
*)
(* Figure 8. The LCS is the only *)
(* nonempty solution concept, page 27 *)
initialize;
coalcontthreats[{{"1a","1b"},{"2a","2b"},{"3a","3b"}},
{{1,2,3},
{4,0,4},
{0,0,0},
{3,1,2},
(* *)
{0,4,4},
{0,0,0},
{2,3,1},
{4,4,0}}
];
name[lcs]
{{1a, 2a, 3a}, {1a, 2b, 3b}, {1b, 2b, 3a}}
(*
*)
(* Figure 9. The LCS and strong Nash equilibrium differ, page 27
*)
initialize;
coalcontthreats[{{"1a","1b"},{"2a","2b"},{"3a","3b"}},
{{2,2,4},
{5,5,3},
{0,2,0},
{0,2,0},
(* *)
{0,0,0},
{0,0,0},
{1,4,1},
{3,3,0}}
];
name[lcs]
{{1a, 2a, 3b}}
(*
*)
(* Figure 10. An outcome in the LCS is Pareto dominated *)
(* by another outcome in the LCS, page
28
*)
initialize;
coalcontthreats[{{"1a","1b","1c"},{"2a","2b","2c"}},
{{2,4}, {0,0}, {0,0},
{0,0}, {3,5}, {1,7},
{0,0}, {7,1}, {5,3}}
];
name[lcs]
{{1a, 2a}, {1b, 2b}, {1b, 2c}, {1c, 2b}, {1c, 2c}}
(*
*)
(* The Prisoners' Dilemma, page 28 *)
initialize;
coalcontthreats[{{"Cooperate","Defect"},{"Cooperate","Defect"}},
{{3,3}, {0,4},
{4,0}, {1,1}}
];
name[lcs]
{{Cooperate, Cooperate}}
(*
*)
(* Figure 11. The LCS in the coalitional contingent threats *)
(* situation is not a subset of the LCS in the
individual *)
(* contingent threats situation, page
29
*)
initialize;
indivcontthreats[{{"1a","1b"},{"2a","2b"},{"3a","3b"}},
{{3,3,2},
{1,1,0},
{0,4,3},
{0,0,0},
(* *)
{4,0,3},
{0,0,0},
{1,1,4},
{2,2,3}}
];
name[lcs]
{{1a, 2a, 3a}, {1b, 2b, 3a}}
initialize;
coalcontthreats[{{"1a","1b"},{"2a","2b"},{"3a","3b"}},
{{3,3,2},
{1,1,0},
{0,4,3},
{0,0,0},
(* *)
{4,0,3},
{0,0,0},
{1,1,4},
{2,2,3}}
];
name[lcs]
{{1a, 2a, 3a}, {1b, 2b, 3b}}
(*
*)
(* First example of majority rule voting, page 39 *)
initialize;
setup[3, {134, 341, 413, 222}];
u[134]={1,3,4}; u[341]={3,4,1}; u[413]={4,1,3}; u[222]={2,2,2};
u2preferences;
majorityrule;
name[lcs]
{134, 341, 413, 222}
(*
*)
(* Second example of majority rule voting, page 40 *)
initialize;
setup[3, {134, 423, 541, 252, 315}];
u[134]={1,3,4}; u[423]={4,2,3}; u[541]={5,4,1};
u[252]={2,5,2}; u[315]={3,1,5};
u2preferences;
majorityrule;
name[lcs]
{423, 541, 252}
(*
*)
(* Comparative statics examples: player 1 is the kidnapper, *)
(* player 2 the relative, player 3 the detective,
and *)
(* player 4 the judge, page
41
*)
initialize;
setup[4, {a,b,c,d}];
ord[1]={d,b,a,c};
ord[2]={b,c,a,d};
ord[3]={b,c,a,d};
ord[4]={b,c,d,a};
ord2preferences;
a~to[{1}]~b; b~to[{2}]~c; c~to[{3}]~d; d~to[{4}]~a;
name[lcs]
{a}
initialize;
setup[4, {a,b,c,d}];
ord[1]={d,b,a,c};
ord[2]={b,c,a,d};
ord[3]={b,c,a,d};
ord[4]={b,c,d,a};
ord2preferences;
a~to[{1}]~b; b~to[{2}]~c; d~to[{4}]~a;
name[lcs]
{c, d}
initialize;
setup[4, {a,b,c,d}];
ord[1]={d,b,a,c};
ord[2]={b,c,a,d};
ord[3]={b,c,a,d};
ord[4]={b,c,d,a};
ord2preferences;
a~to[{1}]~b; d~to[{4}]~a;
name[lcs]
{a, b, c}
(*
*)
(* Refinements and extensions examples, pages 44--45 *)
initialize;
setup[1, {a,b,c}];
ord[1]={a,b,c};
ord2preferences;
a~to[{1}]~b; a~to[{1}]~c;
name[lcs]
{b, c}
initialize;
setup[2, {a,b,c}];
ord[1]={c,a,b};
ord[2]={a,b,c};
ord2preferences;
a~to[{1,2}]~b; a~to[{2}]~c;
name[lcs]
{b, c}
initialize;
setup[2, {a,b,c}];
ord[1]={a,b,c};
ord[2]={a,b,c};
ord2preferences;
a~to[{1}]~b; a~to[{2}]~c;
name[lcs]
{b, c}
initialize;
setup[2, {a,b,c}];
ord[1]={a,c,b};
ord[2]={b,c,a};
ord2preferences;
a~to[{1}]~b; a~to[{2}]~c;
name[lcs]
{b, c}
(*
*)
(* Isaac and Plott's paper *)
(*
*)
(*
*)
initialize;
setup[3,{a,b,c,d,e,f,g,h,i,j}];
ord[1]={f,e,i,d,c,h,a,j,g,b};
(* each player's preference ordering *)
ord[2]={b,j,a,g,c,h,d,i,e,f};
ord[3]={c,a,g,b,i,d,j,h,f,e};
ord2preferences; (* convert order representation
to preferences *)
fromanywhere[{1}, {d}];
fromanywhere[{2,3}, {d}];
fromanywhere[{1,2}, {a,b,c,d,e,f,g,h,i,j}];
fromanywhere[{1,3}, {a,b,c,d,e,f,g,h,i,j}];
fromanywhere[{1,2,3}, {a,b,c,d,e,f,g,h,i,j}];
name[lcs]
{a, g, h, j}
inddom[[num[d]]]
{False, False, False, False, False, False, False, True, False,
True}
inddom[[num[j]]]
{False, False, False, False, False, False, True, True, False,
False}
TableForm[inddom[[num[{a,g,h,j}],num[{a,g,h,j}]]]]
False True True
False
False False True False
False False False True
False True True
False
initialize;
setup[3,{a,b,c,d,e,f,g,h,i,j}];
ord[1]={f,e,i,d,c,h,a,j,g,b};
(* each player's preference ordering *)
ord[2]={b,j,a,g,c,h,d,i,e,f};
ord[3]={c,a,g,b,i,d,j,h,f,e};
ord2preferences; (* convert order representation
to preferences *)
majorityrule;
name[lcs]
{e}
(*
*)
(* McKelvey and Ordeshook, Public Choice 1983 *)
(*
*)
(*
*)
(* Game F1 *)
initialize;
setup[5,{a,b,c,d,e,f,g,h,i,j,k,l,m,n,o}];
ord[1]={e,l,{a,c},b,{d,m},{g,o,h},k,i,f,j,n};
ord[2]={a,{l,n},{h,c},{g,b},{k,d},i,{e,f},m,o,j};
ord[3]={o,{l,n},{e,c},g,{k,m,d,j},i,{a,f},h,b};
ord[4]={h,{n,j},{f,c},{k,b},i,m,{a,g,o},d,e,l};
ord[5]={{f,i},{l,n,j},{o,c},m,d,k,{e,g,h},a,b};
ord2preferences;
majorityrule;
name[lcs]
{a, b, d, e, f, g, h, i, j, k, m, o}
(* Game *F1A *)
initialize;
setup[5,{a,b,c,d,e,f,g,h,i,j,k,l,m,n,o}];
ord[1]={e,l,{a,c},b,{d,m},{o,h},k,i,g,f,j,n};
ord[2]={a,{l,n},{h,c},{g,b},{k,d},i,{e,f},m,o,j};
ord[3]={o,{l,n},{e,c},g,{k,m,d,j},i,{a,f},h,b};
ord[4]={h,{n,j},{f,c},{k,b},i,m,{a,o},d,g,e,l};
ord[5]={{f,i},{l,n,j},{o,c},m,d,k,{e,h},g,a,b};
ord2preferences;
majorityrule;
name[lcs]
{a, b, d, e, f, g, i, j, k, m, o}