File: [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Symmetry / symmetric_polyhedral_continuation.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:31 2000 UTC (23 years, 10 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 integer_io; use integer_io;
with Standard_Floating_Numbers; use Standard_Floating_Numbers;
with Standard_Complex_Numbers; use Standard_Complex_Numbers;
with Standard_Integer_Vectors_io; use Standard_Integer_Vectors_io;
with Standard_Complex_Polynomials; use Standard_Complex_Polynomials;
with Standard_Complex_Laur_Polys; use Standard_Complex_Laur_Polys;
with Standard_Complex_Poly_Systems; use Standard_Complex_Poly_Systems;
with Standard_Laur_Poly_Convertors; use Standard_Laur_Poly_Convertors;
with Standard_Complex_Laur_Randomizers; use Standard_Complex_Laur_Randomizers;
with Lists_of_Integer_Vectors; use Lists_of_Integer_Vectors;
with Transforming_Integer_Vector_Lists; use Transforming_Integer_Vector_Lists;
with Arrays_of_Integer_Vector_Lists; use Arrays_of_Integer_Vector_Lists;
with Power_Lists; use Power_Lists;
with Integer_Lifting_Utilities; use Integer_Lifting_Utilities;
with Transforming_Laurent_Systems; use Transforming_Laurent_Systems;
with Fewnomial_System_Solvers; use Fewnomial_System_Solvers;
with Integer_Polyhedral_Continuation; use Integer_Polyhedral_Continuation;
with Symmetric_BKK_Bound_Solvers; use Symmetric_BKK_Bound_Solvers;
with Orbits_of_Solutions; use Orbits_of_Solutions;
package body Symmetric_Polyhedral_Continuation is
function Select_Subsystem ( p : Laur_Sys; mix : Vector; mic : Mixed_Cell )
return Laur_Sys is
res : Laur_Sys(p'range);
cnt : natural := 0;
begin
for k in mix'range loop
for l in 1..mix(k) loop
cnt := cnt + 1;
res(cnt) := Select_Terms(p(cnt),mic.pts(k));
end loop;
end loop;
return res;
end Select_Subsystem;
function Symmetric_Mixed_Solve
( file : file_type; grp : List_of_Permutations; sign : boolean;
p : Laur_Sys; mixsub : Mixed_Subdivision;
n : natural; mix : Vector ) return Solution_List is
sols,sols_last : Solution_List;
cnt : natural := 0;
tmp : Mixed_Subdivision := mixsub;
procedure Solve_Subsystem ( mic : in Mixed_Cell ) is
q : Laur_Sys(p'range) := Select_Subsystem(p,mix,mic);
sq : Laur_Sys(q'range);
qsols : Solution_List;
fail : boolean;
eps : constant double_float := 10.0**(-10);
begin
new_line(file);
put(file,"*** CONSIDERING SUBSYSTEM "); put(file,cnt,1);
put_line(file," ***");
new_line(file);
Reduce(n+1,q); sq := Shift(q);
declare
pq : Poly_Sys(q'range) := Laurent_to_Polynomial_System(sq);
begin
Solve(sq,qsols,fail);
if not fail
then put_line(file,"It is a fewnomial system.");
else put_line(file,"No fewnomial system.");
if mic.sub = null
then put_line(file,"Calling the black box solver.");
qsols := Symmetric_BKK_Solve(file,pq,grp,sign);
else put_line(file,"Using the refinement of the cell.");
declare
sup : Array_of_Lists(q'range);
cnt : natural := sup'first;
lif : Array_of_Lists(mix'range);
lifq : Laur_Sys(q'range);
begin
for i in mic.pts'range loop
sup(cnt) := Reduce(mic.pts(i),q'last+1);
for j in 1..(mix(i)-1) loop
Copy(sup(cnt),sup(cnt+j));
end loop;
cnt := cnt + mix(i);
end loop;
lif := Induced_Lifting(n,mix,sup,mic.sub.all);
lifq := Perform_Lifting(n,mix,lif,q);
qsols := Symmetric_Mixed_Solve
(file,grp,sign,lifq,mic.sub.all,n,mix);
Deep_Clear(sup); Deep_Clear(lif); Clear(lifq);
end;
end if;
Set_Continuation_Parameter(qsols,Create(0.0));
end if;
put(file,Length_Of(qsols),1);
put_line(file," solutions found.");
if not Is_Null(qsols)
then Analyze(grp,sign,eps,qsols);
put(file,Length_Of(qsols),1);
put_line(file," generating solutions found.");
Mixed_Continuation(file,p,mic.nor.all,qsols);
Concat(sols,sols_last,qsols);
end if;
Clear(pq); Clear(sq);
end;
Clear(q); -- Shallow_Clear(qsols);
end Solve_Subsystem;
begin
while not Is_Null(tmp) loop
cnt := cnt + 1;
Solve_Subsystem(Head_Of(tmp));
tmp := Tail_Of(tmp);
end loop;
return sols;
end Symmetric_Mixed_Solve;
function Symmetric_Mixed_Solve
( file : file_type; sign : boolean; p : Laur_Sys;
mixsub : Mixed_Subdivision; n : natural;
mix : Vector ) return Solution_List is
sols,sols_last : Solution_List;
cnt : natural;
tmp : Mixed_Subdivision := mixsub;
procedure Solve_Subsystem ( mic : in Mixed_Cell ) is
q : Laur_Sys(p'range) := Select_Subsystem(p,mix,mic);
sq : Laur_Sys(q'range);
qsols,genqsols : Solution_List;
fail : boolean;
eps : constant double_float := 10.0**(-10);
begin
new_line(file);
put(file,"*** CONSIDERING SUBSYSTEM "); put(file,cnt,1);
put_line(file," ***");
new_line(file);
Reduce(n+1,q); sq := Shift(q);
declare
pq : Poly_Sys(q'range) := Laurent_to_Polynomial_System(sq);
begin
Solve(sq,qsols,fail);
if not fail
then put_line(file,"It is a fewnomial system.");
else put_line(file,"No fewnomial system.");
if mic.sub = null
then put_line(file,"Calling the black box solver.");
qsols := Symmetric_BKK_Solve(file,pq,sign);
else put_line(file,"Using the refinement of the cell.");
declare
sup : Array_of_Lists(q'range);
cnt : natural := sup'first;
lif : Array_of_Lists(mix'range);
lifq : Laur_Sys(q'range);
begin
for i in mic.pts'range loop
sup(cnt) := Reduce(mic.pts(i),q'last+1);
for j in 1..(mix(i)-1) loop
Copy(sup(cnt),sup(cnt+j));
end loop;
cnt := cnt + mix(i);
end loop;
lif := Induced_Lifting(n,mix,sup,mic.sub.all);
lifq := Perform_Lifting(n,mix,lif,q);
qsols := Symmetric_Mixed_Solve(file,sign,lifq,
mic.sub.all,n,mix);
Deep_Clear(sup); Deep_Clear(lif); Clear(lifq);
end;
end if;
Set_Continuation_Parameter(qsols,Create(0.0));
end if;
put(file,Length_Of(qsols),1);
put_line(file," solutions found.");
if not Is_Null(qsols)
then genqsols := Generating(qsols,sign,eps);
put(file,Length_Of(genqsols),1);
put_line(file," generating solutions found.");
Mixed_Continuation(file,p,mic.nor.all,genqsols);
Concat(sols,sols_last,genqsols);
end if;
Clear(pq); Clear(sq);
end;
Clear(q); -- Shallow_Clear(genqsols);
end Solve_Subsystem;
begin
while not Is_Null(tmp) loop
cnt := cnt + 1;
Solve_Subsystem(Head_Of(tmp));
tmp := Tail_Of(tmp);
end loop;
return sols;
end Symmetric_Mixed_Solve;
end Symmetric_Polyhedral_Continuation;