Complexity of Cooperation Web Site

alliance_sim_main_unit_v3.13


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}

Back to Chapter 4
Back to Chapter 5
Back to Complexity of Cooperation Home Page

University of Michigan Program for the Study of Complex Systems
Contact http@maria.physics.lsa.umich.edu.
Revised November 4, 1996.