Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/symmetric_polyhedral_continuation.adb, Revision 1.1
1.1 ! maekawa 1: with integer_io; use integer_io;
! 2: with Standard_Floating_Numbers; use Standard_Floating_Numbers;
! 3: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
! 4: with Standard_Integer_Vectors_io; use Standard_Integer_Vectors_io;
! 5: with Standard_Complex_Polynomials; use Standard_Complex_Polynomials;
! 6: with Standard_Complex_Laur_Polys; use Standard_Complex_Laur_Polys;
! 7: with Standard_Complex_Poly_Systems; use Standard_Complex_Poly_Systems;
! 8: with Standard_Laur_Poly_Convertors; use Standard_Laur_Poly_Convertors;
! 9: with Standard_Complex_Laur_Randomizers; use Standard_Complex_Laur_Randomizers;
! 10: with Lists_of_Integer_Vectors; use Lists_of_Integer_Vectors;
! 11: with Transforming_Integer_Vector_Lists; use Transforming_Integer_Vector_Lists;
! 12: with Arrays_of_Integer_Vector_Lists; use Arrays_of_Integer_Vector_Lists;
! 13: with Power_Lists; use Power_Lists;
! 14: with Integer_Lifting_Utilities; use Integer_Lifting_Utilities;
! 15: with Transforming_Laurent_Systems; use Transforming_Laurent_Systems;
! 16: with Fewnomial_System_Solvers; use Fewnomial_System_Solvers;
! 17: with Integer_Polyhedral_Continuation; use Integer_Polyhedral_Continuation;
! 18: with Symmetric_BKK_Bound_Solvers; use Symmetric_BKK_Bound_Solvers;
! 19: with Orbits_of_Solutions; use Orbits_of_Solutions;
! 20:
! 21: package body Symmetric_Polyhedral_Continuation is
! 22:
! 23: function Select_Subsystem ( p : Laur_Sys; mix : Vector; mic : Mixed_Cell )
! 24: return Laur_Sys is
! 25:
! 26: res : Laur_Sys(p'range);
! 27: cnt : natural := 0;
! 28:
! 29: begin
! 30: for k in mix'range loop
! 31: for l in 1..mix(k) loop
! 32: cnt := cnt + 1;
! 33: res(cnt) := Select_Terms(p(cnt),mic.pts(k));
! 34: end loop;
! 35: end loop;
! 36: return res;
! 37: end Select_Subsystem;
! 38:
! 39: function Symmetric_Mixed_Solve
! 40: ( file : file_type; grp : List_of_Permutations; sign : boolean;
! 41: p : Laur_Sys; mixsub : Mixed_Subdivision;
! 42: n : natural; mix : Vector ) return Solution_List is
! 43:
! 44: sols,sols_last : Solution_List;
! 45: cnt : natural := 0;
! 46: tmp : Mixed_Subdivision := mixsub;
! 47:
! 48: procedure Solve_Subsystem ( mic : in Mixed_Cell ) is
! 49:
! 50: q : Laur_Sys(p'range) := Select_Subsystem(p,mix,mic);
! 51: sq : Laur_Sys(q'range);
! 52: qsols : Solution_List;
! 53: fail : boolean;
! 54: eps : constant double_float := 10.0**(-10);
! 55:
! 56: begin
! 57: new_line(file);
! 58: put(file,"*** CONSIDERING SUBSYSTEM "); put(file,cnt,1);
! 59: put_line(file," ***");
! 60: new_line(file);
! 61: Reduce(n+1,q); sq := Shift(q);
! 62: declare
! 63: pq : Poly_Sys(q'range) := Laurent_to_Polynomial_System(sq);
! 64: begin
! 65: Solve(sq,qsols,fail);
! 66: if not fail
! 67: then put_line(file,"It is a fewnomial system.");
! 68: else put_line(file,"No fewnomial system.");
! 69: if mic.sub = null
! 70: then put_line(file,"Calling the black box solver.");
! 71: qsols := Symmetric_BKK_Solve(file,pq,grp,sign);
! 72: else put_line(file,"Using the refinement of the cell.");
! 73: declare
! 74: sup : Array_of_Lists(q'range);
! 75: cnt : natural := sup'first;
! 76: lif : Array_of_Lists(mix'range);
! 77: lifq : Laur_Sys(q'range);
! 78: begin
! 79: for i in mic.pts'range loop
! 80: sup(cnt) := Reduce(mic.pts(i),q'last+1);
! 81: for j in 1..(mix(i)-1) loop
! 82: Copy(sup(cnt),sup(cnt+j));
! 83: end loop;
! 84: cnt := cnt + mix(i);
! 85: end loop;
! 86: lif := Induced_Lifting(n,mix,sup,mic.sub.all);
! 87: lifq := Perform_Lifting(n,mix,lif,q);
! 88: qsols := Symmetric_Mixed_Solve
! 89: (file,grp,sign,lifq,mic.sub.all,n,mix);
! 90: Deep_Clear(sup); Deep_Clear(lif); Clear(lifq);
! 91: end;
! 92: end if;
! 93: Set_Continuation_Parameter(qsols,Create(0.0));
! 94: end if;
! 95: put(file,Length_Of(qsols),1);
! 96: put_line(file," solutions found.");
! 97: if not Is_Null(qsols)
! 98: then Analyze(grp,sign,eps,qsols);
! 99: put(file,Length_Of(qsols),1);
! 100: put_line(file," generating solutions found.");
! 101: Mixed_Continuation(file,p,mic.nor.all,qsols);
! 102: Concat(sols,sols_last,qsols);
! 103: end if;
! 104: Clear(pq); Clear(sq);
! 105: end;
! 106: Clear(q); -- Shallow_Clear(qsols);
! 107: end Solve_Subsystem;
! 108:
! 109: begin
! 110: while not Is_Null(tmp) loop
! 111: cnt := cnt + 1;
! 112: Solve_Subsystem(Head_Of(tmp));
! 113: tmp := Tail_Of(tmp);
! 114: end loop;
! 115: return sols;
! 116: end Symmetric_Mixed_Solve;
! 117:
! 118: function Symmetric_Mixed_Solve
! 119: ( file : file_type; sign : boolean; p : Laur_Sys;
! 120: mixsub : Mixed_Subdivision; n : natural;
! 121: mix : Vector ) return Solution_List is
! 122:
! 123: sols,sols_last : Solution_List;
! 124: cnt : natural;
! 125: tmp : Mixed_Subdivision := mixsub;
! 126:
! 127: procedure Solve_Subsystem ( mic : in Mixed_Cell ) is
! 128:
! 129: q : Laur_Sys(p'range) := Select_Subsystem(p,mix,mic);
! 130: sq : Laur_Sys(q'range);
! 131: qsols,genqsols : Solution_List;
! 132: fail : boolean;
! 133: eps : constant double_float := 10.0**(-10);
! 134:
! 135: begin
! 136: new_line(file);
! 137: put(file,"*** CONSIDERING SUBSYSTEM "); put(file,cnt,1);
! 138: put_line(file," ***");
! 139: new_line(file);
! 140: Reduce(n+1,q); sq := Shift(q);
! 141: declare
! 142: pq : Poly_Sys(q'range) := Laurent_to_Polynomial_System(sq);
! 143: begin
! 144: Solve(sq,qsols,fail);
! 145: if not fail
! 146: then put_line(file,"It is a fewnomial system.");
! 147: else put_line(file,"No fewnomial system.");
! 148: if mic.sub = null
! 149: then put_line(file,"Calling the black box solver.");
! 150: qsols := Symmetric_BKK_Solve(file,pq,sign);
! 151: else put_line(file,"Using the refinement of the cell.");
! 152: declare
! 153: sup : Array_of_Lists(q'range);
! 154: cnt : natural := sup'first;
! 155: lif : Array_of_Lists(mix'range);
! 156: lifq : Laur_Sys(q'range);
! 157: begin
! 158: for i in mic.pts'range loop
! 159: sup(cnt) := Reduce(mic.pts(i),q'last+1);
! 160: for j in 1..(mix(i)-1) loop
! 161: Copy(sup(cnt),sup(cnt+j));
! 162: end loop;
! 163: cnt := cnt + mix(i);
! 164: end loop;
! 165: lif := Induced_Lifting(n,mix,sup,mic.sub.all);
! 166: lifq := Perform_Lifting(n,mix,lif,q);
! 167: qsols := Symmetric_Mixed_Solve(file,sign,lifq,
! 168: mic.sub.all,n,mix);
! 169: Deep_Clear(sup); Deep_Clear(lif); Clear(lifq);
! 170: end;
! 171: end if;
! 172: Set_Continuation_Parameter(qsols,Create(0.0));
! 173: end if;
! 174: put(file,Length_Of(qsols),1);
! 175: put_line(file," solutions found.");
! 176: if not Is_Null(qsols)
! 177: then genqsols := Generating(qsols,sign,eps);
! 178: put(file,Length_Of(genqsols),1);
! 179: put_line(file," generating solutions found.");
! 180: Mixed_Continuation(file,p,mic.nor.all,genqsols);
! 181: Concat(sols,sols_last,genqsols);
! 182: end if;
! 183: Clear(pq); Clear(sq);
! 184: end;
! 185: Clear(q); -- Shallow_Clear(genqsols);
! 186: end Solve_Subsystem;
! 187:
! 188: begin
! 189: while not Is_Null(tmp) loop
! 190: cnt := cnt + 1;
! 191: Solve_Subsystem(Head_Of(tmp));
! 192: tmp := Tail_Of(tmp);
! 193: end loop;
! 194: return sols;
! 195: end Symmetric_Mixed_Solve;
! 196:
! 197: end Symmetric_Polyhedral_Continuation;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to symmetric_polyhedral_continuation.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Symmetry