Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2008

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

Search the Archive

Re: Trouble Implementing Schelling's Segregation Model

  • To: mathgroup at smc.vnet.net
  • Subject: [mg91684] Re: Trouble Implementing Schelling's Segregation Model
  • From: Jean-Marc Gulliet <jeanmarc.gulliet at gmail.com>
  • Date: Fri, 5 Sep 2008 07:13:02 -0400 (EDT)
  • Organization: The Open University, Milton Keynes, UK
  • References: <g7uo2p$5un$1@smc.vnet.net>

Steve_Kinsella wrote:

> I'm trying to write a demonstration for a class on Schelling's 1978
> segregation model. An implementation exists from Gaylord and D'Andria,
> 1998, but it's not playing ball with Mathematica 6.0. If anyone wants
> to take a pop at the code below, I'd appreciate it. Thanks, Steve

It would have been better if you told us what issues you encountered 
with the code below. I have corrected two potential syntax/semantic errors.

> (*Schelling Model (1978, 147 - 153) Demonstration
> 
> Model uses a square n*n lattice with wraparound boundary conditions \
> with a population density p of individuals occupying lattice sites \
> and the rest empty. System evolves over t time steps. *)
> 
> neighborhood[n_, p_, v_, w_, t_] :=
>  Module[{walk, movestay, society, RND, Moore, GN} ,
>   RND := RandomInteger[ {1, 4}]
>     society :=
>      Table[Floor[p + RandomInteger[]], {n}, {n}] /.
> 
>       1 :> {RND, Table[Integer, {1, w}], {v}};

You must add a ";" semi-column after RandomInteger[], otherwise 
Mathematica will interpret the space as an implicit multiplication with 
society.

>   movestay[0, __] := 0;
>   movestay[{a_, b_},
>     res__] := {a*
>      Round[1 -
>        Count[Map[
>           Count[b - #[[2]], 0] &, {res}/.0 -> {0,
>             0}], _?{# >= v/2 &}]/8.] , b };
>   (*Walk Rules*)
> 
>   Moore[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];

It seems that a square bracket is missing to end the MapThread[] function.

>     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, Moore[movestay, #]] &, society, t]]]
> 
> SeedRandom[9]
> results = neighborhood[20, 0.6, 1, 2, 500]
> 
> Show[GraphicsArray[
>   Map[Show[Graphics[
>       Raster[# /. {0 -> RGBColor[0.7, 0.7, 0.7], {_, {1}} ->
>           RGBColor[0, 1, 0], {_, {2}} -> RGBColor[0, 0, 1]}]],
>      AspectRatio -> Automatic, DisplayFunction -> Identity] &, {First[
>      results], Last[results]}]]]

So your code could be as follows (note that it is still not working, but 
for other reasons that syntactic ones).

neighborhood[n_, p_, v_, w_, t_] :=

  Module[{walk, movestay, society, RND, Moore, GN},

   RND := RandomInteger[{1, 4}];

   society :=
          Table[Floor[p + RandomInteger[]], {n}, {n}] /.
            1 :> {RND, Table[Integer, {1, w}], {v}};

   movestay[0, __] := 0;

   movestay[{a_, b_}, res__] :=
         {a*
      Round[1 - Count[(Count[b - #1[[2]], 0] & ) /@ ({res}/0. ->
                          {0, 0}), _?({#1 >= v/2 & })]/8.], b};

   Moore[func_, lat_] := MapThread[func,

     Map[RotateRight[lat, #1] & , {{0, 0}, {1, 0}, {0, -1}, {-1, 0},
                {0, 1}, {1, -1}, {-1, -1}, {-1, 1}, {1, 1}}, 2]];

   GN[func_, lat_] := MapThread[func,
              (RotateRight[lat, #1] & ) /@ {{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, Moore[movestay, #1]] & , society, t]]

SeedRandom[9]
results = neighborhood[20, 0.6, 1, 2, 500]
Show[GraphicsArray[
      (Show[Graphics[Raster[#1 /. {0 -> RGBColor[0.7, 0.7, 0.7],
                     {_, {1}} -> RGBColor[0, 1, 0], {_, {2}} ->
            RGBColor[0, 0,
                         1]}]], AspectRatio -> Automatic,
       DisplayFunction ->
               Identity] & ) /@ {First[results], Last[results]}]]


Hope this helps,
-- Jean-Marc


  • Prev by Date: matrix matching
  • Next by Date: Re: Help on Collecting Integers
  • Previous by thread: Re: Trouble Implementing Schelling's Segregation Model
  • Next by thread: Re: Trouble Implementing Schelling's Segregation Model