File: [local] / OpenXM_contrib / PHC / Ada / Schubert / ts_defpos.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:33 2000 UTC (23 years, 8 months ago) by maekawa
Branch: PHC, MAIN
CVS Tags: v2, maekawa-ipv6, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, HEAD Changes since 1.1: +0 -0
lines
Import the second public release of PHCpack.
OKed by Jan Verschelde.
|
with text_io,integer_io; use text_io,integer_io;
with Communications_with_User; use Communications_with_User;
with Timing_Package; use Timing_Package;
with Standard_Complex_Matrices;
with Standard_Complex_Matrices_io; use Standard_Complex_Matrices_io;
with Standard_Random_Matrices; use Standard_Random_Matrices;
with Standard_Complex_VecMats; use Standard_Complex_VecMats;
with Symbol_Table; use Symbol_Table;
with Matrix_Indeterminates;
with Standard_Complex_Poly_Matrices;
with Standard_Complex_Poly_Matrices_io; use Standard_Complex_Poly_Matrices_io;
with Drivers_for_Poly_Continuation; use Drivers_for_Poly_Continuation;
with Brackets,Brackets_io; use Brackets,Brackets_io;
with Symbolic_Minor_Equations; use Symbolic_Minor_Equations;
with Pieri_Homotopies; use Pieri_Homotopies;
with Localization_Posets; use Localization_Posets;
with Localization_Posets_io; use Localization_Posets_io;
with Deformation_Posets; use Deformation_Posets;
procedure ts_defpos is
-- DESCRIPTION :
-- Test on the deformation posets.
procedure Add_t_Symbol is
-- DESCRIPTION :
-- Adds the symbol for the continuation parameter t to the symbol table.
tsb : Symbol;
begin
Symbol_Table.Enlarge(1);
tsb(1) := 't';
for i in 2..tsb'last loop
tsb(i) := ' ';
end loop;
Symbol_Table.Add(tsb);
end Add_t_Symbol;
procedure Set_Parameters ( file : in file_type; report : out boolean ) is
-- DESCRIPTION :
-- Interactive determination of the continuation and output parameters.
oc : natural;
begin
new_line;
Driver_for_Continuation_Parameters(file);
new_line;
Driver_for_Process_io(file,oc);
report := not (oc = 0);
new_line;
put_line("No more input expected. See output file for results...");
new_line;
new_line(file);
end Set_Parameters;
function Random_Input_Planes ( m,p : natural ) return VecMat is
-- DESCRIPTION :
-- Returns a vector of m*p random m-planes.
res : VecMat(1..m*p);
n : constant natural := m+p;
begin
for i in res'range loop
res(i) := new Standard_Complex_Matrices.Matrix'(Random_Matrix(n,m));
end loop;
return res;
end Random_Input_Planes;
function Random_Input_Planes ( m,p : natural; k : Bracket ) return VecMat is
-- DESCRIPTION :
-- Returns a vector of m*p random m-planes.
res : VecMat(k'range);
n : constant natural := m+p;
begin
for i in res'range loop
res(i)
:= new Standard_Complex_Matrices.Matrix'(Random_Matrix(n,m+1-k(i)));
end loop;
return res;
end Random_Input_Planes;
procedure Solve_Deformation_Poset
( file : in file_type; m,p : in natural;
level_poset : in Array_of_Nodes;
index_poset : in Array_of_Array_of_Nodes ) is
-- DESCRIPTION :
-- Creates a deformation poset and applies the Solve operator.
deform_poset : Array_of_Array_of_VecMats(index_poset'range)
:= Create(index_poset);
planes : VecMat(1..m*p) := Random_Input_Planes(m,p);
report : boolean;
timer : Timing_Widget;
target_level : natural := m*p;
nbp : natural := 0;
begin
put_line("The size of the deformation poset : ");
put_line(file,"The size of the deformation poset : ");
put_roco(index_poset);
put_roco(file,index_poset);
new_line;
put("Give target level <= "); put(target_level,1);
put(" = root level : "); get(target_level);
for i in 1..target_level loop
nbp := nbp + Row_Root_Count_Sum(level_poset,i);
end loop;
put("The number of paths : "); put(nbp,1); new_line;
put(file,"The number of paths : "); put(file,nbp,1); new_line(file);
Matrix_Indeterminates.Initialize_Symbols(m+p,p);
Add_t_Symbol;
skip_line;
Set_Parameters(file,report);
tstart(timer);
for i in index_poset(target_level)'range loop
declare
root : Node := index_poset(target_level)(i).all;
begin
Solve(file,m+p,deform_poset,root,planes,report);
end;
end loop;
tstop(timer);
new_line(file);
print_times(file,timer,"Solving along the deformation poset");
end Solve_Deformation_Poset;
procedure Solve_Deformation_Poset
( file : in file_type; m,p : in natural; k : in Bracket;
index_poset : in Array_of_Array_of_Nodes ) is
-- DESCRIPTION :
-- Applies the solver to general intersection conditions.
deform_poset : Array_of_Array_of_VecMats(index_poset'range)
:= Create(index_poset);
planes : VecMat(k'range) := Random_Input_Planes(m,p,k);
report : boolean;
timer : Timing_Widget;
target_level : natural := m*p;
begin
put_line("The size of the deformation poset : ");
put_line(file,"The size of the deformation poset : ");
put_roco(index_poset);
put_roco(file,index_poset);
new_line;
put("Give target level <= "); put(target_level,1);
put(" = root level : "); get(target_level);
Matrix_Indeterminates.Initialize_Symbols(m+p,p);
Add_t_Symbol;
skip_line;
Set_Parameters(file,report);
tstart(timer);
for i in index_poset(target_level)'range loop
declare
root : Node := index_poset(target_level)(i).all;
begin
if ((root.tp = top) or (root.tp = bottom))
then --One_Solve(file,m+p,k,deform_poset,root,planes,report);
Solve(file,m+p,k,deform_poset,root,planes,report);
else Solve(file,m+p,k,deform_poset,root,planes,report);
end if;
end;
end loop;
tstop(timer);
new_line(file);
print_times(file,timer,"Solving along the deformation poset");
end Solve_Deformation_Poset;
procedure Create_Top_Hypersurface_Poset
( file : in file_type; m,p : in natural ) is
-- DESCRIPTION :
-- Create the poset by incrementing only top pivots.
root : Node(p) := Trivial_Root(m,p);
lnkroot : Link_to_Node := new Node'(root);
level_poset : Array_of_Nodes(0..m*p);
index_poset : Array_of_Array_of_Nodes(0..m*p);
begin
Top_Create(lnkroot,m+p);
put_line("The poset created from the top : ");
put_line(file,"The poset created from the top : ");
level_poset := Create_Leveled_Poset(lnkroot);
Count_Roots(level_poset);
index_poset := Create_Indexed_Poset(level_poset);
put(index_poset);
put(file,index_poset);
Solve_Deformation_Poset(file,m,p,level_poset,index_poset);
end Create_Top_Hypersurface_Poset;
procedure Create_Bottom_Hypersurface_Poset
( file : in file_type; m,p : in natural ) is
-- DESCRIPTION :
-- Create the poset by decrementing only bottom pivots.
root : Node(p) := Trivial_Root(m,p);
lnkroot : Link_to_Node := new Node'(root);
level_poset : Array_of_Nodes(0..m*p);
index_poset : Array_of_Array_of_Nodes(0..m*p);
begin
Bottom_Create(lnkroot);
put_line("The poset created from the bottom : ");
put_line(file,"The poset created from the bottom : ");
level_poset := Create_Leveled_Poset(lnkroot);
Count_Roots(level_poset);
index_poset := Create_Indexed_Poset(level_poset);
put(index_poset);
put(file,index_poset);
Solve_Deformation_Poset(file,m,p,level_poset,index_poset);
end Create_Bottom_Hypersurface_Poset;
procedure Create_Mixed_Hypersurface_Poset
( file : in file_type; m,p : in natural ) is
-- DESCRIPTION :
-- Create the poset by incrementing top and decrementing bottom pivots.
root : Node(p) := Trivial_Root(m,p);
lnkroot : Link_to_Node := new Node'(root);
level_poset : Array_of_Nodes(0..m*p);
index_poset : Array_of_Array_of_Nodes(0..m*p);
begin
Top_Bottom_Create(lnkroot,m+p);
put_line("The poset created in a mixed fashion : ");
put_line(file,"The poset created in a mixed fashion : ");
level_poset := Create_Leveled_Poset(lnkroot);
Count_Roots(level_poset);
index_poset := Create_Indexed_Poset(level_poset);
put(index_poset);
put(file,index_poset);
Solve_Deformation_Poset(file,m,p,level_poset,index_poset);
end Create_Mixed_Hypersurface_Poset;
function Finite ( dim : Bracket; m,p : natural ) return boolean is
-- DESCRIPTION :
-- Returns true if the codimensions yield a finite number of solutions.
sum : natural := 0;
begin
for i in dim'range loop
sum := sum + dim(i);
end loop;
if sum = m*p
then return true;
else return false;
end if;
end Finite;
function Read_Codimensions ( m,p : natural ) return Bracket is
-- DESCRIPTION :
-- Reads the vector of codimensions and checks on finiteness.
codim : Bracket(1..m*p);
n : natural;
poset : Array_of_Nodes(0..m*p);
begin
loop
put("Give number of intersection conditions : "); get(n);
put("Give "); put(n,1); put(" codimensions : ");
for i in 1..n loop
get(codim(i));
end loop;
for i in 1..n-1 loop
put(codim(i),1); put(" + ");
end loop;
put(codim(n),1);
if Finite(codim(1..n),m,p)
then put(" = "); put(m*p,1); put_line(" Finite #sols.");
exit;
else put(" /= "); put(m*p,1);
put_line(" Please try again.");
end if;
end loop;
return codim(1..n);
end Read_Codimensions;
procedure Create_Top_General_Poset
( file : in file_type; m,p : in natural ) is
-- DESCRIPTION :
-- Creates a poset for counting general subspace intersections,
-- by consistently incrementing the top pivots.
root : Node(p) := Trivial_Root(m,p);
lnkroot : Link_to_Node := new Node'(root);
codim : constant Bracket := Read_Codimensions(m,p);
level_poset : Array_of_Nodes(0..m*p);
index_poset : Array_of_Array_of_Nodes(0..m*p);
begin
put(file," k = "); put(file,codim); new_line(file);
Top_Create(lnkroot,codim,m+p);
put_line("The poset created from the top : ");
put_line(file,"The poset created from the top : ");
level_poset := Create_Leveled_Poset(lnkroot);
Count_Roots(level_poset);
index_poset := Create_Indexed_Poset(level_poset);
put(index_poset);
put(file,index_poset);
Solve_Deformation_Poset(file,m,p,codim,index_poset);
end Create_Top_General_Poset;
procedure Create_Bottom_General_Poset
( file : in file_type; m,p : in natural ) is
-- DESCRIPTION :
-- Creates a poset for counting general subspace intersections,
-- by consistently incrementing the top pivots.
root : Node(p) := Trivial_Root(m,p);
lnkroot : Link_to_Node := new Node'(root);
codim : constant Bracket := Read_Codimensions(m,p);
level_poset : Array_of_Nodes(0..m*p);
index_poset : Array_of_Array_of_Nodes(0..m*p);
begin
put(file," k = "); put(file,codim); new_line(file);
Bottom_Create(lnkroot,codim);
put_line("The poset created from the bottom : ");
put_line(file,"The poset created from the bottom : ");
level_poset := Create_Leveled_Poset(lnkroot);
Count_Roots(level_poset);
index_poset := Create_Indexed_Poset(level_poset);
put(index_poset);
put(file,index_poset);
Solve_Deformation_Poset(file,m,p,codim,index_poset);
end Create_Bottom_General_Poset;
procedure Create_Mixed_General_Poset
( file : in file_type; m,p : in natural ) is
-- DESCRIPTION :
-- Creates a poset for counting general subspace intersections,
-- by incrementing the top and decrementing the bottom pivots.
root : Node(p) := Trivial_Root(m,p);
lnkroot : Link_to_Node := new Node'(root);
codim : constant Bracket := Read_Codimensions(m,p);
level_poset : Array_of_Nodes(0..m*p);
index_poset : Array_of_Array_of_Nodes(0..m*p);
begin
put(file," k = "); put(file,codim); new_line(file);
Top_Bottom_Create(lnkroot,codim,m+p);
put_line("The poset created in a mixed fashion : ");
put_line(file,"The poset created in a mixed fashion : ");
level_poset := Create_Leveled_Poset(lnkroot);
Count_Roots(level_poset);
index_poset := Create_Indexed_Poset(level_poset);
put(index_poset);
put(file,index_poset);
Solve_Deformation_Poset(file,m,p,codim,index_poset);
end Create_Mixed_General_Poset;
procedure Main is
m,p : natural;
ans : character;
file : file_type;
begin
new_line;
put_line("MENU for posets for deforming p-planes in (m+p)-space : ");
put_line(" 1. k_i = 1 consistently incrementing the top pivots.");
put_line(" 2. consistently decrementing the bottom pivots.");
put_line(" 3. mixed top-bottom sequence for poset creation.");
put_line(" 4. k_i >= 1 consistently incrementing the top pivots.");
put_line(" 5. consistently decrementing the bottom pivots.");
put_line(" 6. mixed top-bottom sequence for poset creation.");
put("Type 1, 2, 3, 4, 5, or 6 to choose : "); get(ans);
skip_line; new_line;
put_line("Reading the name of the file for the deformations.");
Read_Name_and_Create_File(file);
new_line;
put("Give p, the number of entries in bracket : "); get(p);
put("Give m, the complementary dimension : "); get(m);
put(file,"p = "); put(file,p,1); put(file," m = "); put(file,m,1);
new_line;
case ans is
when '1' => new_line(file); Create_Top_Hypersurface_Poset(file,m,p);
when '2' => new_line(file); Create_Bottom_Hypersurface_Poset(file,m,p);
when '3' => new_line(file); Create_Mixed_Hypersurface_Poset(file,m,p);
when '4' => Create_Top_General_Poset(file,m,p);
when '5' => Create_Bottom_General_Poset(file,m,p);
when '6' => Create_Mixed_General_Poset(file,m,p);
when others => put_line("Option not recognized. Please try again.");
end case;
end Main;
begin
new_line;
put_line("Test on deformation posets for linear subspace intersections.");
Main;
end ts_defpos;