{This contains the output procedures for Alliance_Sim}
unit Alliance_Sim_Output_Unit;
interface
uses
alliance_sim_type_unit;
procedure write_output (potential_alliances: potential_alliance_type; top_alliance: longint; num_countries: integer; country_names: c_name_type; propensities: propensity_type; inputfilename: filenametype; datetime: datetimerec; best_energy_alliance: longint; tied_optima: integer; permuted_propensities: propensity_type; index_array: permuted_index_type; tied_optima_array: tied_opt_list_type; main_comment: main_comment_type; run_number: integer; have_starting_alliance: boolean; starting_alliance: starting_alliance_type; frustration_array: frustration_array_type; optimum_array: optimum_array_type; num_optima: integer);
procedure write_complete_output_to_file (potential_alliances: potential_alliance_type; top_alliance: longint; num_countries: integer; country_names: c_name_type; propensities: propensity_type; var outfile: text; inputfilename, outputfilename: filenametype; datetime: datetimerec; best_energy_alliance: longint; tied_optima: integer; permuted_propensities: propensity_type; index_array: permuted_index_type; tied_optima_array: tied_opt_list_type; main_comment: main_comment_type; run_number, num_raw_lines: integer; raw_data_from_prop_file: raw_from_prop_type; have_starting_alliance: boolean; starting_alliance: starting_alliance_type; frustration_array: frustration_array_type; optimum_array: optimum_array_type; num_optima: integer);
{ ------------------------------------------------------------- }
implementation
procedure write_output (potential_alliances: potential_alliance_type; top_alliance: longint; num_countries: integer; country_names: c_name_type; propensities: propensity_type; inputfilename: filenametype; datetime: datetimerec; best_energy_alliance: longint; tied_optima: integer; permuted_propensities: propensity_type; index_array: permuted_index_type; tied_optima_array: tied_opt_list_type; main_comment: main_comment_type; run_number: integer; have_starting_alliance: boolean; starting_alliance: starting_alliance_type; frustration_array: frustration_array_type; optimum_array: optimum_array_type; num_optima: integer);
var
current_alliance, current_index: longint;
x, y: integer;
current_basin: integer;
first_optimum, second_optimum: integer;
point_condition: point_condition_type;
procedure write_header;
var
x: integer;
begin
write('Index ' : 8, 'Alliance_Rep ' : 14);
for x := 7 to max_countries do
write('' : 1, ' ');
writeln('Energy Local_Opt Basin_Size');
end;
procedure write_full_alliance (analliance: one_potential_alliance; alliance_index: longint);
{output alliance info including translation to country names}
var
country, y: integer;
begin
write(alliance_index : 5, ' ' : 3);
{there are max-countries bits to represent. want to print bits max-1 to 0.}
for country := 1 to num_countries do
write(alliance_rep(btst(alliance_index, bit(country))) : 2);
for y := num_countries to max_countries do
write(' ' : 2); {format output}
write(analliance.energy : 6 : 2, ' ');
write(analliance.local_opt : 4, ' ');
write(basin_size(alliance_index) : 4);
writeln;
write(' Alliance 1: ');
for country := 1 to num_countries do
begin
if btst(alliance_index, bit(country)) = false then
write(country_names[country], ' ');
end;
writeln;
write(' Alliance 2: ');
for country := 1 to num_countries do
begin
if btst(alliance_index, bit(country)) = true then
write(country_names[country], ' ');
end;
writeln;
writeln;
end;
procedure write_brief_alliance (analliance: one_potential_alliance; alliance_index: longint);
{write alliance info but no country names}
var
country, y: integer;
begin
write(alliance_index : 5, ' ' : 3);
for country := 1 to num_countries do
write(alliance_rep(btst(alliance_index, bit(country))) : 2);
for y := num_countries to max_countries do
write(' ' : 2); {format output}
write(analliance.energy : 6 : 2, ' ');
write(analliance.local_opt : 4, ' ');
write(basin_size(alliance_index) : 4);
writeln;
end;
begin {main procedure write output}
{Write header info}
writeln;
writeln;
writeln('Run from program Alliance_Sim, version ', version : 4 : 2);
writeln(' In this version: ');
writeln(' A) energy is being minimized, and ');
writeln(' B) within alliance distance is 0 while between alliance distance is 1 ');
writeln('Run Number ', run_number : 4);
writeln('Input file was ', inputfilename);
writeln;
for x := 1 to main_comment.num_lines do
writeln(main_comment.lines[x]);
writeln;
writeln;
{first Echo initial data}
writeln('There are ', num_countries : 3, ' countries in this run of the simulation');
for x := 1 to num_countries do
writeln('country ', x : 3, ': ', country_names[x]);
writeln;
writeln;
writeln('Initial Propensity * Size Matrix is :');
writeln;
write(' ');
for x := 1 to num_countries do
write(x : 4, ' ');
writeln;
writeln;
for x := 1 to num_countries do
begin
write(x : 2, ' ', country_names[x] : 8, chr(9), ' ');
for y := 1 to num_countries do
begin
write(propensities[x, y] : 5 : 1, ' ');
end;
writeln;
writeln;
end;
writeln;
writeln;
writeln('Global optimum alliance : ');
write_header;
write_full_alliance(potential_alliances^[best_energy_alliance], best_energy_alliance);
{Tied optimum is a global count, doubled from the complete list reported in output. So report as half...}
{ I changed the next lines 11/6/90 b/c of checks in calculate that tell me this is exactly a double cnt.}
{ Should be able to divide in half to drop complements, and then subtract one to get OTHERs only}
writeln(((tied_optima) div 2 - 1) : 3, ' _other_ alliance(s) [in the reported half] had the same energy.');
if (tied_optima) div 2 - 1 > 0 then
writeln('They/it will be reported later in the printout.');
writeln;
{display permuted propensity matrix}
writeln('Permuted Propensity * Size Matrix is :');
writeln;
write(' ');
for x := 1 to num_countries do
write(index_array[x] : 4, ' ');
writeln;
writeln;
for x := 1 to num_countries do
begin
write(index_array[x] : 2, ' ', country_names[index_array[x]] : 8, chr(9), ' ');
for y := 1 to num_countries do
begin
write(permuted_propensities[x, y] : 5 : 1, ' ');
end;
writeln;
writeln;
end;
writeln;
writeln;
if (num_optima div 2) = 1 then
writeln('There is', (num_optima div 2) : 3, ' optimum in the non-complement half. It is: ')
else
writeln('There are ', (num_optima div 2) : 3, ' optima in the non-complement half. They are: ');
{ report those basins that are > 0, but NOT complements.}
write_header;
for current_basin := 1 to (min(num_optima, max_optima)) do
if not a_complement(optimum_array[current_basin].index) then
write_full_alliance(potential_alliances^[optimum_array[current_basin].index], optimum_array[current_basin].index);
writeln;
writeln;
writeln(' Complementary basins are not being reported ');
writeln('Frustrations of all countries at the starting alliance and (non-complement) optima are: ');
writeln(' These are frustrations defined as Frust(i)= Sum over j<>i of Prop(i,j)*Size(j)*Dist(i,j)');
writeln;
write('Index =' : 10, ' ');
write(' Start/' : 8, starting_alliance.index : 5, ' ' : 1); {This is spot 0 on basin list}
for x := 1 to (min(num_optima, max_optima)) do
if not a_complement(optimum_array[x].index) then
write(optimum_array[x].index : 10);
writeln;
writeln;
for x := 1 to num_countries do {for each country}
begin
write(country_names[x] : 10, ' ');
if have_starting_alliance then
write(frustration_array[x, 0] : 14 : 2, ' ')
else
write(' -- ' : 14);
for y := 1 to (min(num_optima, max_optima)) do {do for each basin}
{print its frustration}
if not a_complement(optimum_array[y].index) then
write(frustration_array[x, y] : 10 : 2, ' ');
writeln;
end; {for x}
writeln;
writeln;
{Now report tied for optimum alliances}
if (tied_optima div 2) - 1 > 0 then {so at least one in this half different than global}
begin
if tied_optima <= max_tied_optima then
writeln('Alliances tied for global optimum in the non-complement group are: ')
else
begin
writeln('More than ', max_tied_optima : 3, ' ties for global optima were found. ');
writeln('The first ', max_tied_optima : 3, ' alliances in the non-complement group are: ');
end;
write_header;
for x := 1 to (min(max_tied_optima, tied_optima)) do
if not a_complement(tied_optimum_array[x]) then
write_brief_alliance(potential_alliances^[tied_optimum_array[x]], tied_optimum_array[x]);
end;
writeln;
{Now write information about where the starting config is moving}
if have_starting_alliance then
begin
write_header;
writeln('Starting alliance configuration :');
write_brief_alliance(potential_alliances^[starting_alliance.index], starting_alliance.index);
writeln('This structure has as its local optimum : ');
write_brief_alliance(potential_alliances^[potential_alliances^[starting_alliance.index].local_opt], potential_alliances^[starting_alliance.index].local_opt);
writeln('Path from starting configuration to the local optimum was : ');
current_index := starting_alliance.index;
{write first}
write_brief_alliance(potential_alliances^[current_index], current_index);
{now write rest}
repeat
current_index := best_neighbor(current_index);
write_brief_alliance(potential_alliances^[current_index], current_index);
until current_index = potential_alliances^[starting_alliance.index].local_opt;
end;
writeln;
writeln;
{Now check basins for any special characteristics and print them.}
{ Looking for adjacent optima (actually in same basin) or one point optima.}
write_header;
for first_optimum := 1 to (min(num_optima, max_optima) - 1) do
for second_optimum := first_optimum + 1 to (min(num_optima, max_optima)) do
if not a_complement(optimum_array[first_optimum].index) then
if not a_complement(optimum_array[second_optimum].index) then
if adjacent_optima(optimum_array[second_optimum].index, optimum_array[first_optimum].index) then
begin
writeln('Optima ', optimum_array[first_optimum].index : 5, ' and ', optimum_array[second_optimum].index : 5, ' are adjacent and in the same basin.');
point_condition := adjacency_status(optimum_array[first_optimum].index);
if point_condition = saddle then
writeln(' Optimum ', optimum_array[first_optimum].index : 5, ' is on a saddle.')
else if point_condition = floor then
writeln(' Optimum ', optimum_array[first_optimum].index : 5, ' is on the floor of a valley.')
else if point_condition = plateau then
writeln(' Optimum ', optimum_array[first_optimum].index : 5, ' is a point on a plateau.')
else if point_condition = maybe_floor then
writeln(' Optimum ', optimum_array[first_optimum].index : 5, ' may be (only a 1 level search was done) on the floor of a valley.')
else if point_condition = maybe_plateau then
writeln(' Optimum ', optimum_array[first_optimum].index : 5, ' may be (only a 1 level search was done) a point on a plateau.')
else if point_condition = unknown then
writeln(' Optimum ', optimum_array[first_optimum].index : 5, 'has a status on floor , plateau , or saddle cannot be determined . ')
else
writeln('ERROR in return from adjacency_status procedure');
point_condition := adjacency_status(optimum_array[second_optimum].index);
if point_condition = saddle then
writeln(' Optimum ', optimum_array[second_optimum].index : 5, ' is on a saddle.')
else if point_condition = floor then
writeln(' Optimum ', optimum_array[second_optimum].index : 5, ' is on the floor of a valley.')
else if point_condition = plateau then
writeln(' Optimum ', optimum_array[second_optimum].index : 5, ' is a point on a plateau.')
else if point_condition = maybe_floor then
writeln(' Optimum ', optimum_array[second_optimum].index : 5, ' may be (only a 1 level search was done) on the floor of a valley.')
else if point_condition = maybe_plateau then
writeln(' Optimum ', optimum_array[second_optimum].index : 5, ' may be (only a 1 level search was done) a point on a plateau.')
else if point_condition = unknown then
writeln(' Optimum ', optimum_array[second_optimum].index : 5, 'has a status on floor , plateau , or saddle cannot be determined . ')
else
writeln('ERROR in return from adjacency_status procedure');
writeln;
end; {big if if if if begin}
writeln;
writeln;
for first_optimum := 1 to (min(num_optima, max_optima)) do
if optimum_array[first_optimum].basin_size = 1 then
begin
write('Optimum ', optimum_array[first_optimum].index : 5, ' is a one-point optimum ');
point_condition := adjacency_status(optimum_array[first_optimum].index);
if point_condition = saddle then
writeln('which is on a saddle.')
else if point_condition = floor then
writeln('which is on the floor of a valley.')
else if point_condition = plateau then
writeln('which is a point on a plateau.')
else if point_condition = maybe_floor then
writeln('which may be (only a 1 level search was done) on the floor of a valley.')
else if point_condition = maybe_plateau then
writeln('which may be (only a 1 level search was done) a point on a plateau.')
else if point_condition = unknown then
writeln('whose status on floor, plateau, or saddle cannot be determined.')
else
writeln('ERROR in return from adjacency_status procedure');
writeln;
writeln;
end; {if basin_size = 1}
end; {procedure write output}
{------------------------------}
procedure get_top_50 (var first_of_50: full_rec_ptr);
{Puts top 50 of the non-complement half onto the list.}
var
current_alliance: longint;
current_ptr, last_ptr: full_rec_ptr;
num_on: integer;
blank_ptr: full_rec_ptr;
worst_energy: real;
begin
new(first_of_50);
first_of_50^.index := 0;
first_of_50^.energy := potential_alliances^[first_of_50^.index].energy;
first_of_50^.next := nil;
first_of_50^.prev := nil;
num_on := 1;
last_ptr := first_of_50;
worst_energy := potential_alliances^[first_of_50^.index].energy;
for current_alliance := 1 to (top_alliance div 2) do
begin
if (potential_alliances^[current_alliance].energy <= worst_energy) or (num_on < 50) then
begin
current_ptr := first_of_50;
while (current_ptr^.next <> nil) and (potential_alliances^[current_alliance].energy >= current_ptr^.energy) do
current_ptr := current_ptr^.next;
if (current_ptr = first_of_50) and (potential_alliances^[current_alliance].energy < current_ptr^.energy) then
begin {insert before first record is different.}
new(blank_ptr);
blank_ptr^.index := current_alliance;
blank_ptr^.energy := potential_alliances^[current_alliance].energy;
blank_ptr^.next := current_ptr;
blank_ptr^.prev := nil;
current_ptr^.prev := blank_ptr;
num_on := num_on + 1;
first_of_50 := blank_ptr;
if num_on > 50 then
begin {inserted, over 50, now want to drop the last record on the list}
current_ptr := last_ptr;
last_ptr := last_ptr^.prev;
last_ptr^.next := nil;
dispose(current_ptr);
num_on := num_on - 1;
worst_energy := potential_alliances^[last_ptr^.index].energy;
end;
end
else if potential_alliances^[current_alliance].energy < current_ptr^.energy then
begin {insert before this record, in the same way if it's last or somewhere else on the list.}
{This is somewhere in the middle, b/c separated out first record case above, and can't}
{be the last record b/c energy is greater than the next record.}
new(blank_ptr);
blank_ptr^.index := current_alliance;
blank_ptr^.energy := potential_alliances^[current_alliance].energy;
blank_ptr^.next := current_ptr;
blank_ptr^.prev := current_ptr^.prev;
current_ptr^.prev^.next := blank_ptr;
current_ptr^.prev := blank_ptr;
num_on := num_on + 1;
if num_on > 50 then
begin {inserted, now want to drop the last record on the list}
current_ptr := last_ptr;
last_ptr := last_ptr^.prev;
last_ptr^.next := nil;
dispose(current_ptr);
num_on := num_on - 1;
worst_energy := potential_alliances^[last_ptr^.index].energy;
end;
end
else if current_ptr^.next = nil then {at last record and inserting after the last}
if num_on < 50 then {if already have 50 better than this, don't add it.}
begin
new(blank_ptr);
blank_ptr^.index := current_alliance;
blank_ptr^.energy := potential_alliances^[current_alliance].energy;
blank_ptr^.next := nil;
blank_ptr^.prev := current_ptr;
current_ptr^.next := blank_ptr;
num_on := num_on + 1;
last_ptr := blank_ptr;
worst_energy := potential_alliances^[last_ptr^.index].energy;
end;
end; {if energy < ___ or num < 50}
end; {for alliance 1 to top div 2}
end; {procedure get top 50}
{ ---------------------------------------------------- }
procedure write_complete_output_to_file (potential_alliances: potential_alliance_type; top_alliance: longint; num_countries: integer; country_names: c_name_type; propensities: propensity_type; var outfile: text; inputfilename, outputfilename: filenametype; datetime: datetimerec; best_energy_alliance: longint; tied_optima: integer; permuted_propensities: propensity_type; index_array: permuted_index_type; tied_optima_array: tied_opt_list_type; main_comment: main_comment_type; run_number, num_raw_lines: integer; raw_data_from_prop_file: raw_from_prop_type; have_starting_alliance: boolean; starting_alliance: starting_alliance_type; frustration_array: frustration_array_type; optimum_array: optimum_array_type; num_optima: integer);
var
current_alliance, current_index: longint;
x, y: integer;
complement_set: boolean;
extra_basin: one_potential_alliance;
current_basin: integer;
first_optimum, second_optimum: integer;
point_condition: point_condition_type;
limit: integer;
procedure write_header;
var
x: integer;
begin
write(outfile, 'Index ', chr(9), 'Alliance_Rep ');
for x := 1 to 12 do
write(outfile, chr(9));
writeln(outfile, chr(9), ' Energy', chr(9), ' Local_Opt', chr(9), 'Basin_Size ');
end;
procedure write_full_alliance (analliance: one_potential_alliance; alliance_index: longint);
{output alliance info including translation to country names}
var
country, y: integer;
begin
write(outfile, alliance_index : 7, chr(9));
{there are max-countries bits to represent. want to print bits max-1 to 0.}
for country := 1 to num_countries do
write(outfile, alliance_rep(btst(alliance_index, bit(country))) : 1, chr(9));
for y := num_countries to 16 do {This was num to max, but the format in Word format file set for 16}
write(outfile, chr(9)); {format output}
write(outfile, analliance.energy : 6 : 2, chr(9));
write(outfile, analliance.local_opt : 4, chr(9));
write(outfile, basin_size(alliance_index) : 4);
writeln(outfile);
writeln(outfile);
write(outfile, ' Alliance 1: ');
for country := 1 to num_countries do
begin
if btst(alliance_index, bit(country)) = false then
write(outfile, country_names[country], chr(9));
end;
writeln(outfile);
write(outfile, ' Alliance 2: ');
for country := 1 to num_countries do
begin
if btst(alliance_index, bit(country)) = true then
write(outfile, country_names[country], chr(9));
end;
writeln(outfile);
writeln(outfile);
end;
procedure write_brief_alliance (analliance: one_potential_alliance; alliance_index: longint);
{write alliance info but no country names}
var
country, y: integer;
begin
write(outfile, alliance_index : 7, chr(9));
{there are max-countries bits to represent. want to print bits max-1 to 0.}
for country := 1 to num_countries do
write(outfile, alliance_rep(btst(alliance_index, bit(country))) : 1, chr(9));
for y := num_countries to 16 do {This was num to max, but the format in Word format file set for 16}
write(outfile, chr(9)); {format output}
write(outfile, analliance.energy : 6 : 2, chr(9));
write(outfile, analliance.local_opt : 4, chr(9));
write(outfile, basin_size(alliance_index) : 4);
writeln(outfile);
end;
{-----------------------}
begin
rewrite(outfile, outputfilename);
{Write header info}
write(outfile, 'Run from program Alliance_Sim, version ', version : 6 : 3, ' ', datetime.month : 2, '/', datetime.day : 2, '/', (datetime.year - 1900) : 2);
write(outfile, ' ', datetime.hour : 2, ':');
if datetime.minute < 10 then
writeln(outfile, '0', datetime.minute : 1)
else
writeln(outfile, datetime.minute : 2);
writeln(outfile, ' In this version: ');
writeln(outfile, ' A) energy is being minimized, and ');
writeln(outfile, ' B) within alliance distance is 0 while between alliance distance is 1 ');
writeln(outfile, ' Run Number ', run_number : 4);
writeln(outfile, ' Input file was ', inputfilename);
writeln(outfile);
for x := 1 to main_comment.num_lines do
writeln(outfile, main_comment.lines[x]);
writeln(outfile);
writeln(outfile);
if num_raw_lines > 0 then
begin
writeln(outfile, 'Propensity data came from raw input. The data which generated propensities are:');
for x := 1 to num_raw_lines do
writeln(outfile, raw_data_from_prop_file[x]);
writeln(outfile);
writeln(outfile);
end;
writeln(outfile, 'Initial Propensity*Size Matrix (that is, P(ij)*S(i)*S(j)) is :');
writeln(outfile);
for x := 1 to 3 do
write(outfile, chr(9));
for x := 1 to num_countries do
write(outfile, x : 3, chr(9));
writeln(outfile);
writeln(outfile);
for x := 1 to num_countries do
begin
write(outfile, chr(9), x : 2, chr(9), country_names[x] : 8, chr(9));
for y := 1 to num_countries do
begin
write(outfile, propensities[x, y] : 5 : 1, chr(9));
end;
writeln(outfile);
writeln(outfile);
end;
writeln(outfile);
writeln(outfile);
writeln(outfile, 'Global optimum alliance structure : ');
write_header;
write_full_alliance(potential_alliances^[best_energy_alliance], best_energy_alliance);
{Tied optimum is a global count, doubled from the complete list reported. So make it half...}
{As noted in write_output above, this is slightly changed from previous version 11/6/90.}
writeln(outfile, ((tied_optima div 2) - 1) : 3, ' _other_ alliance(s) had the same energy (in the reported half).');
if (tied_optima div 2) - 1 > 0 then
writeln(outfile, 'They/it will be reported later in the printout.');
writeln(outfile);
writeln(outfile, 'Permuted Propensity * Size Matrix is :');
writeln(outfile);
for x := 1 to 3 do
write(outfile, chr(9));
for x := 1 to num_countries do
write(outfile, index_array[x] : 3, chr(9));
writeln(outfile);
writeln(outfile);
for x := 1 to num_countries do
begin
write(outfile, chr(9), index_array[x] : 2, chr(9), country_names[index_array[x]] : 8, chr(9));
for y := 1 to num_countries do
begin
write(outfile, permuted_propensities[x, y] : 5 : 1, chr(9));
end;
writeln(outfile);
writeln(outfile);
end;
writeln(outfile);
writeln(outfile);
writeln(outfile);
if (num_optima div 2) = 1 then
writeln(outfile, 'There is', (num_optima div 2) : 3, ' optimum in the non-complement half. It is: ')
else
begin
if num_optima > max_optima then {write message }
begin
writeln(outfile, 'There are ', (num_optima div 2) : 3, ' optima in the non-complement half. ');
writeln(outfile, ' **Note: more than ', max_optima : 3, ' optima were seen. The program can only handle ', max_optima : 3, ' in both halves. Others were ignored.');
writeln(outfile);
writeln(outfile, ' The first ', max_optima : 3, ' optima are: ');
writeln(outfile);
end
else
writeln(outfile, 'There are ', (num_optima div 2) : 3, ' optima in the non-complement half. They are: ');
end;
{ report those non-complement basins that are > 0. They are ordered by energy in calculate.}
{now output them, first 0 start, then complements}
write_header;
for current_basin := 1 to (min(num_optima, max_optima)) do
if not (a_complement(optimum_array[current_basin].index)) then
write_full_alliance(potential_alliances^[optimum_array[current_basin].index], optimum_array[current_basin].index);
writeln(outfile);
writeln(outfile, ' Complementary optima of those already seen will not be reported here. ');
writeln(outfile);
writeln(outfile);
writeln(outfile, 'Frustrations of all countries at the starting alliance and (non-complement) optima are: ');
writeln(outfile, ' These are frustrations defined as Frust(i)= Sum over j<>i of Prop(i,j)*Size(j)*Dist(i,j)');
if (num_optima <= max_frust_to_print) and (num_optima <= max_optima) then
begin
{no additional message}
limit := num_optima;
end
else if (max_frust_to_print < num_optima) and (max_frust_to_print < max_optima) then
begin
limit := max_frust_to_print;
writeln(outfile, ' Due to program limits on how many frustrations are to be printed, ');
writeln(outfile, ' frustrations at a maximum of ', max_frust_to_print, ' optima can be printed.');
end
else if (max_optima < num_optima) and (max_optima < max_frust_to_print) then
begin
limit := max_optima;
writeln(outfile, ' Due to program limits on how many optima can be stored, only ');
writeln(outfile, ' frustrations at a maximum of ', max_frust_to_print, ' optima can be printed.');
end;
write(outfile, 'Alliance' : 15, chr(9));
write(outfile, ' Start=', starting_alliance.index : 2, chr(9));
for x := 1 to (limit) do
if not (a_complement(optimum_array[x].index)) then
write(outfile, optimum_array[x].index : 6, chr(9));
writeln(outfile);
writeln(outfile);
for x := 1 to num_countries do {for each country}
begin
write(outfile, country_names[x] : 15, chr(9));
if have_starting_alliance then
write(outfile, frustration_array[x, 0] : 9 : 2, chr(9))
else
write(outfile, ' -- ' : 9, chr(9));
for y := 1 to (limit) do {do for each basin}
begin {print its frustration}
if not (a_complement(optimum_array[y].index)) then
write(outfile, frustration_array[x, y] : 6 : 2, chr(9));
end;
writeln(outfile);
end; {for x}
writeln(outfile);
writeln(outfile);
if (tied_optima div 2) - 1 > 0 then {at least one different than global}
begin
if tied_optima <= max_tied_optima then
writeln(outfile, 'Non-complement alliances tied for global optimum are: ')
else
begin
writeln(outfile, 'More than ', max_tied_optima : 3, ' alliances with energy equal to the global optimum were found. ');
writeln(outfile, 'The first ', max_tied_optima : 3, ' of these in the non-complement group are: ');
end;
write_header;
for x := 1 to (min(max_tied_optima, tied_optima)) do
if not (a_complement(tied_optimum_array[x])) then
write_brief_alliance(potential_alliances^[tied_optimum_array[x]], tied_optimum_array[x]);
writeln(outfile);
writeln(outfile);
end; {if tied_opt > 2 then}
{now output starting alliance info, if there is any}
if have_starting_alliance then
begin
Writeln(outfile, 'Starting alliance configuration :');
write_header;
write_full_alliance(potential_alliances^[starting_alliance.index], starting_alliance.index);
writeln(outfile, 'Path from starting configuration to the local optima was : ');
{write first}
current_index := starting_alliance.index;
write_brief_alliance(potential_alliances^[current_index], current_index);
{now write rest}
repeat
current_index := best_neighbor(current_index);
write_brief_alliance(potential_alliances^[current_index], current_index);
until current_index = potential_alliances^[starting_alliance.index].local_opt;
end;
writeln(outfile);
writeln(outfile);
{Now check basins for any special characteristics and print them.}
{ Looking for adjacent optima (actually in same basin) or one point optima.}
for first_optimum := 1 to (min(num_optima, max_optima) - 1) do
for second_optimum := first_optimum + 1 to (min(num_optima, max_optima)) do
if not a_complement(optimum_array[first_optimum].index) then
if not a_complement(optimum_array[second_optimum].index) then
if adjacent_optima(optimum_array[second_optimum].index, optimum_array[first_optimum].index) then
begin
writeln(outfile, 'Optima ', optimum_array[first_optimum].index : 5, ' and ', optimum_array[second_optimum].index : 5, ' are adjacent and in the same basin.');
point_condition := adjacency_status(optimum_array[first_optimum].index);
if point_condition = saddle then
writeln(outfile, ' Optimum ', optimum_array[first_optimum].index : 5, ' is on a saddle.')
else if point_condition = floor then
writeln(outfile, ' Optimum ', optimum_array[first_optimum].index : 5, ' is on the floor of a valley.')
else if point_condition = plateau then
writeln(outfile, ' Optimum ', optimum_array[first_optimum].index : 5, ' is a point on a plateau.')
else if point_condition = maybe_floor then
writeln(outfile, ' Optimum ', optimum_array[first_optimum].index : 5, ' may be (only a 1 level search was done) on the floor of a valley.')
else if point_condition = maybe_plateau then
writeln(outfile, ' Optimum ', optimum_array[first_optimum].index : 5, ' may be (only a 1 level search was done) a point on a plateau.')
else if point_condition = unknown then
writeln(outfile, ' Optimum ', optimum_array[first_optimum].index : 5, 'has a status on floor , plateau , or saddle cannot be determined . ')
else
writeln('ERROR in return from adjacency_status procedure');
point_condition := adjacency_status(optimum_array[second_optimum].index);
if point_condition = saddle then
writeln(outfile, ' Optimum ', optimum_array[second_optimum].index : 5, ' is on a saddle.')
else if point_condition = floor then
writeln(outfile, ' Optimum ', optimum_array[second_optimum].index : 5, ' is on the floor of a valley.')
else if point_condition = plateau then
writeln(outfile, ' Optimum ', optimum_array[second_optimum].index : 5, ' is a point on a plateau.')
else if point_condition = maybe_floor then
writeln(outfile, ' Optimum ', optimum_array[second_optimum].index : 5, ' may be (only a 1 level search was done) on the floor of a valley.')
else if point_condition = maybe_plateau then
writeln(outfile, ' Optimum ', optimum_array[second_optimum].index : 5, ' may be (only a 1 level search was done) a point on a plateau.')
else if point_condition = unknown then
writeln(outfile, ' Optimum ', optimum_array[second_optimum].index : 5, 'has a status on floor , plateau , or saddle cannot be determined . ')
else
writeln('ERROR in return from adjacency_status procedure');
writeln(outfile);
end; {big if if if if begin}
writeln(outfile);
writeln(outfile);
for first_optimum := 1 to (min(num_optima, max_optima)) do
if optimum_array[first_optimum].basin_size = 1 then
begin
write(outfile, 'Optimum ', optimum_array[first_optimum].index : 5, ' is a one-point optimum ');
point_condition := adjacency_status(optimum_array[first_optimum].index);
if point_condition = saddle then
writeln(outfile, 'which is on a saddle.')
else if point_condition = floor then
writeln(outfile, 'which is on the floor of a valley.')
else if point_condition = plateau then
writeln(outfile, 'which is a point on a plateau.')
else if point_condition = maybe_floor then
writeln(outfile, 'which may be (only a 1 level search was done) on the floor of a valley.')
else if point_condition = maybe_plateau then
writeln(outfile, 'which may be (only a 1 level search was done) a point on a plateau.')
else if point_condition = unknown then
writeln(outfile, 'whose status on floor, plateau, or saddle cannot be determined.')
else
writeln('ERROR in return from adjacency_status procedure');
end; {if basin_size = 1}
writeln(outfile);
writeln(outfile);
get_top_50(first_of_50);
{This proc. gets the top 50 non-complement alliances into a linked list.}
writeln(outfile, 'Top 50 (or maximum) potential alliances follow : ');
write_header;
current_ptr := first_of_50;
while current_ptr <> nil do
begin
{write one alliance structure data}
write_brief_alliance(potential_alliances^[current_ptr^.index], current_ptr^.index);
current_ptr := current_ptr^.next;
end;
close(outfile);
end; {procedure write complete output to file}
{ ------------------------------------------- }
end. {unit alliance_sim_output_unit}
University of Michigan Program for the Study of Complex Systems
Contact http@maria.physics.lsa.umich.edu.
Revised November 4, 1996.