Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/driver_for_symmetric_set_structure.adb, Revision 1.1
1.1 ! maekawa 1: with integer_io; use integer_io;
! 2: with Communications_with_User; use Communications_with_User;
! 3: with Timing_Package; use Timing_Package;
! 4: with Standard_Floating_Numbers; use Standard_Floating_Numbers;
! 5: with Numbers_io; use Numbers_io;
! 6: with Standard_Natural_Vectors; use Standard_Natural_Vectors;
! 7: with Standard_Complex_Poly_Systems_io; use Standard_Complex_Poly_Systems_io;
! 8: with Lists_of_Integer_Vectors_io; use Lists_of_Integer_Vectors_io;
! 9: with Standard_Complex_Solutions; use Standard_Complex_Solutions;
! 10: with Standard_Complex_Solutions_io; use Standard_Complex_Solutions_io;
! 11: with Random_Product_System;
! 12: with Random_Product_System_io;
! 13: with Set_Structure,Set_Structure_io; use Set_Structure;
! 14: with Degree_Sets_Tables; use Degree_Sets_Tables;
! 15: with Orbits_of_Solutions; use Orbits_of_Solutions;
! 16: with Permutations,Symmetry_Group; use Permutations,Symmetry_Group;
! 17: with Symmetry_Group_io; use Symmetry_Group_io;
! 18: with Symbolic_Symmetry_Group_io; use Symbolic_Symmetry_Group_io;
! 19: with Drivers_for_Symmetry_Group_io; use Drivers_for_Symmetry_Group_io;
! 20: with Symmetric_Set_Structure; use Symmetric_Set_Structure;
! 21: with Equivariant_Polynomial_Systems; use Equivariant_Polynomial_Systems;
! 22: with Linear_Symmetric_Reduction; use Linear_Symmetric_Reduction;
! 23:
! 24: package body Driver_for_Symmetric_Set_Structure is
! 25:
! 26: procedure Symmetric_Set_Structure_Info is
! 27:
! 28: i : array(1..5) of string(1..65);
! 29:
! 30: begin
! 31: i(1):=" A symmetric generalized Bezout number is based on a symmetric";
! 32: i(2):="supporting set structure and allows to exploit permutation";
! 33: i(3):="symmetries in the system. The corresponding linear-product start";
! 34: i(4):="system has the same symmetric structure, so that in the homotopy,";
! 35: i(5):="only the generating solution paths need to be traced. ";
! 36: for k in i'range loop
! 37: put_line(i(k));
! 38: end loop;
! 39: end Symmetric_Set_Structure_Info;
! 40:
! 41: procedure Driver_for_Symmetric_Random_Product_Systems
! 42: ( file : in file_type; p : in Poly_Sys; q : out Poly_Sys;
! 43: qsols : out Solution_List; bs : in out natural;
! 44: lpos : in out List ) is
! 45:
! 46: tol : constant double_float := 10.0**(-12);
! 47:
! 48: procedure Write_Results ( file : in file_type; bb : in natural ) is
! 49: begin
! 50: new_line(file);
! 51: put(file," generalized Bezout number is "); put(file,bb,1);
! 52: new_line(file);
! 53: put_line(file," based on the set structure :");
! 54: Set_Structure_io.put(file);
! 55: end Write_Results;
! 56:
! 57: procedure Save_Results ( qq : in Poly_Sys; qqsols : in Solution_List ) is
! 58:
! 59: qqfile : file_type;
! 60:
! 61: begin
! 62: if not Is_Null(qqsols)
! 63: then new_line;
! 64: put_line("Reading file name to write start system.");
! 65: Read_Name_and_Create_File(qqfile);
! 66: put_line(qqfile,qq);
! 67: new_line(qqfile);
! 68: put_line(qqfile,"THE SOLUTIONS : ");
! 69: new_line(qqfile);
! 70: put(qqfile,Length_Of(qqsols),Head_Of(qqsols).n,qqsols);
! 71: Close(qqfile);
! 72: end if;
! 73: end Save_Results;
! 74:
! 75: procedure Write_Orbits
! 76: ( file : in file_type; qqsols : in Solution_List ) is
! 77:
! 78: orb : constant Permutation := Orbits(qqsols,tol);
! 79:
! 80: begin
! 81: new_line;
! 82: put("The number of generating solutions : ");
! 83: put(Length_Of(qqsols),1); new_line;
! 84: new_line(file);
! 85: put(file,"The number of generating solutions : ");
! 86: put(file,Length_Of(qqsols),1); new_line(file);
! 87: put("The orbits : "); Symmetry_Group_io.put(orb); new_line;
! 88: put(file,"The orbits : "); Symmetry_Group_io.put(file,orb);
! 89: new_line(file);
! 90: end Write_Orbits;
! 91:
! 92: procedure Driver_for_Bezout_Number ( file : in file_type ) is
! 93:
! 94: timer : timing_widget;
! 95: ns : Standard_Natural_Vectors.Vector(p'range);
! 96:
! 97: begin
! 98: put_line("Reading the set structure.");
! 99: for i in ns'range loop
! 100: put(" Give the number of sets for polynomial ");
! 101: put(i,1); put(" : ");
! 102: Read_Natural(ns(i));
! 103: end loop;
! 104: Set_Structure.Init(ns);
! 105: put_line("Give the set structure : ");
! 106: Set_Structure_io.get;
! 107: -- Set_Structure.B(bs,lpos);
! 108: tstart(timer);
! 109: bs := Permanent(Degree_Sets_Tables.Create);
! 110: tstop(timer);
! 111: Write_Results(file,bs);
! 112: Write_Results(Standard_Output,bs);
! 113: new_line(file);
! 114: print_times(file,timer,"computation of generalized permanent");
! 115: end Driver_for_Bezout_Number;
! 116:
! 117: procedure Construct_Start_System
! 118: ( file : in file_type; n : in natural;
! 119: allperms : in boolean; v,w : List_of_Permutations;
! 120: notsymmetric,degenerate : out boolean ) is
! 121:
! 122: timer : timing_widget;
! 123: notequi,notsym,degen : boolean;
! 124:
! 125: begin
! 126: tstart(timer);
! 127: if allperms
! 128: then Equivariant_Start_System(n,v,notequi);
! 129: if notequi
! 130: then new_line; new_line(file);
! 131: put_line("The set structure is not equivariant.");
! 132: put_line(file,"The set structure is not equivariant.");
! 133: else notsym := false; degen := false;
! 134: end if;
! 135: end if;
! 136: if not allperms or notequi
! 137: then Symmetric_Start_System(n,bs,lpos,v,w,notsym,degen);
! 138: new_line; new_line(file);
! 139: if notsym
! 140: then
! 141: put_line("The set structure is not symmetric.");
! 142: put_line(file,"The set structure is not symmetric.");
! 143: else
! 144: if degen
! 145: then
! 146: put_line("The set structure is symmetric but degenerate.");
! 147: put_line(file,
! 148: "The set structure is symmetric but degenerate.");
! 149: else
! 150: put_line("The set structure is symmetric and not degenerate.");
! 151: put_line(file,
! 152: "The set structure is symmetric and not degenerate.");
! 153: end if;
! 154: end if;
! 155: end if;
! 156: notsymmetric := notsym;
! 157: degenerate := degen;
! 158: tstop(timer);
! 159: new_line(file);
! 160: print_times(file,timer,"construction of symmetric start system");
! 161: end Construct_Start_System;
! 162:
! 163: procedure Solve_Start_System
! 164: ( file : in file_type;
! 165: allperms : in boolean; v,w : in List_of_Permutations ) is
! 166:
! 167: timer : timing_widget;
! 168: nl : natural;
! 169: qq : Poly_Sys(p'range);
! 170: qqsols : Solution_List;
! 171:
! 172: begin
! 173: -- Random_Product_System_io.put(file,n,2,4,3);
! 174: qq := Random_Product_System.Polynomial_System;
! 175: new_line(file);
! 176: put_line(file,"SYMMETRIC LINEAR-PRODUCT SYSTEM : ");
! 177: put_line(file,qq);
! 178: -- put_line(file,"The list of positions : "); put(file,lpos);
! 179: -- if allperms
! 180: -- then Linear_Symmetric_Reduce(lpos,false);
! 181: -- else Linear_Symmetric_Reduce(v,w,lpos);
! 182: -- end if;
! 183: tstart(timer);
! 184: if allperms
! 185: then lpos := Linear_Symmetric_Reduce(false);
! 186: else lpos := Linear_Symmetric_Reduce(v,w);
! 187: end if;
! 188: -- put_line(file,"The reduced list of positions : "); put(file,lpos);
! 189: Random_Product_System.Solve(qqsols,nl,lpos);
! 190: tstop(timer);
! 191: Random_Product_System.Clear;
! 192: if allperms
! 193: then qqsols := Generating(qqsols,false,tol);
! 194: else Analyze(v,false,tol,qqsols);
! 195: end if;
! 196: Save_Results(qq,qqsols);
! 197: new_line(file);
! 198: put_line(file,"THE GENERATING SOLUTIONS :");
! 199: new_line(file);
! 200: put(file,Length_Of(qqsols),Head_Of(qqsols).n,qqsols);
! 201: Write_Orbits(file,qqsols);
! 202: new_line(file);
! 203: print_times(file,timer,"solving the linear-product system");
! 204: q := qq; qsols := qqsols;
! 205: end Solve_Start_System;
! 206:
! 207: procedure Driver_for_Start_System
! 208: ( file : in file_type; n : in natural;
! 209: allperms : in boolean; v,w : List_of_Permutations ) is
! 210:
! 211: ans : character;
! 212: notsym,degen : boolean;
! 213:
! 214: begin
! 215: new_line;
! 216: put("Do you want a symmetric linear-product start system ? ");
! 217: Ask_Yes_or_No(ans);
! 218: if ans = 'y'
! 219: then
! 220: Construct_Start_System(file,n,allperms,v,w,notsym,degen);
! 221: -- new_line(file); Write_Covering(file); new_line(file);
! 222: -- new_line(file); Write_Templates(file,n); new_line(file);
! 223: -- Symmetric_Set_Structure.Clear;
! 224: Set_Structure.Clear;
! 225: if not notsym and not degen
! 226: then Solve_Start_System(file,allperms,v,w);
! 227: end if;
! 228: end if;
! 229: end Driver_for_Start_System;
! 230:
! 231: procedure Main_Driver is
! 232:
! 233: totaltimer : timing_widget;
! 234: n : natural := p'length;
! 235: allperms,notsym,inva,equi : boolean;
! 236: g,v,w : List_of_Permutations;
! 237:
! 238: begin
! 239: new_line(file);
! 240: put_line(file,"SYMMETRIC SET STRUCTURE ANALYSIS :");
! 241: new_line(file);
! 242: Read_Permutation_Group(n,g,v,allperms);
! 243: tstart(totaltimer);
! 244: put_line(file,"THE SYMMETRY GROUP :");
! 245: new_line(file);
! 246: put_line(file,"v:"); Symbolic_Symmetry_Group_io.put(file,v);
! 247: new_line(file);
! 248: Act(v,p,w,notsym,inva,equi);
! 249: new_line(file);
! 250: put_line(file,"w:"); Symmetry_Group_io.put(file,w); new_line(file);
! 251: if notsym
! 252: then put_line("The system is not (G,V,W)-symmetric.");
! 253: put_line(file,"The system is not (G,V,W)-symmetric.");
! 254: else put_line("The system is (G,V,W)-symmetric.");
! 255: put_line(file,"The system is (G,V,W)-symmetric.");
! 256: if Set_Structure.Empty
! 257: then Driver_for_Bezout_Number(file);
! 258: end if;
! 259: if not Set_Structure.Empty
! 260: then Driver_for_Start_System(file,n,allperms,v,w);
! 261: end if;
! 262: end if;
! 263: tstop(totaltimer);
! 264: new_line(file);
! 265: print_times(file,totaltimer,"symmetric set structure analysis");
! 266: end Main_Driver;
! 267:
! 268: begin
! 269: Main_Driver;
! 270: end Driver_for_Symmetric_Random_Product_Systems;
! 271:
! 272: end Driver_for_Symmetric_Set_Structure;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to driver_for_symmetric_set_structure.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