program Alliance_Sim (input, output); {This is an alliance simulation, programmed by}
{ Scott Bennett for Professor Robert Axelrod, at the}
{ University of Michigan. }
{ Version 1: Begun 1/19/90. }
{ This version, for tie breaking, will go through all the alliances before calculating}
{ gradients, and break ties in alliance order (lowest alliance gets highest energy) }
{ v1.1 initiated initial stuff, through 2/8/90.}
{ v1.2 makes 1st change in sorting procedure and ranking procedure; corrects minor bugs}
{ v 1.3 reformats output with tabs only for MS Word, and adds reporting of all tied alliances.}
{ v 1.4 reworks main algorithm, adding index field for sorting to pot.alliances}
{ v 1.5 sorts by rank before printing list of alliances; cuts energy time in half via complement}
{ v 1.6 sets up as longint rather than int, to allow more countries. Run numbers and history}
{ files implemented. More algorithm speedups implemented. Reading of one comment line}
{ and print in output implemented. Auto-opening Text window done. Output improvements}
{ v 1.6 finished (not completely tested) on 2/17/90. }
{ v 2.0 changes input propensity file format. }
{ v 2.1 adds "name" to history file output.}
{ v2.2 (7/7/90) adds the calculation of frustration to procedures and output. Program}
{ is shortened in the output section by some recoding. Output is modified to make}
{ all sections (basins, etc, print the same)}
{ A change during 10/90 (same version number) allows the programmer to list input }
{ file names in an internal array rather than always prompt the screen. }
{ Also, history file has date and time of runs now.}
{ v2.3 (11/5/90) expands to allow more countries again, 16 as of 11/5/90.}
{ Previous impl. of extra countries was never fully debugged. This time it is.}
{ 16 countries requires 3200 K heap space and 128 K stack. }
{ This requires about 3700K assigned to Think Pascal, which then means that}
{ the program must be run under the Finder to have enough memory free.}
{ v2.31 (11/6/90) fixes up counting of basins and ties with global optimum when}
{ those numbers reach the maximum allowed. }
{ }
{ v3.0 (started 8/21/91) implements a number of speedup and memory reduction changes.}
{ 8/22 dropped the alliance_rep field and implemented a bit-based procedure using}
{ the bit and btst functions, which give a t/f for alliance membership based on alliance index.}
{ Note that this will have to be changed if multipolar alliances are ever used.}
{ 8/22 also added a "test" constant. If Test is true, no output will be written to }
{ run_number or sim_history files.}
{ 8/27 added a recursive, speeded up energy calculation for i <> j. Big improvement!}
{ 8/28 changed frustration, dropping the "ideal" part of the frustration idea. Frustration}
{ is now just the part of the energy due to each individual country.}
{ 8/28 also changed the method by which optima were kept track of, resulting in saving}
{ 2 fields (highest_adjacent and basin_size) from the main data array. Only the }
{ local_max field is needed for basin info, and size is kept in a separate optimum_array.}
{ As part of this, variable names were changed quite a bit. The old basin_list variable}
{ is now the optimum_array.index field, with the new .basin_size field. The old}
{ optimum_array kept track of ties for global optimum, and this is now done in}
{ tied_optimum_array. num_basins is now num_optima; old num_optima is now}
{ tied_optima}
{ 9/3/91 finished dropping the .rank and .index fields of the main data array. Ties are}
{ now broken and stored in a linked list with tie information. As left 9/3, this is }
{ done by using some global variables for the pointers. }
{ As of 9/4/91, the rewritten program appears to be debugged and running OK.}
{ For 18 countries max., I am running with a 2700K Heap, although as small as 2500 }
{ seems to work, to leave some room for pointer structures. I also set a 128K stack.}
{ This all fits in a 3500K multifinder space for Think Pascal, maybe less (not tried).}
{ v3.1 (started 9/16/91) makes more changes. First, the best_neighbor function is}
{ rewritten because it was very slow in v3.0. Second, the polarity of the landscape is }
{ switched so that better points have lower energy. Third, distance is changed to 0 in and}
{ 1 between alliances. At the end of v3.1, speed is about 2.5 times faster than version 2, }
{ and, as discussed above, memory requirements are much less, allowing bigger datasets.}
{ 4th, a section was added to the output to notify the user when adjacent optima }
{ and one point optima are found.}
{ v3.11 added into the raw data output lines 2 and 3 from the propensity file, which}
{ normally have the date and time the prop file was created, and the version of Prop_maker}
{ which created that file. It also fixes a small bug in the adjacency_status proc which}
{ would have reported erroneous info about an equal adjacent pt itself having an equal }
{ adjacent point (which is in fact the first point). }
{ v3.12 adjusted the frustration calculation and output so that frustration(i) =}
{ sum over j of size(j) * raw_propensity_P(ij) * D(ij), as is in the documentation. }
{ v3.0,3.1, 3.11 all}
{ included size(i) in that calculation, making frustration be exactly the portion of the}
{ energy due to one country with everyone. It was done this way partly because }
{ Alliance_Sim assumes that it is reading in a propensity * size matrix, with size not}
{ separate. There was never a need for size before this change was desired. All }
{ calculations are done with energy, not frustration, so it wasn't needed.}
{ The changes to frustration were implemented by adding processing to the}
{ input procedure to separate out the size variable, which was not previously read in}
{ to a variable. Once this was separate, size is used as a modifer on the program variable}
{ "Propensities" which is really a propensity * size matrix.}
{ v3.13 added a check on filename input so that the program run as an application doesn't}
{ crash the whole machine when a file is not found. The main input file, and the }
{ run number and sim_history files are checked to make sure they exist. }
uses
alliance_sim_type_unit, alliance_sim_calculate_unit, alliance_sim_output_unit;
{------------------------------}
procedure initialize_simulation (var country_names: c_name_type; var propensities: propensity_type; var top_alliance: longint; var initial_datetime: datetimerec; var random_seed: integer; var potential_alliances: potential_alliance_type; var first_tie_value: tie_value_ptr; var size: size_type);
{inits some, not all (espc not potential alliances matrix, b/c too big) variables}
var
x, y: integer;
mainrect: rect;
begin
mainrect.top := 40;
mainrect.bottom := 450;
mainrect.left := 5;
mainrect.right := 620;
SetTextRect(mainrect);
ShowText;
gettime(initial_datetime);
writeln('This is the program Alliance_Sim, a simulation of alliances and energy landscapes');
write('This run begun on ', initial_datetime.month : 2, ' / ', initial_datetime.day : 2, ' / ', (initial_datetime.year - 1900) : 2);
write(' at ', initial_datetime.hour : 2, ':');
if initial_datetime.minute < 10 then
writeln('0', initial_datetime.minute : 1)
else
writeln(initial_datetime.minute : 2);
writeln;
random_seed := initial_datetime.hour + initial_datetime.minute + initial_datetime.second + (initial_datetime.second * 300) + (initial_datetime.minute * initial_datetime.hour) + (initial_datetime.minute * initial_datetime.second);
randseed := random_seed;
new(potential_alliances);
for x := 1 to max_countries do
begin
country_names[x] := 'NoName--';
size[x] := -1;
end;
for x := 1 to max_countries do
for y := 1 to max_countries do
propensities[x, y] := 0;
for x := 1 to max_countries do
propensities[x, x] := 0;
top_alliance := 0; {intiially blank, potential matrix not yet initialized}
first_tie_value := nil;
end; {proc init sim}
{------------------------------}
procedure read_input (var num_countries: integer; var country_names: c_name_type; var propensities: propensity_type; var datafile: text; var top_alliance: longint; var inputfilename, outputfilename: filenametype; var run_number: integer; var Main_Comment: main_comment_type; var random_seed, num_raw_lines: integer; var raw_data_from_prop_file: raw_from_prop_type; var have_starting_alliance: boolean; var starting_alliance: starting_alliance_type; datetime: datetimerec; var size: size_type);
{Reads input, does history and run_number file reading and updating}
var
x, y: integer; {counter}
country_i, country_j: integer;
propij: real;
num_propensities: integer;
big_item_read: string[150];
Run_Number_File_Name, history_file_name: file_path_name_type;
comment_line: big_comment_type;
cname: one_cname_type;
charnum: integer;
have_raw_input: boolean;
csize: real;
initial_num: integer;
power: integer;
currentstringmarker, alliance_spot: integer;
{---------------------------------- }
procedure read_a_line (var afile: text; var aline: big_comment_type);
{reads one line, stops at eoln or eof. If stops at eoln, reads next line}
var
currentstringmarker: integer;
achar: char;
begin
currentstringmarker := 1;
aline := '';
achar := ' ';
if not eof(afile) then
while not eoln(afile) and (achar = ' ') do
read(afile, achar); {read any initial spaces - stop at first char.}
aline := concat(aline, achar);
if not eof(afile) then
begin
while (not eoln(afile)) and (currentstringmarker < comment_length) do
begin
read(afile, achar);
aline := concat(aline, achar);
currentstringmarker := currentstringmarker + 1;
if eof(afile) then
leave; {exit this while loop if get to eof}
if (currentstringmarker > comment_length) then
writeln('A line was too long. Max comment line length is ', comment_length, ' characters. Line truncated');
end;
readln(afile);
end;
end; {proc read a line}
{ -------------------------- }
procedure read_a_path (var afile: text; var apath: file_path_name_type);
{reads a path enclosed in " marks}
var
currentstringmarker: integer;
charread: char;
begin
currentstringmarker := 1;
apath := '';
read(afile, charread);
if charread = ' ' then
repeat
read(afile, charread)
until charread <> ' '; {This allows there to be spaces at the beginning of a line}
if charread <> '"' then
begin
writeln('Error -- filenames in data file must be enclosed in " marks. This is a fatal error -- execution ends');
writeln('Please check data file and try again. ');
halt;
end
else
read(afile, charread);
while (charread <> '"') and (not eoln(afile)) and (currentstringmarker <= max_file_string_length) do
begin
apath := concat(apath, charread);
currentstringmarker := currentstringmarker + 1;
if eof(afile) then
begin
writeln('Unexpected end of file found. Please check the file -- more errors may occur. ');
leave; {get out of the while}
end
else {not eof, so read}
read(afile, charread);
if (currentstringmarker > max_file_string_length) then
begin
writeln('Path name was too long for a file name. Max is ', max_file_string_length, ' characters');
writeln('This is a fatal error. Program won t be able to find file . Execution ends. Check data file path and re run ');
halt;
end;
end;
readln(afile);
end; {proc read a path}
{------------------------------------------ }
begin
{Section added for input file name check.}
iocheck(false);
writeln('What input file do you want to use? ');
write('Maximum ', max_file_string_length, ' chars , please: ');
inputfilename := ' ';
if files_from_list = true then
inputfilename := input_name_array[array_loop]
else
readln(inputfilename);
write('Trying to open file called ');
writeln(inputfilename);
reset(datafile, inputfilename);
case (ioresult) of
-43, 17, 19, 21, 24:
begin
writeln('File error opening the main input file. ');
writeln('This is a fatal error. Check file name and try again ');
halt;
end;
otherwise
begin
writeln('File opened OK.');
end;
end; {case}
writeln('What output file do you want to use? ');
write('Maximum ', max_file_string_length, ' chars , please: ');
outputfilename := ' ';
if files_from_list = true then
outputfilename := output_name_array[array_loop]
else
readln(outputfilename);
writeln(outputfilename);
iocheck(true);
{the following lines all read in initial variables from external file}
{Want to keep lines 2 and 3. This has information about the propensity file put there by Prop_Maker}
num_raw_lines := 0;
for x := 1 to 12 do
if (x = 2) or (x = 3) then
begin
num_raw_lines := num_raw_lines + 1;
read_a_line(datafile, comment_line);
raw_data_from_prop_file[num_raw_lines] := comment_line;
end
else
readln(datafile); {first 12 lines are header lines}
{next line should be a line of ****}
read_a_line(datafile, comment_line);
if (comment_line[1] <> '*') and (comment_line[2] <> '*') then
begin
writeln('Problem reading input file. Did not see * * when should have . ');
writeln(' This is a fatal error -- execution ends. Check data file and re-run.');
halt;
end;
{read the included descriptive comment lines}
Main_comment.num_lines := 0;
repeat
main_comment.num_lines := main_comment.num_lines + 1;
read_a_line(datafile, Main_comment.lines[main_comment.num_lines]);
until (Main_comment.lines[main_comment.num_lines][1] = '*') and (Main_comment.lines[main_comment.num_lines][2] = '*') or (main_comment.num_lines > 25);
if (main_comment.num_lines >= 25) and (Main_comment.lines[main_comment.num_lines][1] <> '*') and (Main_comment.lines[main_comment.num_lines][2] <> '*') then
begin
writeln('Problem reading input file. Did not see "**" within 25 lines of comment beginning');
writeln(' This is a fatal error -- execution ends. Check data file and re-run.');
halt;
end;
Main_comment.num_lines := Main_comment.num_lines - 1;
{now read path to run number and history file }
read_a_path(datafile, Run_Number_File_Name);
read_a_path(datafile, history_file_name);
readln(datafile, num_countries);
if (num_countries < 2) then
begin
writeln('The number of countries specified in the data file was less than 2');
writeln('This number must be greater than or equal to 2 for the program to execute.');
writeln('This is a fatal error. Please check the data file and re-run');
HALT;
end;
if (num_countries > max_countries) then
begin
writeln('The number of countries specified in the data file was more than the maximum allowed');
writeln('The maximum number of countries allowed by the program is ', max_countries : 3);
writeln('This is fatal error. Please modify the data file and re-run');
HALT;
end;
for x := 1 to num_countries do
begin
readln(datafile, big_item_read);
country_names[x] := '';
for y := 1 to min(length(big_item_read), 8) do
country_names[x] := concat(country_names[x], big_item_read[y]);
end;
readln(datafile); {read the propensity table header line, which is useless}
for country_i := 1 to num_countries do
begin
read(datafile, initial_num); {the initial number on each row is just an index}
for country_j := 1 to num_countries do
read(datafile, propensities[country_i, country_j]);
readln(datafile);
end;
read_a_line(datafile, comment_line); {now read line of **** following prop matrix}
if (comment_line[1] <> '*') and (comment_line[2] <> '*') then
begin
writeln('Problem reading input file. Did not see * * when should have following prop matrix. ');
writeln(' This is a fatal error -- execution ends. Check data file and re-run.');
halt;
end;
{now read the alliance config, or a blank line if there is none}
have_starting_alliance := false;
read_a_line(datafile, comment_line); {this should be the line of initial config, or blank. Check if there...}
currentstringmarker := 1;
while (currentstringmarker < length(comment_line)) and ((comment_line[currentstringmarker] <> '0') and (comment_line[currentstringmarker] <> '1')) do
currentstringmarker := currentstringmarker + 1; {read until see 0 or 1, or get to end of line read}
if (comment_line[currentstringmarker] = '0') or (comment_line[currentstringmarker] = '1') then
begin {have an initial config}
have_starting_alliance := true;
alliance_spot := 1;
starting_alliance.raw[alliance_spot] := ord(comment_line[currentstringmarker]) - 48;
currentstringmarker := currentstringmarker + 1;
repeat
while (currentstringmarker < length(comment_line)) and ((comment_line[currentstringmarker] <> '0') and (comment_line[currentstringmarker] <> '1')) do
currentstringmarker := currentstringmarker + 1; {again, read until see 0 or 1, or get to end of line read}
alliance_spot := alliance_spot + 1;
starting_alliance.raw[alliance_spot] := ord(comment_line[currentstringmarker]) - 48;
currentstringmarker := currentstringmarker + 1;
until (alliance_spot = num_countries) or (currentstringmarker > length(comment_line));
if alliance_spot <> num_countries then {exited abnormally}
begin
writeln('Tried to read an alliance config from raw data file, but couldnt . ');
writeln('This run is therefore not outputting any alliance configuration to the output file.');
have_starting_alliance := false;
end;
end;
{now, if have alliance config, figure out its index number}
{For each "digit" of alliance_rep, take 2^power, where power is one less than posn from rt}
if have_starting_alliance then
begin
power := 0;
starting_alliance.index := 0;
for x := num_countries downto 1 do
begin
starting_alliance.index := starting_alliance.index + (starting_alliance.raw[x] * intpower(2, power));
power := power + 1;
end;
end;
read_a_line(datafile, comment_line); {now read line of **** following starting config}
if (comment_line[1] <> '*') and (comment_line[2] <> '*') then
begin
writeln('Problem reading input file. Did not see * * when should have following initial config matrix. ');
writeln(' This is a fatal error -- execution ends. Check data file and re-run.');
halt;
end;
{Now read any initial raw data file lines that were copied into the .prop file}
{ First should be three lines that are the header to the raw data. But, always check}
{ to make sure the lines are really there in case they were deleted.}
for x := 1 to 3 do
if (not eof(datafile)) then
begin
num_raw_lines := num_raw_lines + 1;
read_a_line(datafile, comment_line);
raw_data_from_prop_file[num_raw_lines] := comment_line;
end;
if (comment_line[1] <> '-') and (comment_line[2] <> '-') then
{not input from prop_maker}
have_raw_input := false
else
have_raw_input := true;
{Now, for each country, pick out the size}
repeat
if not eof(datafile) then
begin
num_raw_lines := num_raw_lines + 1;
read_a_line(datafile, comment_line);
raw_data_from_prop_file[num_raw_lines] := comment_line;
if have_raw_input then
begin
readstring(comment_line, x); {Get number of index from raw data.}
{Now figure out what character is second tab, which is past name and right before size}
charnum := 1;
while (comment_line[charnum] <> chr(9)) do
charnum := charnum + 1;
charnum := charnum + 1; {Advance to next beyond tab}
while (comment_line[charnum] <> chr(9)) do
charnum := charnum + 1;
delete(comment_line, 1, charnum); {This deletes chars 1 to charnum}
readstring(comment_line, csize);
size[x] := csize;
end; {if have_raw_input}
end;
until eof(datafile);
close(datafile);
top_alliance := intpower(2, num_countries) - 1; {this is the top relevant alliance in potential list}
{alliances numbered 0 to 2^num -1}
iocheck(false);
if test then
run_number := 0
else
begin {not a test; read run #, history file}
reset(datafile, Run_Number_File_Name);
case (ioresult) of
-43, 17, 19, 21, 24:
begin
writeln('File error opening the run_number file. ');
writeln('This is a fatal error. Check file name and path in input file and try again ');
halt;
end;
otherwise
begin
writeln('Run number file opened OK.');
end;
end; {case}
readln(datafile, run_number);
run_number := run_number + 1;
close(datafile);
rewrite(datafile, Run_Number_File_Name);
writeln(datafile, run_number);
close(datafile);
open(datafile, History_File_Name);
case (ioresult) of
-43, 17, 19, 21, 24:
begin
writeln('File error opening the history file. ');
writeln('This is a fatal error. Check file name and path in input file and try again ');
halt;
end;
otherwise
begin
writeln('History file opened OK. Now reading...');
end;
end; {case}
iocheck(true);
while not eof(datafile) do
readln(datafile);
write(datafile, run_number : 4, ' ', name, ' ', ' v', version : 6 : 3, ' ', datetime.month : 2, '/', datetime.day : 2, '/', (datetime.year - 1900) : 2, ' ', datetime.hour : 2, ':');
if datetime.minute < 10 then
write(datafile, '0', datetime.minute : 1)
else
write(datafile, datetime.minute : 2);
writeln(datafile, random_seed);
{write header info.}
for x := 1 to main_comment.num_lines do
writeln(datafile, ' ', Main_Comment.lines[x]);
close(datafile);
end; {not test}
end; {procedure input read}
{ ------------------------------------------- }
begin {main program}
name := 'Alliance_Sim ';
{To use the input name array method of running, changes need to be made in the actual code}
{here, to set the names of the input and output files, and to set the number of files to be used from this list.}
{See documentation, and set the boolean variable in the type unit to use the list of input/output file names.}
if files_from_list = true then
begin
num_files_to_process := 1;
input_name_array[4] := 'as.1936.theory3.prop';
output_name_array[4] := 'as.1936.theory3.out.asv3.12';
input_name_array[2] := 'as.1936.theory3.gps.prop';
output_name_array[2] := 'as.1936.theory3.gps.out';
input_name_array[3] := 'as.1936.theory3.realgps.prop';
output_name_array[3] := 'as.1936.theory3.realgps.out';
input_name_array[1] := 'as.1936.theory3.real.prop.2';
output_name_array[1] := 'as.1936.theory3.real.out.2';
end
else {not using files from list method, so do only one, and prompt the user for the names in read_input.}
num_files_to_process := 1;
for array_loop := 1 to num_files_to_process do
begin
initialize_simulation(country_names, propensities, top_alliance, initial_datetime, random_seed, potential_alliances, first_tie_value, size);
read_input(num_countries, country_names, propensities, datafile, top_alliance, inputfilename, outputfilename, run_number, Main_Comment, random_seed, num_raw_lines, raw_data_from_prop_file, have_starting_alliance, starting_alliance, initial_datetime, size);
calculate_all_alliances(propensities, potential_alliances, top_alliance, best_energy_alliance, tied_optima, permuted_propensity_matrix, permuted_index_array, tied_optimum_array, frustration_array, optimum_array, num_optima, size);
write_output(potential_alliances, top_alliance, num_countries, country_names, propensities, inputfilename, initial_datetime, best_energy_alliance, tied_optima, permuted_propensity_matrix, permuted_index_array, tied_optimum_array, main_comment, run_number, have_starting_alliance, starting_alliance, frustration_array, optimum_array, num_optima);
writeln('Processing output to file. Please wait... ');
write_complete_output_to_file(potential_alliances, top_alliance, num_countries, country_names, propensities, outfile, inputfilename, outputfilename, initial_datetime, best_energy_alliance, tied_optima, permuted_propensity_matrix, permuted_index_array, tied_optimum_array, main_comment, run_number, num_raw_lines, raw_data_from_prop_file, have_starting_alliance, starting_alliance, frustration_array, optimum_array, num_optima);
writeln('Processing complete. This run now over ');
dispose(potential_alliances);
if first_tie_value <> nil then
dispose(first_tie_value);
end;
end. {main program}
University of Michigan Program for the Study of Complex Systems
Contact http@maria.physics.lsa.umich.edu.
Revised November 4, 1996.