{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}
University of Michigan Program for the Study of Complex Systems
Contact http@maria.physics.lsa.umich.edu.
Revised November 4, 1996.