MathGroup Archive 2010

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

Search the Archive

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}];
>
>




  • Prev by Date: Re: Re: looping
  • Next by Date: Re: Re: looping
  • Previous by thread: Re: Re: Mathematica gets stuck,
  • Next by thread: ElementData[] Problems