Re: Re: Mathematica gets stuck,
- To: mathgroup at smc.vnet.net
- Subject: [mg106864] Re: [mg106815] Re: Mathematica gets stuck,
- From: danl at wolfram.com
- Date: Mon, 25 Jan 2010 05:08:12 -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 It is almost certainly the same bug I mentioned in reply to an earflier report by yourself of a bug in RandomSample. http://forums.wolfram.com/mathgroup/archive/2009/Dec/msg00615.html If you get rid of Dynamic and instead use Print in your Do loop for the run, you will see it is the 27th iteration (when using that particular random seed value). I suspect the dynamic value cannot be refreshed at that point because RandomSample is in some ghastly uninteruptible loop. But I do not know enough about Dynamic internals to be certain that is the reason. I did fix this uninterruptible infinite loop in RandomSample for a future release (both that it is will be interruptible, and also not infinite). I'll check tomorrow whether what I think was a fix does in fact make this example run better. Daniel Lichtblau Wolfram Research > _____________________________ > > (* 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}]; > >