Services & ResourcesWolfram ForumsMathGroup Archive

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

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_] :=
            MapThread[func, Map[RotateRight[lat, #]&,
                  {{0, 0}, {1, 0}, {0, -1}, {-1, 0}, {0, 1}}], 2];

          GN[func_, lat_] :=
            MapThread[func, Map[RotateRight[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.