Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: Mathematica gets stuck, only thing I can do is quit kernel

• To: mathgroup at smc.vnet.net
• Subject: [mg106815] Re: Mathematica gets stuck, only thing I can do is quit kernel
• From: Matthias <greiff at mac.com>
• Date: Sun, 24 Jan 2010 05:40:30 -0500 (EST)
• References: <hjbv47$2ko$1@smc.vnet.net> <hjeq43$fkk$1@smc.vnet.net>

Hi,

thanks for the reply.

Here is the code of my model. I tried to reduce it. With these
settings for parameter and seed value the model stops after 25
iterations. If I change seed to SeedRandom[9173] it stops after 61
iterations but with SeedRandom[1] it somehow works.

It would be a great help for me if you could copy the code into your
Mathematica and see if it is the same problem on your machine. I'd
really appreciate it.

Cheers,

Matthias
_____________________________

(* parameters *)
n = 100;
c = 1;
h = 0.1;
rewardsize = 0.7;
nrofrewards = 2;
discount = 0.1;
alpha = .9;
prob = .1;

(* functions *)
setup := {
  contributionsovertime = {};
  agents =
   Table[{i, RandomChoice[{{0, 0}, {1, 1}, {1, 0}}],
     RandomReal[]}, {i, n}];
  wmatrix = Table[1, {n}, {n}];
  Do[wmatrix[[j, j]] = 0;, {j, n}];
  }

pmatrix := N[Table[wmatrix[[i]]/Total[wmatrix[[i]]], {i, n}]]

contribute[{id_, {0, s2_}, a_}] := {};

contribute[{id_, {1, s2_}, a_}] := {payoffs[[id]] -= c;
   contributions[[id]] += a;};

reward[{id_, {s1_, 0}, a_}] := {};

reward[{id_, {s1_, 1}, a_}] :=
 Module[{choiceweights, nrofrewardsgiven, whomtoreward},
  nrofrewardsgiven =
   Min[Length[Cases[Ceiling[contributions], Except[0]]],
    nrofrewards];
  choiceweights = pmatrix[[id]] Ceiling[contributions];
  If[Max[choiceweights] > 0,
   whomtoreward =
    RandomSample[choiceweights -> Range[n], nrofrewardsgiven];
   Do[
    wmatrix[[whomtoreward[[i]], id]] += rewardsize;
    payoffs[[whomtoreward[[i]]]] += rewardsize;
    payoffs[[id]] -= h;
    , {i, nrofrewardsgiven}];];
   ]

globalimitation[{id_, ___}] :=
 Module[{best =
    RandomChoice[Flatten[Position[payoffs, Max[payoffs]]]]},
  If[RandomReal[] > prob,
   If[Max[payoffs] > payoffs[[id]],
     agents[[id, 2]] = agents[[best, 2]];];,
   agents[[id, 2]] = RandomChoice[{{0, 0}, {1, 0}, {1, 1}}];]
  ]

run := {
  contributions = Table[0, {n}];
  payoffs = Table[0, {n}];
  contribute /@ agents;
  shuffledagents = RandomSample[agents];
  reward /@ shuffledagents;
  AppendTo[contributionsovertime, Total[Ceiling[contributions]]];
  Do[
   If[RandomReal[] <= alpha, globalimitation[agents[[i]]];];
   , {i, n}];
  wmatrix *= (1 - discount);
  }

(* running the model *)
Dynamic[t]
SeedRandom[91733]
setup;
t = 0;
Do[run; t++;, {100}];