Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2008

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

Search the Archive

Trouble Implementing Schelling's Segregation Model

  • To: mathgroup at smc.vnet.net
  • Subject: [mg91286] Trouble Implementing Schelling's Segregation Model
  • From: Steve_Kinsella <stephen.kinsella at gmail.com>
  • Date: Wed, 13 Aug 2008 04:41:24 -0400 (EDT)

Hi All,

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

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


  • Prev by Date: Re: Grouping and constraining slider controls
  • Next by Date: Re: Integrating DiracDelta to get UnitStep
  • Previous by thread: Re: fractional derivative (order t) of (Log[x])^n and Log[Log[x]]
  • Next by thread: x-axis value issues