with text_io,integer_io; use text_io,integer_io;
with Timing_Package; use Timing_Package;
with Communications_with_User; use Communications_with_User;
with File_Scanning; use File_Scanning;
with Standard_Floating_Numbers; use Standard_Floating_Numbers;
with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
with Multprec_Floating_Numbers; use Multprec_Floating_Numbers;
with Multprec_Floating_Numbers_io; use Multprec_Floating_Numbers_io;
with Standard_Complex_Numbers; use Standard_Complex_Numbers;
with Standard_Complex_Numbers_io; use Standard_Complex_Numbers_io;
with Numbers_io; use Numbers_io;
with Standard_Complex_Vectors; use Standard_Complex_Vectors;
with Standard_Complex_Vectors_io; use Standard_Complex_Vectors_io;
with Standard_Complex_Poly_Systems; use Standard_Complex_Poly_Systems;
with Standard_Complex_Poly_Systems_io; use Standard_Complex_Poly_Systems_io;
with Standard_to_Multprec_Convertors; use Standard_to_Multprec_Convertors;
with Multprec_Complex_Poly_Systems; use Multprec_Complex_Poly_Systems;
with Multprec_Complex_Poly_SysFun; use Multprec_Complex_Poly_SysFun;
with Standard_Complex_Solutions;
with Standard_Complex_Solutions_io; use Standard_Complex_Solutions_io;
with Multprec_Complex_Solutions;
with Multprec_Complex_Solutions_io; use Multprec_Complex_Solutions_io;
with Standard_Root_Refiners; use Standard_Root_Refiners;
with Multprec_Root_Refiners; use Multprec_Root_Refiners;
with Multprec_Residual_Evaluations; use Multprec_Residual_Evaluations;
with Symmetry_Group; use Symmetry_Group;
with Symbolic_Symmetry_Group_io; use Symbolic_Symmetry_Group_io;
with Drivers_for_Symmetry_Group_io; use Drivers_for_Symmetry_Group_io;
with Drivers_for_Orbits_of_Solutions; use Drivers_for_Orbits_of_Solutions;
with Driver_for_Winding_Numbers;
with valipoco;
with Bye_Bye_Message;
procedure mainvali ( infilename,outfilename : in string ) is
procedure Display_Validation_Info is
-- DESCRIPTION :
-- Displays information about available validation methods on screen.
i : array(1..9) of string(1..65);
begin
i(1):="Basic validation consists in the application of Newton's method";
i(2):="on the list of solutions. There are facilities to extract the";
i(3):="generating solutions when the symmetry group is submitted. ";
i(4):=" Winding numbers can be computed by homotopy continuation";
i(5):="methods. The user must provide a start system with solutions at";
i(6):="t < 1. ";
i(7):=" Polyhedral validation is based on the output file of poco,";
i(8):="where the polyhedral end game was turned on. This validation";
i(9):="puts up a frequency table of computed path directions. ";
for k in i'range loop
put_line(i(k));
end loop;
end Display_Validation_Info;
-- READING THE INPUT :
procedure Scan_System
( file : in out file_type; filename : in string;
lp : in out Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
sysonfile : out boolean ) is
-- DESCRIPTION :
-- Checks whether the given file name corresponds to a file with
-- a polynomial system in a correct format.
-- If this is the case, then sysonfile is true on return and lp
-- contains the system.
begin
if filename /= ""
then Open(file,in_file,filename);
get(file,lp);
sysonfile := true;
else sysonfile := false;
end if;
exception
when others =>
new_line;
put("Could not open file with name "); put_line(filename);
lp := null;
sysonfile := false;
return;
end Scan_System;
procedure Read_System
( file : in out file_type; filename : in string;
lp : in out Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
sysonfile : out boolean ) is
-- DESCRIPTION :
-- Searches first the system on file, using the given filename.
-- If necessary other files will be openend.
ans : character;
n : natural;
begin
Scan_System(file,filename,lp,sysonfile);
if lp = null
then loop
new_line;
put("Is the system on a file ? (y/n/i=info) ");
Ask_Alternative(ans,"yni");
if ans = 'i'
then new_line;
Standard_Complex_Poly_Systems_io.Display_Format;
new_line;
end if;
exit when ans /= 'i';
end loop;
new_line;
if ans = 'y'
then put_line("Reading the name of the input file.");
Read_Name_and_Open_File(file);
get(file,lp);
sysonfile := true;
n := lp'length;
else put("Give the dimension : "); get(n);
lp := new Standard_Complex_Poly_Systems.Poly_Sys(1..n);
put("Give "); put(n,1); put(" "); put(n,1);
put_line("-variate polynomials :");
get(n,lp.all);
skip_line; -- skip end_of_line symbol
sysonfile := false;
end if;
end if;
end Read_System;
procedure Scan_Solutions
( file : in out file_type; sysonfile : in boolean;
sols : in out Standard_Complex_Solutions.Solution_List;
found : out boolean ) is
fnd : boolean := false;
begin
if sysonfile
then Scan_and_Skip(file,"SOLUTIONS",fnd);
if fnd
then get(file,sols);
end if;
Close(file);
else fnd := false;
end if;
found := fnd;
exception
when others
=> put_line("Something is wrong with the solutions, will ignore...");
Close(file);
found := false;
end Scan_Solutions;
procedure Read_Solutions
( file : in out file_type; sysonfile : in boolean;
sols : in out Standard_Complex_Solutions.Solution_List ) is
found : boolean;
begin
Scan_Solutions(file,sysonfile,sols,found);
if not found
then new_line;
put_line("Reading the name of the file for the solutions.");
Read_Name_and_Open_File(file);
get(file,sols);
Close(file);
end if;
end Read_Solutions;
-- ROOT REFINING AUXILIARIES :
procedure Standard_Default_Root_Refining_Parameters
( epsxa,epsfa,tolsing : out double_float;
maxit : out natural; wout : out boolean ) is
-- DESCRIPTION :
-- Defines the default values for the root refining parameters.
begin
epsxa := 10.0**(-8); -- precision for correction on x
epsfa := 10.0**(-8); -- precision for residual
tolsing := 10.0**(-8); -- tolerance on inverse condition numbers
maxit := 3; -- maximal number of Newton iterations
wout := false; -- if intermediate output is wanted
end Standard_Default_Root_Refining_Parameters;
procedure Multprec_Default_Root_Refining_Parameters
( epsxa,epsfa,tolsing : out Floating_Number;
maxit,deci : out natural; wout : out boolean ) is
-- DESCRIPTION :
-- Defines the default values for the root refining parameters.
begin
epsxa := Create(10.0**(-8)); -- precision for correction on x
epsfa := Create(10.0**(-8)); -- precision for residual
tolsing := Create(10.0**(-8)); -- tolerance on inverse condition numbers
maxit := 3; -- maximal number of Newton iterations
deci := 16; -- number of decimal places
wout := false; -- if intermediate output is wanted
end Multprec_Default_Root_Refining_Parameters;
procedure Standard_Put_Root_Refining_Parameters
( file : in file_type; epsxa,epsfa,tolsing : in double_float;
maxit : in natural; wout : in boolean ) is
-- DESCRIPTION :
-- Writes the parameters for the root refiner on file.
begin
put(file," 1. output during the iterations : ");
if wout
then put(file," yes"); new_line(file);
else put(file," no"); new_line(file);
end if;
put(file," 2. tolerance for error on the root : ");
put(file,epsxa,2,3,3); new_line(file);
put(file," 3. tolerance for the residual : ");
put(file,epsfa,2,3,3); new_line(file);
put(file," 4. tolerance for singular roots : ");
put(file,tolsing,2,3,3); new_line(file);
put(file," 5. maximum number of iterations : ");
put(file,maxit,2); new_line(file);
end Standard_Put_Root_Refining_Parameters;
procedure Multprec_Put_Root_Refining_Parameters
( file : in file_type; epsxa,epsfa,tolsing : in Floating_Number;
maxit,deci : in natural; wout : in boolean ) is
-- DESCRIPTION :
-- Writes the parameters for the root refiner on file.
begin
put(file," 1. output during the iterations : ");
if wout
then put(file," yes"); new_line(file);
else put(file," no"); new_line(file);
end if;
put(file," 2. tolerance for error on the root : ");
put(file,epsxa,2,3,3); new_line(file);
put(file," 3. tolerance for the residual : ");
put(file,epsfa,2,3,3); new_line(file);
put(file," 4. tolerance for singular roots : ");
put(file,tolsing,2,3,3); new_line(file);
put(file," 5. maximum number of iterations : ");
put(file,maxit,2); new_line(file);
put(file," 6. number of decimal places : ");
put(file,deci,2); new_line(file);
end Multprec_Put_Root_Refining_Parameters;
procedure Standard_Menu_Root_Refining_Parameters
( file : in file_type; epsxa,epsfa,tolsing : in out double_float;
maxit : in out natural; wout : in out boolean ) is
-- DESCRIPTION :
-- The user can set the parameters of the root refiner by the menu's.
ans : character;
begin
new_line;
loop
put_line("MENU with current Settings for the Root Refiner :");
Standard_Put_Root_Refining_Parameters
(Standard_Output,epsxa,epsfa,tolsing,maxit,wout);
put("Type 1,2,3,4, or 5 to change, type 0 to exit : ");
Ask_Alternative(ans,"012345");
exit when ans = '0';
case ans is
when '1' => put("Do you want output during the iterations ? (y/n) ");
Ask_Yes_or_No(ans); wout := (ans = 'y');
when '2' => put("Give new tolerance for error on the root : ");
Read_Double_Float(epsxa);
when '3' => put("Give new tolerance for residual : ");
Read_Double_Float(epsfa);
when '4' => put("Give new tolerance for singular roots : ");
Read_Double_Float(tolsing);
when '5' => put("Give new maximum number of iterations : ");
Read_Natural(maxit);
when others => null;
end case;
end loop;
new_line(file);
put_line(file,"ROOT REFINING PARAMETERS : ");
Standard_Put_Root_Refining_Parameters(file,epsxa,epsfa,tolsing,maxit,wout);
end Standard_Menu_Root_Refining_Parameters;
procedure Multprec_Menu_Root_Refining_Parameters
( file : in file_type;
epsxa,epsfa,tolsing : in out Floating_Number;
maxit,deci : in out natural; wout : in out boolean ) is
-- DESCRIPTION :
-- The user can set the parameters of the root refiner by the menu's.
ans : character;
begin
new_line;
loop
put_line("MENU with current Settings for the Root Refiner :");
Multprec_Put_Root_Refining_Parameters
(Standard_Output,epsxa,epsfa,tolsing,maxit,deci,wout);
put("Type 1,2,3,4,5 or 6 to change, type 0 to exit : ");
Ask_Alternative(ans,"0123456");
exit when ans = '0';
case ans is
when '1' => put("Do you want output during the iterations ? (y/n) ");
Ask_Yes_or_No(ans); wout := (ans = 'y');
when '2' => put("Give new tolerance for error on the root : ");
get(epsxa);
when '3' => put("Give new tolerance for residual : ");
get(epsfa);
when '4' => put("Give new tolerance for singular roots : ");
get(tolsing);
when '5' => put("Give new maximum number of iterations : ");
Read_Natural(maxit);
when '6' => put("Give new number of decimal places : ");
Read_Natural(deci);
when others => null;
end case;
end loop;
new_line(file);
put_line(file,"ROOT REFINING PARAMETERS : ");
Multprec_Put_Root_Refining_Parameters
(file,epsxa,epsfa,tolsing,maxit,deci,wout);
end Multprec_Menu_Root_Refining_Parameters;
procedure Refine_Roots
( file : in file_type;
p : in Standard_Complex_Poly_Systems.Poly_Sys;
solsfile,invar,allperms,signsym : in boolean;
v : in List_of_Permutations;
epsxa,epsfa,tolsing : in double_float;
maxit : in natural; wout : in boolean;
sols,refsols
: in out Standard_Complex_Solutions.Solution_List ) is
-- DESCRIPTION :
-- Refines the roots and computes generating solutions when required.
-- ON ENTRY :
-- file for writing results on;
-- p the polynomial system under consideration;
-- solsfile whether refined solution have to go to separate file;
-- invar whether generating solutions have to be computed;
-- allperms whether invariant under all permutations;
-- signsym whether there is sign-symmetry;
-- v group representation, only needed when invar;
-- sols solutions that need to be refined.
-- ON RETURN :
-- sols solutions after applying some Newton iteration;
-- refsols refined solutions, with the exception of failures and
-- the non-generating solutions.
numit : natural := 0;
begin
if solsfile or invar
then Reporting_Root_Refiner
(file,p,sols,refsols,epsxa,epsfa,tolsing,numit,maxit,wout);
if invar
then Driver_for_Orbits_of_Solutions
(file,refsols,v,allperms,signsym,epsxa);
end if;
else Reporting_Root_Refiner
(file,p,sols,epsxa,epsfa,tolsing,numit,maxit,wout);
end if;
end Refine_Roots;
procedure Refine_Roots
( file : in file_type;
p : in Standard_Complex_Poly_Systems.Poly_Sys;
solsfile : in boolean;
epsxa,epsfa,tolsing : in double_float;
maxit : in natural; wout : in boolean;
sols,refsols : in out Standard_Complex_Solutions.Solution_List ) is
-- DESCRIPTION :
-- Root refinement without computing of generating solutions.
numit : natural := 0;
begin
if solsfile
then Reporting_Root_Refiner
(file,p,sols,refsols,epsxa,epsfa,tolsing,numit,maxit,wout);
else Reporting_Root_Refiner
(file,p,sols,epsxa,epsfa,tolsing,numit,maxit,wout);
end if;
end Refine_Roots;
procedure End_of_Input_Message is
begin
new_line;
put_line("No more input expected. See output file for results.");
new_line;
end End_of_Input_Message;
-- VALIDATION PROCEDURES :
procedure Winding_Validation is
-- DESCRIPTION :
-- Validation by computing winding numbers by homotopy continuation.
use Standard_Complex_Solutions;
lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
timer : Timing_Widget;
infile,solsft,outfile : file_type;
ans : character;
sysonfile,solsfile,wout : boolean;
sols,refsols: Standard_Complex_Solutions.Solution_List;
epsxa,epsfa,tolsing : double_float;
maxit : natural;
begin
Read_System(infile,infilename,lp,sysonfile);
Create_Output_File(outfile,outfilename);
put(outfile,lp'last,lp.all);
Read_Solutions(infile,sysonfile,sols);
new_line;
put("Do you want the refined solutions on separate file ? (y/n) ");
Ask_Yes_or_No(ans);
if ans = 'y'
then solsfile := true;
put_line("Reading the name of the file to write the solutions on.");
Read_Name_and_Create_File(solsft);
else solsfile := false;
end if;
Standard_Default_Root_Refining_Parameters(epsxa,epsfa,tolsing,maxit,wout);
Standard_Menu_Root_Refining_Parameters
(outfile,epsxa,epsfa,tolsing,maxit,wout);
Driver_for_Winding_Numbers(outfile,lp.all,sols);
tstart(timer);
Refine_Roots(outfile,lp.all,solsfile,
epsxa,epsfa,tolsing,maxit,wout,sols,refsols);
tstop(timer);
if solsfile
then put(solsft,Length_Of(refsols),Head_Of(refsols).n,refsols);
Close(solsft);
end if;
new_line(outfile);
print_times(outfile,timer,"Root Refinement");
Close(outfile);
end Winding_Validation;
procedure Standard_Weeding_Validation is
-- DESCRIPTION :
-- Validation by refining the roots and weeding out the solution set.
use Standard_Complex_Solutions;
lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
timer : Timing_Widget;
infile,solsft,outfile : file_type;
n,maxit : natural;
ans : character;
sysonfile,solsfile,wout : boolean;
invar,allperms,signsym,allsigns : boolean;
g,v : List_of_Permutations;
sols,refsols: Standard_Complex_Solutions.Solution_List;
epsxa,epsfa,tolsing : double_float;
begin
Read_System(infile,infilename,lp,sysonfile);
Create_Output_File(outfile,outfilename);
put(outfile,lp'last,lp.all);
Read_Solutions(infile,sysonfile,sols);
new_line;
put("Is the system invariant under group actions ? (y/n) ");
Ask_Yes_or_No(ans);
if ans = 'y'
then invar := true; n := lp'length;
Read_Symmetry_Group(n,g,v,allperms,signsym,allsigns);
new_line(outfile);
put_line(outfile,"THE SYMMETRY GROUP : ");
new_line(outfile);
Symbolic_Symmetry_Group_io.put(outfile,v);
new_line(outfile);
else invar := false;
end if;
new_line;
put("Do you want the refined solutions on separate file ? (y/n) ");
Ask_Yes_or_No(ans);
if ans = 'y'
then solsfile := true;
put_line("Reading the name of the file to write the solutions on.");
Read_Name_and_Create_File(solsft);
else solsfile := false;
end if;
Standard_Default_Root_Refining_Parameters(epsxa,epsfa,tolsing,maxit,wout);
Standard_Menu_Root_Refining_Parameters
(outfile,epsxa,epsfa,tolsing,maxit,wout);
End_of_Input_Message;
tstart(timer);
Refine_Roots(outfile,lp.all,solsfile,invar,allperms,signsym,v,
epsxa,epsfa,tolsing,maxit,wout,sols,refsols);
tstop(timer);
if solsfile
then put(solsft,Length_Of(refsols),Head_Of(refsols).n,refsols);
Close(solsft);
end if;
new_line(outfile);
print_times(outfile,timer,"Root Refinement");
Close(outfile);
end Standard_Weeding_Validation;
procedure Multprec_Residual_Evaluator is
-- DESCRIPTION :
-- Evaluation of residuals using multi-precision arithmetic.
lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
timer : Timing_Widget;
infile,outfile : file_type;
sysonfile : boolean;
sols : Standard_Complex_Solutions.Solution_List;
begin
Read_System(infile,infilename,lp,sysonfile);
Create_Output_File(outfile,outfilename);
put(outfile,lp'last,lp.all);
Read_Solutions(infile,sysonfile,sols);
new_line(outfile);
put_line(outfile,"THE SOLUTIONS IN STANDARD PRECISION : ");
put(outfile,Standard_Complex_Solutions.Length_Of(sols),lp'last,sols);
declare
mpsols : Multprec_Complex_Solutions.Solution_List
:= Multprec_Complex_Solutions.Create(sols);
mp : Multprec_Complex_Poly_Systems.Poly_Sys(lp'range) := Convert(lp.all);
mp_eval : Multprec_Complex_Poly_SysFun.Eval_Poly_Sys(mp'range)
:= Create(mp);
deci,size : natural;
begin
new_line;
put("Give the number of decimal places : "); get(deci);
size := Decimal_to_Size(deci);
Multprec_Complex_Solutions.Set_Size(mpsols,Decimal_to_Size(deci));
new_line(outfile);
put(outfile,"THE RESIDUALS with "); put(outfile,deci,1);
put_line(outfile," decimal places :");
tstart(timer);
Residuals(outfile,mp_eval,mpsols);
tstop(timer);
end;
new_line(outfile);
print_times(outfile,timer,"Multi-Precision Residual Evaluation");
Close(outfile);
end Multprec_Residual_Evaluator;
procedure Call_Multprec_Root_Refiner
( file : in file_type;
p : in Multprec_Complex_Poly_Systems.Poly_Sys;
sols : in out Multprec_Complex_Solutions.Solution_List ) is
timer : Timing_Widget;
epsxa,epsfa,tolsing : Floating_Number;
maxit,numit,deci,size : natural;
wout : boolean;
begin
new_line;
Multprec_Default_Root_Refining_Parameters
(epsxa,epsfa,tolsing,maxit,deci,wout);
Multprec_Menu_Root_Refining_Parameters
(file,epsxa,epsfa,tolsing,maxit,deci,wout);
size := Decimal_to_Size(deci);
-- put("Give the size of the numbers : "); get(size);
Multprec_Complex_Solutions.Set_Size(sols,size);
End_of_Input_Message;
tstart(timer);
Reporting_Root_Refiner(file,p,sols,epsxa,epsfa,tolsing,numit,maxit,wout);
tstop(timer);
new_line(file);
print_times(file,timer,"Multi-Precision Root Refinement");
end Call_Multprec_Root_Refiner;
procedure Multprec_Weeding_Validation is
-- DESCRIPTION :
-- Newton's method using multi-precision arithmetic.
lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
timer : Timing_Widget;
infile,outfile : file_type;
sysonfile : boolean;
sols : Standard_Complex_Solutions.Solution_List;
begin
Read_System(infile,infilename,lp,sysonfile);
Create_Output_File(outfile,outfilename);
put(outfile,lp'last,lp.all);
Read_Solutions(infile,sysonfile,sols);
new_line(outfile);
put_line(outfile,"THE SOLUTIONS IN STANDARD PRECISION : ");
put(outfile,Standard_Complex_Solutions.Length_Of(sols),lp'last,sols);
declare
mpsols : Multprec_Complex_Solutions.Solution_List
:= Multprec_Complex_Solutions.Create(sols);
mp : Multprec_Complex_Poly_Systems.Poly_Sys(lp'range) := Convert(lp.all);
begin
Call_Multprec_Root_Refiner(outfile,mp,mpsols);
end;
Close(outfile);
end Multprec_Weeding_Validation;
procedure Polyhedral_End_Game_Validation is
-- DESCRIPTION :
-- Validation of the polyhedral end game.
pocofile,resultfile : file_type;
begin
new_line;
put_line("Reading name of the output file of poco.");
Read_Name_and_Open_File(pocofile);
new_line;
put_line("Reading name of output file.");
Read_Name_and_Create_File(resultfile);
End_of_Input_Message;
valipoco(pocofile,resultfile);
Close(pocofile);
new_line(resultfile);
put(resultfile,Bye_Bye_Message);
Close(resultfile);
end Polyhedral_End_Game_Validation;
procedure Display_and_Dispatch_Menu is
ans : character;
timer : Timing_Widget;
begin
loop
new_line;
put_line("MENU with Validation Methods : ");
put_line
(" 1. Basic Validation : refining and weeding out the solution set");
put_line
(" 2. Evaluation of the residuals using multi-precision arithmetic");
put_line
(" 3. Newton's method using multi-precision arithmetic");
put_line
(" 4. Winding-Number Computation by homotopy continuation");
put_line
(" 5. Polyhedral Validation : frequency table of path directions");
put("Type 1, 2, 3 or 4 to select validation method, or i for info : ");
Ask_Alternative(ans,"12345i");
case ans is
when 'i' => new_line;
Display_Validation_Info;
when '1' => Standard_Weeding_Validation;
when '2' => Multprec_Residual_Evaluator;
when '3' => Multprec_Weeding_Validation;
when '4' => Winding_Validation;
when '5' => Polyhedral_End_Game_Validation;
when others => null;
end case;
exit when ans /= 'i';
end loop;
end Display_and_Dispatch_Menu;
begin
Display_and_Dispatch_Menu;
end mainvali;