{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.