PercentileBarChart

• To: mathgroup at smc.vnet.net
• Subject: [mg18883] PercentileBarChart
• From: kkfung at my-deja.com
• Date: Sun, 25 Jul 1999 03:30:15 -0400
• Organization: Deja.com - Share what you know. Learn what you don't.
• Sender: owner-wri-mathgroup at wolfram.com

```I use a Pentium II PC with Mathematica 3.0 installed.

I have a Mathematica program that displays the evaluation in the form of
a PercentileBarChart.  I have not been able (except once) to generate
the PercentileBarChart even though the program codes are error free. I
have tried to run the program without any success on many different PC's
with Mathematica 3.0 installed.

What else could I do?

My program codes are as follows:

charlesBarkley[n_, p_, s_, m_, t_] :=
Module[{society, RND, exchange, walk, vonNeumann, GN},

RND := Random[Integer, {1, 4}];
society = Table[Floor[p + Random[]], {n}, {n}] /. 1
\[RuleDelayed]
{RND, Random[], Table[Random[Integer, {1, m}], {s}]};

exchange[{1, a_, u_}, {3, b_, v_}, _, _, _] :=
{1, a, ReplacePart[u, v[[#]], #]&[
Random[Integer, {1, s}]]} /; a < b;
exchange[{2, a_, u_}, _, {4, b_, v_}, _, _] :=
{2, a, ReplacePart[u, v[[#]], #]&[
Random[Integer, {1, s}]]} /; a < b;
exchange[{3, a_, u_}, _, _, {1, b_, v_}, _] :=
{3, a, ReplacePart[u, v[[#]], #]&[
Random[Integer, {1, s}]]} /; a < b;
exchange[{4, a_, u_}, _, _, _, {2, b_, v_}] :=
{4, a, ReplacePart[u, v[[#]], #]&[
Random[Integer, {1, s}]]} /; a < b;
exchange[z_, _, _, _, _] := z;

walk[{1,a___},0,_,_,_,{4,___},_,_,_,_,_,_,_] := {RND,a};
walk[{1,a___},0,_,_,_,_,_,_,{2,___},_,_,_,_] := {RND,a};
walk[{1,a___},0,_,_,_,_,_,_,_,{3,___},_,_,_] := {RND,a};
walk[{1,a___},0,_,_,_,_,_,_,_,_,_,_,_] := 0;
walk[{2,a___},_,0,_,_,{3,___},_,_,_,_,_,_,_] := {RND,a};
walk[{2,a___},_,0,_,_,_,{1,___},_,_,_,_,_,_] := {RND,a};
walk[{2,a___},_,0,_,_,_,_,_,_,_,{4,___},_,_] := {RND,a};
walk[{2,a___},_,0,_,_,_,_,_,_,_,_,_,_] := 0;
walk[{3,a___},_,_,0,_,_,{4,___},_,_,_,_,_,_] := {RND,a};
walk[{3,a___},_,_,0,_,_,_,{2,___},_,_,_,_,_] := {RND,a};
walk[{3,a___},_,_,0,_,_,_,_,_,_,_,{1,___},_] := {RND,a};
walk[{3,a___},_,_,0,_,_,_,_,_,_,_,_,_] := 0;
walk[{4,a___},_,_,_,0,_,_,{1,___},_,_,_,_,_] := {RND,a};
walk[{4,a___},_,_,_,0,_,_,_,{3,___},_,_,_,_] := {RND,a};
walk[{4,a___},_,_,_,0,_,_,_,_,_,_,_,{2,___}] := {RND,a};
walk[{4,a___},_,_,_,0,_,_,_,_,_,_,_,_] := 0;
walk[{_,a___},_,_,_,_,_,_,_,_,_,_,_,_] := {RND,a};
walk[0,{3,___},{4,___},_,_,_,_,_,_,_,_,_,_] := 0;
walk[0,{3,___},_,{1,___},_,_,_,_,_,_,_,_,_] := 0;
walk[0,{3,___},_,_,{2,___},_,_,_,_,_,_,_,_] := 0;
walk[0,_,{4,___},{1,___},_,_,_,_,_,_,_,_,_] := 0;
walk[0,_,{4,___},_,{2,___},_,_,_,_,_,_,_,_] := 0;
walk[0,_,_,{1,___},{2,___},_,_,_,_,_,_,_,_] := 0;
walk[0,{3,a___},_,_,_,_,_,_,_,_,_,_,_] := {RND,a};
walk[0,_,{4,a___},_,_,_,_,_,_,_,_,_,_] := {RND,a};
walk[0,_,_,{1,a___},_,_,_,_,_,_,_,_,_] := {RND,a};
walk[0,_,_,_,{2,a___},_,_,_,_,_,_,_,_] := {RND,a};
walk[0,_,_,_,_,_,_,_,_,_,_,_,_] := 0;

vonNeumann[func_, lat_] :=
{{0, 0}, {1, 0}, {0, -1}, {-1, 0}, {0, 1}}], 2];

GN[func_, lat_] :=
{{0, 0}, {1, 0}, {0, -1}, {-1, 0}, {0, 1},
{1, -1}, {-1, -1}, {-1, 1}, {1, 1}, {2, 0},
{0, -2}, {-2, 0}, {0, 2}}], 2];

NestList[GN[walk, vonNeumann[exchange, #]]&, society, t]]

SeedRandom[7]
results = charlesBarkley[5, 0.7, 2, 2, 500];
<<Graphics`;
countCultures[lat_] := Map[Count[lat, {_, _, #}, 2]&,
{{1, 1}, {1, 2}, {2, 1}, {2, 2}}];
counts[res_] := Map[countCultures, res[[Range[1, 500, 25]]]];
Apply[PercentileBarChart, Transpose[counts[results]]];

Sent via Deja.com http://www.deja.com/
Share what you know. Learn what you don't.

```

• Prev by Date: RE: How to prevent the saving dialog box ...
• Next by Date: Creating a keyboard Shortcut
• Previous by thread: Re: another question regarding NDSolve
• Next by thread: Re: PercentileBarChart