## Complexity of Cooperation Web Site

### Tipping.p

```program Tipping2;
{ Schelling's Tipping Model                         }
{    Implemented by Robert Axelrod.         }
{     See my file "Schelling Documentation".}
{  ver 1 begun 10/5/95                          }
{  ver 2 begun 10/6/95                          }
{           initialize random seed,                     }
{           report only periodically                    }
{           add output of map of "colors"       }

const                  {contants - used for input parameters}

{control constants}
Version = 2;                              {version of this program}
debug = false;                        {if True, report debugging info}
old_random_seed = 0;          {if 0 generate new seed from clock, else use this seed}
events_per_report = 200;          {Controls frequency of output}
number_of_reports = 4;            {Controls number of reports in all}

{input parameters}
N = 50;                                       {number of actors}
proportion_white = 0.50;          {proportion of actors who are "white", i.e. color=0}

var                    {variables}
occupant: array[0..64] of integer;        {which i occupies the location; 0 is empty}
color: array[1..N] of integer;                {color of the ith actor}
location: array[1..N] of integer;         {location of ith actor}
event: integer;                                       {count of events}
i: integer;                                               {actor index}
neighbor_loc: array[1..64, 1..8] of integer;  {8 neighboring locs of a cell, 0 if off board}
random_seed: integer;
initial_datetime: datetimerec;    {date, etc.}
initial_hour: longint;
report: integer;                      {count of reports, each with events_per_report in it}
event_in_report: integer;         {count of events within current report}
moves_this_period: integer;       {count of moves so far in current period}
{ ---------------------------------------------------------------  }
procedure set_random_seed;         {called from initial_output}
begin
if old_random_seed = 0 then
begin                                                {generate new seed}
random_seed := initial_datetime.hour + initial_datetime.minute + initial_datetime.second;
random_seed := random_seed + (initial_datetime.second * 300);
random_seed := random_seed + (initial_datetime.minute * initial_datetime.hour);
random_seed := random_seed + (initial_datetime.minute * initial_datetime.second);
randseed := random_seed;                {set system's random seed}
end
else
begin                                        {use old seed, which was inputed as constant}
randseed := old_random_seed;
end;
end; {set_random_seed;}
{ { ---------------------------------------------------------------  }
function random_one_to_n (n: longint): longint;        {a random integer between 1 and n inclusive}
var
ub, lb: integer;                             {upper and lower bounds}
r: integer;
begin
ub := 32767 - (32767 mod n);
lb := -32768 - (-32768 mod n);        {truncate distrib on 2 ends so that later mod is OK}
repeat
r := random;                                 {Mac system function gives # betw -32768 and 32767}
until (r <= ub) and (r >= lb);            {make sure random genrated is in truncated (even) distrib}
random_one_to_n := abs(r mod n) + 1;
end;            {random function}
{ ---------------------------------------------------------------  }
procedure initialize_actor_color;  {give each actor color of 0 or 1}
var
i: integer;                  {actor index}
begin
for i := 1 to N do                    {Set up actor vector}
begin
if i <= proportion_white * N then
color[i] := 0              {first part of list is 0's}
else
color[i] := 1;
end;
end;{initialize_actor_color}
{ ---------------------------------------------------------------  }
procedure initialize_actor_location;       {put actors on the map}
var
i: integer;                  {actor index}
trial_location: integer;
begin
for i := 1 to N do
begin
repeat
trial_location := random_one_to_n(64)      {trial location]}
until occupant[trial_location] = 0;     {accept when empty}
occupant[trial_location] := i;
location[i] := trial_location;
end;
end;{initialize_actor_location}
{ ---------------------------------------------------------------  }
procedure initialize_neighbor_list;        {calculate 8 neighbors of each cell of map}
{MAKE 0 IF off board}
var
L: integer;              {location}
begin
for L := 1 to 64 do           {EACH LOCATION}
begin
neighbor_loc[L, 1] := L - 9;            {northwest}
neighbor_loc[L, 2] := L - 8;            {north}
neighbor_loc[L, 3] := L - 7;
neighbor_loc[L, 4] := L - 1;
neighbor_loc[L, 5] := L + 1;
neighbor_loc[L, 6] := L + 7;
neighbor_loc[L, 7] := L + 8;
neighbor_loc[L, 8] := L + 9;
if L < 9 then               {CORRECT TOP ROW}
begin
neighbor_loc[L, 1] := 0;
neighbor_loc[L, 2] := 0;
neighbor_loc[L, 3] := 0;
end;
if L > 56 then              {CORRECT TOP ROW}
begin
neighbor_loc[L, 6] := 0;
neighbor_loc[L, 7] := 0;
neighbor_loc[L, 8] := 0;
end;
if L mod 8 = 0 then     {CORRECT RIGHT SIDE}
begin
neighbor_loc[L, 3] := 0;
neighbor_loc[L, 5] := 0;
neighbor_loc[L, 8] := 0;
end;
if (L - 1) mod 8 = 0 then       {CORRECT LEFT SIDE}
begin
neighbor_loc[L, 1] := 0;
neighbor_loc[L, 4] := 0;
neighbor_loc[L, 6] := 0;
end;
end;{L}
end;   {initialize_neighbor_list}
{ ---------------------------------------------------------------  }
function content: boolean;     {cacluate if active actor is content}
{True is content, F is not}
var
neigh: integer;
L: integer;          {location of i}
ncell: integer;      {neighboring cell}
same_color_count: integer;       {count of neighbors of the same color as i}
occupied_count: integer;         {count of neighboring locs which are occupied}
begin
same_color_count := 0;
occupied_count := 0;
L := location[i];                     {look up i's location}
for neigh := 1 to 8 do            {check each neighbor}
begin
ncell := neighbor_loc[L, neigh];        {neighboring cell}
if (ncell <> 0) and (occupant[ncell] <> 0) then
{neighboring location is on map, and occupied}
begin
occupied_count := occupied_count + 1;
if debug then
begin
write('test L, neigh, n[L, neigh], occt[neig[L, neigh]]');
writeln(L, neigh, neighbor_loc[L, neigh], occupant[neighbor_loc[L, neigh]]);
end;
if color[occupant[ncell]] = color[i] then     {same color}
same_color_count := same_color_count + 1;
end;{if neighbor is on board}
end;{debug}
if 3 * same_color_count > occupied_count then
content := true
else
begin
content := false;
end;
if debug then
begin
write('test, i=', i : 3, '. same_color_count=', same_color_count : 3);
writeln('. occupied_count= ', occupied_count : 3);
end;{debug}
end; {content}
{ ---------------------------------------------------------------  }
var
trial_location: integer;
begin
repeat
trial_location := random_one_to_n(64);
until occupant[trial_location] = 0;   {empty location found}
occupant[location[i]] := 0;                   {empty i's old location}
occupant[trial_location] := i;                {fill the new location}
location[i] := trial_location;                {change i's location}
end;{move}
{ ---------------------------------------------------------------  }
procedure initial_output;                  {write output's header info}
begin
writeln(' Schelling tipping model, coded by R. Axelrod.  Version ', version : 2, '.');
write('   This run began on ', stringof(initial_datetime.month : 2), '/');
write(stringof(initial_datetime.day : 2), '/', stringof(initial_datetime.year : 4), ' at ');
writeln(stringof(initial_datetime.hour : 2), ':', stringof(initial_datetime.minute : 2), '.');
writeln('   Number of actors = ', N : 3, '.');
writeln('   Proportion of actors who have color 0 = ', proportion_white : 4 : 2);
if old_random_seed = 0 then
Writeln('   New random seed ', randseed : 6, '. ')
else
Writeln('   Old random seed ', randseed : 6, '.');
writeln;
end;
{ ---------------------------------------------------------------  }
procedure periodic_output;             {write periodic report}
var
line: integer;                       {line number of map}
L: integer;                          {location}
column: integer;                 {column in map}
begin
if event = 0 then
writeln('Initial conditions.')
else
writeln('Event', event : 5, '. Moves this period', moves_this_period : 4, '.');
writeln('        Agent Map                  Color Map');
L := 0;
for line := 1 to 8 do
begin
for column := 1 to 8 do     {agent map}
begin
L := L + 1;       {next location}
write(occupant[L] : 3);
end;{col}
L := L - 8;     {restart this row}
write('      ');        {space between maps}
for column := 1 to 8 do     {color map}
begin
L := L + 1;
if occupant[L] = 0 then
write(' .')
else
write(color[occupant[L]] : 2);
end;
writeln;
end;{line}
writeln;
end; {periodic output}
{ ---------------------------------------------------------------  }
procedure initialize;                   {initialize a run}
begin
gettime(initial_datetime);                    {record starting time from system clock}
initial_hour := initial_datetime.hour;    {to force long integer}
set_random_seed;
initial_output;                                   {includes setting random number seed}
initialize_actor_color;
initialize_actor_location;
initialize_neighbor_list;
periodic_output;                                  {eport initial positions}
end;{initialize}
{ ---------------------------------------------------------------  }
{M A I N    P R O G R A M }
begin
initialize;
event := 0;                                            {start event count}
i := 0;                                                    {start actor list}
for report := 1 to number_of_reports do
begin
moves_this_period := 0;                  {initialize count of actual moves}
for event_in_report := 1 to events_per_report do
begin
event := event + 1;
i := i + 1;                            {activate next actor on the list}
if i > N then
i := 1;
if not content then                    {if actor is not content then move it}
begin
moves_this_period := moves_this_period + 1;
random_move;
end;{if not content}
end;{one event in this report}
periodic_output;                             {report at end of period}
end;{report (at end of period)}
end.{main program}
```

Back to Appendix B