Complexity of Cooperation Web Site

alliance_sim_type_unit_v3.13


                            {This is types and common procedures and functions for Alliance_Sim}

unit alliance_sim_type_unit;

interface

    const
        version = 3.13;
        test = false;                   {if test=true, no run_number or sim_history is read or written.  Run # is set to 0 for}
{                                       test=true runs, but is not saved.}
        files_from_list = false;

        Max_countries = 18;
        Max_countries_Plus20 = 38;

                                        {This is 2 ^ max_countries.  For 15, this is 0 to 32767, equiv to 1 to 32768.}
{                                                                   For 16 this is 0 to 65535.  For 17 this is 0 to 131071.}
{                                                                   For 18, this is 0 to 262143, eq. to 1 to 262144.}
{                                                                   For 19, this is 0 to 524287, eq. to 1 to 524288.}
{                                       Using longint type would allow up to 31, i.e. 2 ^ 31 alliances.}
{                                       Version 2.x used memory such that with 4 meg could only do 16 countries.  }
{                                       16 required 3200 K heap space to run. 17 would take 3.7 Meg for main potential_alliance array itself.}
{                                       Version 3.0 reduced the memory necessary substantially...  Can do 18, for which}
{                                           main potential_alliances structure needs 2.1 Meg.  }
{                                           19 would need 4.2 Meg for that structure alone.  }
{                                           Each 32768 alliances (0 to 32767) takes 262,120 bytes  (262K).}

        max_alliances = 262143;
        max_alliances_plus1 = 262144;      {This will be used as an initial value -- if ever seen in output, know prog wrong}

        max_optima = 200;           {This  number is total for both base and complement set}
        max_tied_optima = 15;       {max allowable ties for global optimum}
        max_value_ties = 1000;  {maximum number of points allowable with any one energy value}
        max_frust_to_print = 15;    {Only print frustration of countries with this many optima.}

        max_file_string_length = 80;
        comment_length = 100;

    type
        propensity_type = array[1..max_countries, 1..max_countries] of real;

        alliance_rep_type = array[1..max_countries] of 0..1;            {in or out of alliance}

        one_potential_alliance = record
                energy: real;
                local_opt: 0..max_alliances_plus1;
            end;                    {record}

        potential_alliance_array_type = array[0..max_alliances] of one_potential_alliance;

        potential_ptr = ^potential_alliance_array_type;

        potential_alliance_type = potential_ptr;

        opt_record = record
                index: longint;
                basin_size: 0..max_alliances_plus1;
            end;

        optimum_array_type = array[1..max_optima] of opt_record;        {info on opts and basins}

        tied_opt_list_type = array[1..max_optima] of longint;               {info on ties for global optimum}

        frustration_array_type = array[1..max_countries, 0..max_optima] of real;
                                                                    {frust of each country with each basin and 0, starting alliance}

        one_cname_type = string[8];

        c_name_type = array[1..max_countries] of one_cname_type;

        filenametype = string[Max_file_string_length];

        rank_array = array[1..max_value_ties] of longint;

        ranking_within_array_type = ^rank_array;                {used for ranking ties.}

        permuted_index_type = array[1..max_countries] of longint;

        big_comment_type = string[comment_length];

        main_comment_type = record
                num_lines: integer;
                lines: array[1..25] of big_comment_type;
            end;

        file_path_name_type = string[max_file_string_length];

        raw_from_prop_type = array[1..max_countries_plus20] of big_comment_type;

        starting_alliance_type = record
                raw: alliance_rep_type;
                index: longint;
            end;

        name_type = string[20];

        tie_value_ptr = ^tie_value_rec;

        tie_index_ptr = ^tie_index_rec;

        tie_value_rec = record
                value: real;
                next: tie_value_ptr;
                prev: tie_value_ptr;
                first_index: tie_index_ptr;
                last_index: tie_index_ptr;
            end;

        tie_index_rec = record
                index: longint;
                rank: longint;
                next: tie_index_ptr;
                prev: tie_index_ptr;
            end;

        full_rec_ptr = ^full_rec;

        full_rec = record
                index: longint;
                energy: real;
                next, prev: full_rec_ptr;
            end;

        point_condition_type = (plateau, floor, saddle, maybe_floor, maybe_plateau, unknown);

        size_type = array[1..max_countries] of real;

    var
        name: name_type;
        x: longint;
        num_countries: integer;                 {num_countries in this run of the simulation}
        country_names: c_name_type;         {list of names/labels associated w/ countries}
        propensities: propensity_type;          {propensities of countries to ally}
        potential_alliances: potential_alliance_type;           {matrix of all possible alliances and data about them}
        top_alliance: longint;          {marker to the top alliance which is possible in the array of potentials}
        size: size_type;
        best_energy_alliance: longint;          {holds index to the global optimum}

        tied_optima: integer;                           {holds number of ties for the optimum}
        tied_optimum_array: tied_opt_list_type;

        optimum_array: optimum_array_type;  {holds data on optima found}

        frustration_array: frustration_array_type;          {holds frustration of each country with each basin}
        num_optima: integer;                                        {number of optima found}

        permuted_index_array: permuted_index_type;          {for permutation of prop matrix}
        permuted_propensity_matrix: propensity_type;

        initial_datetime: datetimerec;

        random_seed: integer;
        run_number: integer;

        inputfilename, outputfilename: filenametype;
        datafile: text;         {input data}
        outfile: text;              {complete listing of data file}

        Main_Comment: main_comment_type;
        num_raw_lines: integer;
        raw_data_from_prop_file: raw_from_prop_type;

        starting_alliance: starting_alliance_type;
        have_starting_alliance: boolean;

        first_tie_value, last_tie_value: tie_value_ptr;
        current_ptr, first_of_50: full_rec_ptr;

        array_loop: integer;
        input_name_array: array[1..10] of filenametype;
        output_name_array: array[1..10] of filenametype;
        num_files_to_process: integer;

{These functions and procedures are used both by main_unit and calculate_unit, or by one or the other but are small, }
{   so are put here, although  they could be put at the top of calculate unit.}

    function intpower (num: longint; power: longint): longint;
    function realpower (num: real; power: real): real;
    function random_range (n: longint): longint;
    function max (num1, num2: longint): longint;            {returns the larger of two entered integers}
    function min (num1, num2: longint): longint;            {returns the smaller of two entered integers}
    function bit (country_num: integer): integer;
    function country_from_bit (bit_num: integer): integer;
    function bit_format (anum: longint): alliance_rep_type;
    function a_complement (alliance_index: longint): boolean;
    function basin_size (an_index: longint): longint;
    procedure get_random_order (number_to_order: integer; var random_order_list: ranking_within_array_type);
    function best_from_tied_situation (start_config: longint; first_best: longint): longint;
    function best_neighbor (a_config: longint): longint;
    function adjacent_optima (index1, index2: longint): boolean;
    function adjacency_status (anindex: longint): point_condition_type;
    function alliance_rep (frombool: boolean): integer;

implementation

  { ---------------------------------------------------------------  }


    function intpower (num: longint; power: longint): longint;
    begin
        if num = 0 then
            intpower := 0
        else if power = 0 then
            intpower := 1
        else
            intpower := round(exp(power * (ln(num))));
    end;       {function realpower}

   { ---------------------------------------------------------------  }

    function realpower (num: real; power: real): real;
    begin
        if num = 0 then
            realpower := 0
        else if power = 0 then
            realpower := 1
        else
            realpower := exp(power * (ln(num)));
    end;       {function realpower}

   { ---------------------------------------------------------------  }

    function random_range (n: longint): longint;
                            {proc returns a random number between 0 and n}
        var
            ub, lb: integer;
            r: integer;
    begin
        n := n + 1;                         {when n comes in, must modify internally to n+1 for mod to work correctly}
                                    {random gives # betw -32768 and 32767}
        ub := 32767 - (32767 mod n);
        lb := -32768 - (-32768 mod n);                  {truncate distrib on 2 ends so that later mod is OK}
        repeat
            r := random;
        until (r <= ub) and (r >= lb);                      {make sure random genrated is in truncated (even) distrib}
        random_range := abs(r mod n);
    end;            {function}

  { ---------------------------------------------------------------  }

    function max (num1, num2: longint): longint;            {returns the larger of two entered integers}
    begin
        if num1 >= num2 then
            max := num1
        else    {num2 > num1)}
            max := num2;
    end;
  { ---------------------------------------------------------------  }

    function min (num1, num2: longint): longint;            {returns the smaller of two entered integers}
    begin
        if num1 <= num2 then
            min := num1
        else                      {num2 < num1)}
            min := num2;
    end;

  { ---------------------------------------------------------------  }

    function bit (country_num: integer): integer;
                {This returns the position in the bit representation for that country, given countries 1..num_countries}
    begin
        bit := num_countries - country_num;
    end;

  { ---------------------------------------------------------------  }

    function country_from_bit (bit_num: integer): integer;
                {Given a position in the bit_representation, this returns the number of the country}
    begin
        country_from_bit := num_countries - bit_num;
    end;

  { ---------------------------------------------------------------  }

    function bit_format (anum: longint): alliance_rep_type;
                {this func takes an integer and converts to a 0/1 array for display, etc. }
        var
            power, spot: integer;
    begin
        spot := 0;
        for power := max_countries - 1 downto 0 do
            begin
                spot := spot + 1;
                bit_format[spot] := anum div (intpower(2, power));
                anum := anum mod intpower(2, power);
            end;
    end;

  { ---------------------------------------------------------------  }

    function a_complement (alliance_index: longint): boolean;
                    {Checks the first position of an alliance config to see if it is a complement/duplicate alliance.}
{                       This is checking bit(1), which is the bit for country 1.}
    begin
        if btst(alliance_index, bit(1)) = true then
            a_complement := true
        else if btst(alliance_index, bit(1)) = false then
            a_complement := false
        else
            writeln('Error -- a_complement did not see t or f.  ');
    end;

                        {-----------------------}

    procedure get_random_order (number_to_order: integer; var random_order_list: ranking_within_array_type);
                    {returns randomly ordered list of number_to_order #s,  in random_order_list}
                    {range returned is 0 to number_to_order -1;  in array spots 1 to number_to_order}

        type
            blankptr = ^blank_rec;

            blank_rec = record
                    value: integer;
                    next_rec: blankptr;
                    prev_rec: blankptr;
                end;

            rank_pointer = ^blank_rank_rec;

            blank_rank_rec = record
                    value: integer;
                    count: integer;
                    next: rank_pointer;
                    prev: rank_pointer;
                end;

        var
            blank_list_begin: blankptr;
            blank_list_end: blankptr;
            current_on_list: blankptr;
            prev_on_list: blankptr;
            randoms_left: longint;
            random_loc: longint;
            start_left: boolean;
            current_spot: integer;
            random_order_spot: integer;
            x: integer;


    begin
        if number_to_order = 2 then             {This is very common, so is separate.  Returns 0 and 1 in a random order}
            begin
                x := random_range(1);                   {x now has either 0 or 1}
                random_order_list^[1] := x;
                if x = 0 then
                    random_order_list^[2] := 1
                else if x = 1 then
                    random_order_list^[2] := 0
                else
                    writeln('Programming error in procedure "get random order" -- x was not 0 or 1 ');
            end
        else                      {have more than 2 numbers to but in order}
            begin
                    { create a pointer list of the numbers from which #s will be drawn w/o replacement}
                new(current_on_list);
                blank_list_begin := current_on_list;
                blank_list_begin^.prev_rec := nil;
                blank_list_begin^.value := 0;
                prev_on_list := blank_list_begin;
                for x := 2 to number_to_order do
                    begin
                        new(current_on_list);
                        current_on_list^.value := x - 1;
                        current_on_list^.prev_rec := prev_on_list;
                        prev_on_list^.next_rec := current_on_list;
                        prev_on_list := prev_on_list^.next_rec;
                    end;
                current_on_list^.next_rec := nil;
                blank_list_end := current_on_list;
                {Now have list of num_to_order members, values from 0 to num_to_order -1, ptrs to front and back}

                random_order_spot := 1;
                for randoms_left := number_to_order downto 1 do
                    begin
                        random_loc := random_range(randoms_left - 1) + 1;

                {1.  figure out end to start at.  If random spot closer to left, then start at left ptr, else start at right ptr}
                        if random_loc <= (randoms_left div 2) then
                            start_left := true
                        else
                            start_left := false;

                {2.  move to that spot in the pointer list}
                        if start_left then
                            begin
                                current_spot := 1;
                                current_on_list := blank_list_begin;
                                while current_spot < random_loc do
                                    begin
                                        current_spot := current_spot + 1;
                                        current_on_list := current_on_list^.next_rec;
                                    end;                {while currentspot < random_loc}
                            end             {if start left}
                        else                        {start right}
                            begin
                                current_spot := randoms_left;                       {this many remain in pointer list still}
                                current_on_list := blank_list_end;
                                while current_spot > random_loc do
                                    begin
                                        current_spot := current_spot - 1;
                                        current_on_list := current_on_list^.prev_rec;
                                    end;                    {while current spot > random_loc}
                            end;

                {3.  put that value on the random order list, and delete the spot in the pointer list}
                        random_order_list^[random_order_spot] := current_on_list^.value;
                        random_order_spot := random_order_spot + 1;
                        if randoms_left = 1 then
                            begin
                    {this was the last one, pointers are now both at the same value, don't try to move any next/prev}
                            end
                        else if current_on_list = blank_list_begin then
                            begin
                                blank_list_begin := blank_list_begin^.next_rec;
                                blank_list_begin^.prev_rec := nil;
                            end
                        else if current_on_list = blank_list_end then
                            begin
                                blank_list_end := blank_list_end^.prev_rec;
                                blank_list_end^.next_rec := nil;
                            end
                        else
                            begin
                                current_on_list^.prev_rec^.next_rec := current_on_list^.next_rec;
                                current_on_list^.next_rec^.prev_rec := current_on_list^.prev_rec;
                            end;
                        dispose(current_on_list);
                    end;                    {for randoms left}
            end;                            {else from if num_to_order = 2}
    end;                    {proc get random_order}

            { ---------------------------------------  }


    function best_from_tied_situation (start_config: longint; first_best: longint): longint;
                            {This function is called in the case where at least one of the neighbors of a point}
                            {is tied for energy with that point.  This function deals with all the posibilites that entails.}
                            {In v3.1, this func. called when The original point has 2 or more adjacent points with equal }
                            {energy, both greater than it.  That point could go to either point.}
                        {First best comes in with index to one of the top adjacent points.  This gives the energy of the tied points.}

        var
            current_alliance: longint;
            x, loop: integer;
            tied_points: array[1..max_countries] of longint;      {This array has config #s of the tied points.}
            num_tied_points, num_index_ties: integer;
            current_tie_value, tie_value: tie_value_ptr;
            current_tie_index, tie_index: tie_index_ptr;
            ordered_tie_list: ranking_within_array_type;
            best_rank: integer;
            do_insert_value, repeating: boolean;

    begin

        num_tied_points := 0;
                {First make list of those points tied for the best adjacent energy}

                    {First check the possibility that the original point}
                            {is also equal energy to the first_best point.}
        if (potential_alliances^[start_config].energy = potential_alliances^[first_best].energy) then
            begin
                            {found a point equal to one seen before, so add it to tied point list.}
                num_tied_points := num_tied_points + 1;
                tied_points[num_tied_points] := start_config;
            end;
                    {Now check all the adjacent points...}
        for x := 0 to num_countries - 1 do
            if (potential_alliances^[BitXor(start_config, intpower(2, x))].energy = potential_alliances^[first_best].energy) then
                begin
                            {found a point equal to one seen before, so add it to tied point list.}
                    num_tied_points := num_tied_points + 1;
                    tied_points[num_tied_points] := BitXor(start_config, intpower(2, x));
                end;

        {Now have one  max adj. in first_best, and list of all the tied points in the tied_points array}

        if num_tied_points <= 1 then
            writeln('ERROR in high_from_tied situation - num_tied_points <= 1')
        else
            begin
                {Now decide which of these adjacent, better points is best.  }
                { Ugly because I don't want to just randomly choose between these  and forget the ranking.  This}
                {ranking needs to be saved for other points.  Also, probably want to rank all with this energy }
                {so that there is a clear ordering in case of future ties with this value.  }
                {  What I want to do is check the tied/ranked list, and add and rank all points of this value if they }
                {aren't already on it.  This is probably going to degenerate rapidly if a situation occurs with lots of ties.}

{               1.  Is the new value already on the tie list, in which case I can just pick out which is best? }
                {Tie_list is initialized to nil in the initialize procedure, so the following is OK even to start.  }

{    writeln('Having to figure out a tie breaking situation... ');}
                current_tie_value := first_tie_value;
                {Building list in order low energy to high energy, so find either a) end of list, or b) first already on }
                {   list with a bigger or equal energy, and possibly insert before that point.}

                if (current_tie_value = nil) then
                    repeating := false
                else {current_tie_value <> nil}
                    if current_tie_value^.value >= potential_alliances^[first_best].energy then
                        repeating := false
                    else
                        repeating := true;

                while repeating = true do
                    begin
                        current_tie_value := current_tie_value^.next;
                        if (current_tie_value = nil) then
                            begin
                                repeating := false
                            end
                        else        {current_tie_value <> nil}
                            if current_tie_value^.value >= potential_alliances^[first_best].energy then
                                repeating := false
                            else
                                repeating := true;
                    end;

                    {Now found a spot on list where search was stopped.  Evaluate why search stopped, and insert or not...}
                if (current_tie_value = nil) then       {need to insert value on list}
                    begin
                        do_insert_value := true;
                    end
                else                {current not nil;  might need to insert value, or not.  Check if value is really there...}
                    begin
                        if (current_tie_value^.value = potential_alliances^[first_best].energy) then
                            do_insert_value := false
                        else
                            do_insert_value := true;
                    end;

                if do_insert_value = false then
                    begin           {1A.  best_adj value was on the list;  current points to where it is.}
                                        {all values equal to max_adj should already be on this list; don't need to insert.  }
                    end
                else        {do_insert_value = true}
                    {1B.  the best_adj value was not on the list, so need to go through all alliances and put ties on list}
                    begin
                            {First, add the value to the stored list.}
                        new(tie_value);
                        tie_value^.value := potential_alliances^[first_best].energy;
                        tie_value^.first_index := nil;
                        if current_tie_value = nil then             {insert value at end of list; this also happens when list empty}
                            begin
                                tie_value^.next := nil;
                                tie_value^.prev := last_tie_value;
                                if first_tie_value = nil then               {empty; this is first in list}
                                    first_tie_value := tie_value;
                                if last_tie_value <> nil then                       {if it wasn't an empty list, point last.next to this}
                                    last_tie_value^.next := tie_value;
                                last_tie_value := tie_value;
                            end
                        else                                {insert value before the current record, so as to be in numerical order}
                        {might be first}
                            if current_tie_value^.prev = nil then     {first}
                                begin
                                    tie_value^.next := current_tie_value;
                                    tie_value^.prev := nil;
                                    current_tie_value^.prev := tie_value;
                                    first_tie_value := tie_value;
                                end
                            else                    {record goes in the middle, before the current_tie_value}
                                begin
                                    tie_value^.next := current_tie_value;
                                    tie_value^.prev := current_tie_value^.prev;
                                    current_tie_value^.prev := tie_value;
                                    tie_value^.prev^.next := tie_value;
                                end;
                                    {Now have inserted this value on the list.  It's marked by tie_value.}
                        current_tie_value := tie_value;
                                    {1C. Now find all occurences of value in the main alliance list and attach and count them. }
                        num_index_ties := 0;
                        for current_alliance := 0 to top_alliance do
                            if potential_alliances^[current_alliance].energy = current_tie_value^.value then
                                begin
                                    num_index_ties := num_index_ties + 1;
                                    new(tie_index);
                                    tie_index^.index := current_alliance;
                                    tie_index^.rank := 0;
                                    if current_tie_value^.first_index = nil then            {inserting first occurence/record}
                                        begin
                                            tie_index^.prev := nil;
                                            tie_index^.next := nil;
                                            current_tie_value^.first_index := tie_index;
                                            current_tie_value^.last_index := tie_index;
                                        end
                                    else            {Not first;  attach after last.}
                                        begin
                                            tie_index^.prev := tie_value^.last_index;
                                            tie_index^.next := nil;
                                            current_tie_value^.last_index^.next := tie_index;
                                            current_tie_value^.last_index := tie_index;
                                        end;
                                end;                        {for current 0 to top}
                        if odd(num_index_ties) then
                            writeln(' Error in doing ties from the tie list in handle tie procedure in unit type_unit.  Odd # of indices');

                    {1D. Now have all index numbers on the list, and am pointing to the right part of the list.  }
                        {So, now sort them by some ranking method.}
                        {Can use the previously (v1 or 2) written procedure to generate a list of n random numbers.}

                    {Now, get and attach a set of random values.  }
                        new(ordered_tie_list);
                        get_random_order((num_index_ties div 2), ordered_tie_list);
                        current_tie_index := current_tie_value^.first_index;
                        for loop := 1 to (num_index_ties div 2) do
                            begin
                                current_tie_index^.rank := ordered_tie_list^[loop];
                                current_tie_index := current_tie_index^.next;
                            end;

                    {The above did non-complements.  Now attach rank to complements.  Since  a single point will never}
                    {   lead to both a point and its complement, complements can be given the same rank as the non-Cs.}
                    {But, complements are in reverse order, so go backwards through the list.}
                        for loop := (num_index_ties div 2) downto 1 do
                            begin
                                current_tie_index^.rank := ordered_tie_list^[loop];
                                current_tie_index := current_tie_index^.next;
                            end;
                    {Get rid of ordered tie list}
                        dispose(ordered_tie_list);
                    { Now have a rank number attached to each index tied for this value.}
                    {   It's totally arbitrary, so treat 1 as worst rank, and high number (num_index_ties div 2) as best rank.  }

                    end;                        {best_adj not already on list;  Section 1B, 1C, 1D.  }

                    {After the above sections, "current_tie_value" points to the proper value in the main tied_point}
                    {  list.  }

            {2.  Now determine what the best value from the index list of those on the tied_points array}
            {   Return this index in best_from_tied_situation.  }
                best_rank := 0;

                for loop := 1 to num_tied_points do
                    begin                   {find the rank of this point; if better than the best rank seen so far, make it max.}
                        current_tie_index := current_tie_value^.first_index;
                        while (current_tie_index <> nil) & (current_tie_index^.index <> tied_points[loop]) do
                {short circuit and}
                            current_tie_index := current_tie_index^.next;
                        if current_tie_index = nil then
                            writeln('Error in find best tie - loop to match tie list with pointer structer was nil.');
                        if current_tie_index^.rank > best_rank then
                            begin
                                best_rank := current_tie_index^.rank;
                                best_from_tied_situation := tied_points[loop];
                            end;                {if > best}
                    end;                    { for loop}


            end;                            {Max > potential start_config.  }

    end;                {function best from tie}

                {-----------------------}

    function best_neighbor (a_config: longint): longint;

            {Given an input configuration number, this will figure out the best adjacent and return its number}
            {  Best is the lowest point.  If this ever changes, also change the message at the top of the output file.  }
        var
            best_adjacent_alliance, next_alliance: longint;
            ties_for_best: boolean;
            x: integer;

    begin
        ties_for_best := false;
        best_adjacent_alliance := a_config;
                            {This sets the initial max as the alliance itself, the first neighbor}
        for x := 0 to num_countries - 1 do
            begin           {Take as best the neighbor with the best (lowest) energy.}
                {if strictly lesser energy, then it's the optima.  This will take the best of the adjacent points, so it}
                {implicitly includes steepest descent.  }
                next_alliance := BitXor(a_config, intpower(2, x));
                if (potential_alliances^[next_alliance].energy < potential_alliances^[best_adjacent_alliance].energy) then
                    begin
                        ties_for_best := false;
                        best_adjacent_alliance := next_alliance
                    end
                else                    { if equal energy}
                    if (potential_alliances^[next_alliance].energy = potential_alliances^[best_adjacent_alliance].energy) then
                        begin
                        {Because it is ugly,  call another proc with all the tied situation stuff in it.}
                            ties_for_best := true;
                        end
                    else                    {greater energy; potential[next] > potential[best]}
                        begin
                    {No switch of best adjacent}
                        end;
            end;
                {Now have the max adj. in best_adjacent_alliance, unless there was a tie.}

        if ties_for_best = true then
            best_neighbor := best_from_tied_situation(a_config, best_adjacent_alliance)
        else
            best_neighbor := best_adjacent_alliance

    end;                            {function best_neighbor}

                            {------------------------------}

    function basin_size (an_index: longint): longint;
                {checks if a point is really an optimum;  if not, size=0;  if it is, searches for the proper size on list.}
        var
            location: integer;
    begin
        if potential_alliances^[an_index].local_opt <> an_index then
            basin_size := 0
        else
            begin
                location := 0;
                repeat
                    location := location + 1;
                until (an_index = optimum_array[location].index) or (location >= num_optima) or (location >= max_optima);
                if ((location >= max_optima) or (location >= num_optima)) and (an_index <> optimum_array[location].index) then
                    begin
                        basin_size := -1;
     {writeln('Error in proc basin_size -- location exceeded number of optima in list');}
    {This used to write above message, but since this (loc >= num) will happen anytime more than num_optima are }
    {  found, it no longer writes anything.  The message that more than the acceptable number of optima were found is }
    {   printed from the main calculate procedure.  This does need to set the basin size as missing, though.}
                    end
                else                        {OK - have position in list}
                    begin
                        basin_size := optimum_array[location].basin_size;
                    end;
            end;                    {max = index begin}
    end;                        {func basin_size}

{     -------------------------------------------   }

    function adjacency_status (anindex: longint): point_condition_type;
                    {function checks the nearby points of a point to determine if it is on a saddle, or on }
{               an upper plateau or lower valley floor of the landscape.  Returns the "maybe" categories of the type}
{               if a search of one point off the equal points still has further equal points off it.}
        var
            x1, x2: integer;
            next_alliance: longint;
            higher_adj, lower_adj, lower_immediate_adj, higher_immediate_adj, equal_removed_adj, equal_adj: boolean;

    begin
        higher_adj := false;
        lower_adj := false;         {Want lower to tell if can get to lower off an equal point...}
        equal_adj := false;
        lower_immediate_adj := false;
        higher_immediate_adj := false;
        equal_removed_adj := false;
        for x1 := 0 to num_countries - 1 do
            begin
                next_alliance := BitXor(anindex, intpower(2, x));
                if potential_alliances^[next_alliance].energy > potential_alliances^[anindex].energy then
                    higher_immediate_adj := true            {This could be true.}
                else if potential_alliances^[next_alliance].energy < potential_alliances^[anindex].energy then
                    lower_immediate_adj := true         {Should never find this}
                else if potential_alliances^[next_alliance].energy = potential_alliances^[anindex].energy then
                    begin
                        equal_adj := true;
                    {Also check to see if points off this equal point are higher or lower...}
                        for x2 := 0 to num_countries - 1 do
                            begin
                                if potential_alliances^[BitXor(next_alliance, intpower(2, x))].energy > potential_alliances^[next_alliance].energy then
                                    higher_adj := true;         {This could be true.}
                                if potential_alliances^[BitXor(next_alliance, intpower(2, x))].energy < potential_alliances^[next_alliance].energy then
                                    lower_adj := true;          {This could be true.}
                                if (potential_alliances^[BitXor(next_alliance, intpower(2, x))].energy = potential_alliances^[next_alliance].energy) and (BitXor(next_alliance, intpower(2, x)) <> anindex) then
                                    equal_removed_adj := true;      {Check for equal, but make sure its not saying that My equal adjacent has }
                                                        { an equal adjacent which is me...}
                            end;                    {x2 loop}
                    end;                {else if}
            end;                            {x1 loop}

        if higher_immediate_adj = true then
            higher_adj := true;

        if (lower_immediate_adj = true) then
            writeln('Error in adjacency status - found an immediately adjacent point lower than an optimum.');

        if (lower_adj = true) and (higher_adj = true) then          {This is definitely true}
            adjacency_status := saddle
        else if (lower_adj = true) and (higher_adj = false) and (equal_removed_adj = false) then        {definitely true}
            adjacency_status := plateau
        else if (lower_adj = false) and (higher_adj = true) and (equal_removed_adj = false) then        {definitely true}
            adjacency_status := floor
        else if (lower_adj = true) and (higher_adj = false) then        {but could be a saddle if further search would find a higher}
            adjacency_status := maybe_plateau
        else if (lower_adj = false) and (higher_adj = true) then        {but could be a saddle if further search would find lower}
            adjacency_status := maybe_floor

        else if (equal_adj = true) and (higher_adj = false) and (lower_adj = false) then
            adjacency_status := unknown;
    end;                {func. adj_status}

{     -------------------------------------------   }

    function adjacent_optima (index1, index2: longint): boolean;
                {returns true if two optima are adjacent to each other.}
        var
            x: integer;
            ao: boolean;
    begin
        ao := false;
        x := 0;
        repeat
            if BitXor(index2, intpower(2, x)) = index1 then
                ao := true;
            x := x + 1;
        until (ao = true) or (x = num_countries);
        adjacent_optima := ao;
    end;

{     -------------------------------------------   }

    function alliance_rep (frombool: boolean): integer;
    begin
        if frombool = true then
            alliance_rep := 1
        else if frombool = false then
            alliance_rep := 0
        else
            writeln('error in function alliance rep');
    end;                    {func alliance_rep}

                            {------------------------------}

end.                {implementation;   and unit}

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.