Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Consider a game of a function $v$ which has

\begin{align} v(1) & \geq 1\\ v(2) & \geq 0\\ v(3) & \geq 1\\ v(1,2) &\geq 4\\ v(1,3) &\geq 3\\ v(2,3) &\geq 5\\ v(1,2,3) &=8 \end{align}

How can I plot such a function in Mathematica (preferably in 2D). Should one use RegionPlotor Graphics?

The core plotted

share|improve this question
4  
What is a coalition game? Can you explain how you would make the plot by hand? Someone might come along who knows about coalition games, but it would open up the question to a wider audience. –  Pickett Jun 6 at 17:16
add comment

1 Answer 1

up vote 4 down vote accepted

I do not have a good command of the techniques needed to achieve the final transformations but I do understand the problem and can at least get part of the way there. Hopefully one of the whizzes will carry it the rest of the way :)

A coalition game is a model in game theory where one evaluates how well teams of players do. Each player must decide: compete or cooperate. Since there are three players here, each player has multiple choices. This model is less concerned with individual payouts, and more with understanding what configurations are possible assuming the players maximize their positions rationally. A team could be any of these:

players = {x1, x2, x3};
Subsets[players]

{{}, {x1}, {x2}, {x3}, {x1, x2}, {x1, x3}, {x2, x3}, {x1, x2, x3}}

(The empty team is sometimes formally relevant.) Everyone must play, which means that at the end of the game each player receives a payout. (The payout could be nothing.) The purpose of this chart is to describe the space of payouts ("imputations") to {x1, x2, x3}. This task is defined by the characteristic function v, which establishes the parameters of the game in the form of "guarantees". So, v( {1} ) >= 1 means that if x1 plays by himself, he is ensured to receive at least one unit of value, say 1. We see the same constructs for the other two players, and we also see other guarantees: v( {1, 2} ) >= 4 means that x1 and x2 are guaranteed to receive 4 between them if they cooperate, and so forth. The v( {1, 2, 3} ) = 8 means a total of $8 is available if everyone holds hands and joins the "grand coalition". So the possible configurations are:

configurations = 
 DeleteCases[
  ReplaceList[players, {a___, b___, c___} -> {{a}, {b}, {c}}], {}, 2]

{{{x1, x2, x3}}, {{x1}, {x2, x3}}, {{x1, x2}, {x3}}, {{x1, x2, x3}}, {{x1}, {x2, x3}}, {{x1}, {x2}, {x3}}, {{x1}, {x2, x3}}, {{x1, x2}, {x3}}, {{x1, x2}, {x3}}, {{x1, x2, x3}}}

And our characteristic function is:

v = {{x1} -> 1, {x2} -> 0, {x3} -> 1, {x1, x2} -> 4, {x1, x3} -> 
3, {x2, x3} -> 5, {x1, x2, x3} -> 8};

Meaning the configurations imply these guaranteed payouts:

MapThread[Rule, {configurations, configurations /. v}]

{{{x1, x2, x3}} -> {8}, {{x1}, {x2, x3}} -> {1, 5}, {{x1, x2}, {x3}} -> {4, 1}, {{x1, x2, x3}} -> {8}, {{x1}, {x2, x3}} -> {1, 5}, {{x1}, {x2}, {x3}} -> {1, 0, 1}, {{x1}, {x2, x3}} -> {1, 5}, {{x1, x2}, {x3}} -> {4, 1}, {{x1, x2}, {x3}} -> {4, 1}, {{x1, x2, x3}} -> {8}}

Everything else is up in the air, but we can anticipate some of the participants' decisions. By eliminating parts of the payout space that are "unstable" we are left with the "core", the set of "stable" imputations. Instability "through" a coalition means that, if a particular imputation were to be proposed, there would be an incentive for some players to reject it and instead form the coalition in question, which would upset the bargaining power and destroy that proposal. The set of all imputations is:

imputations =
  Solve[
    And[
     x1 + x2 + x3 == 8,
     x1 >= 1,
     x2 >= 0,
     x3 >= 1],
    {x1, x2, x3},
    Integers][[All, All, 2]];

This is indeed a plane:

Point@imputations // Graphics3D

enter image description here

The unstable imputations are:

unstableThrough = Map[
   Select[imputations, #] &,
   unstableRules = {#[[1]] + #[[2]] < 4 &,
     #[[1]] + #[[3]] < 3 &,
     #[[2]] + #[[3]] < 5 &}];
unstableThrough // Column

{{{1, 0, 7}, {1, 1, 6}, {1, 2, 5}, {2, 0, 6}, {2, 1, 5}, {3, 0, 5}},

{{1, 6, 1}},

{{4, 0, 4}, {4, 1, 3}, {4, 2, 2}, {4, 3, 1}, {5, 0, 3}, {5, 1, 2}, {5, 2, 1}, {6, 0, 2}, {6, 1, 1}, {7, 0, 1}}}

dimensions--

colored = {PointSize@Large, Map[Point, unstableThrough, {2}], Red, 
   Point@(stable = 
      Complement[imputations, Flatten[unstableThrough, 1]])};
colored /. l : {__Integer} :> Take[l, 2] // Graphics

enter image description here

So we can now do whatever we want stylistically with the unstable sections:

stable2d = stable[[All, ;; 2]];
stablech = (ch = Part[#, ConvexHull@#] &)@stable2d
unstablech = 
  ch /@ MapThread[
     Join, {unstableThrough, 
      Select[stable, #] & /@ (unstableRules /. Less -> Equal)}][[All, 
     All, ;; 2]];
imputationsch = ch@imputations[[All, ;; 2]];
(*rt=RotationTransform[Pi/2]; I couldn't manage to get all of this to \
rotate in one piece *)
Graphics[{
  Black,
  imputationsch // Polygon,
  Red,
  stablech // Polygon,
  Inner[
   List,
   {Orange, Blue, Green},
   Polygon /@ unstablech,
   List]
  }]

enter image description here

These points just need to be rotated by Pi/2 and transformed into an equilateral triangle but I can't seem to get that working. Then you can pretty it up.

Let's try Invoke[@MrWizard].

share|improve this answer
1  
Nice! -- one way to transform to the simplex is here. –  kguler Jun 7 at 7:14
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.