Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Product/drivers_for_set_structures.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 Numbers_io; use Numbers_io;
! 5: with Standard_Natural_Vectors;
! 6: with Standard_Complex_Poly_Systems_io; use Standard_Complex_Poly_Systems_io;
! 7: with Standard_Complex_Solutions_io; use Standard_Complex_Solutions_io;
! 8: with Set_Structure,Set_Structure_io;
! 9: with Degree_Sets_Tables; use Degree_Sets_Tables;
! 10: with Random_Product_System;
! 11: with Random_Product_Start_Systems; use Random_Product_Start_Systems;
! 12:
! 13: package body Drivers_for_Set_Structures is
! 14:
! 15: procedure Set_Structure_Info is
! 16:
! 17: i : array(1..18) of string(1..65);
! 18:
! 19: begin
! 20: i( 1):=" A generalized Bezout number is based on a supporting set";
! 21: i( 2):="structure. A set structure is a tuple of arrays of subsets of";
! 22: i( 3):="unknowns. ";
! 23: i( 4):=" The corresponding start system is a linear-product system: the";
! 24: i( 5):="i-th equation is the product of linear equations with random";
! 25: i( 6):="coefficient in the unknowns of the set of the i-th array. The";
! 26: i( 7):="number of factors in the product for the i-th equation of the";
! 27: i( 8):="start system equals the number of subsets in the i-th array of";
! 28: i( 9):="the set structure. ";
! 29: i(10):=" A set structure is supporting for a polynomial system if every";
! 30: i(11):="monomial in the system also occurs in the corresponding linear-";
! 31: i(12):="product start system. ";
! 32: i(13):=" Given a supporting set structure, the generalized Bezout number";
! 33: i(14):="equals the number of solutions of the corresponding linear-";
! 34: i(15):="product start system. Before the construction of the start";
! 35: i(16):="system, a generalized Bezout number is first computed in a formal";
! 36: i(17):="way as a generalized permanent of a degree matrix. A heuristic";
! 37: i(18):="procedure is available for generating a supporting set structure.";
! 38: for k in i'range loop
! 39: put_line(i(k));
! 40: end loop;
! 41: end Set_Structure_Info;
! 42:
! 43: procedure Driver_for_Set_Structure
! 44: ( file : in file_type; p : in Poly_Sys;
! 45: b : in out natural; lpos : in out List;
! 46: q : out Poly_Sys; qsols : out Solution_List ) is
! 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 Display_Menu ( choice : out character; bb : in natural ) is
! 76:
! 77: ans : character;
! 78:
! 79: begin
! 80: new_line;
! 81: put_line("MENU for generalized Bezout Numbers based on Set Structures :");
! 82: put (" 0. exit - current Bezout number is "); put(bb,1); new_line;
! 83: put_line(" 1. Apply heuristic constructor for set structure");
! 84: put_line(" 2. Evaluate your own set structure");
! 85: put("Type 0, 1, or 2 to make your choice : ");
! 86: Ask_Alternative(ans,"012"); choice := ans;
! 87: end Display_Menu;
! 88:
! 89: procedure Dispatch_Menu ( file : in file_type;
! 90: choice : in character; bb : in out natural ) is
! 91: begin
! 92: case choice is
! 93: when '1' =>
! 94: Random_Product_Start_Systems.Build_Set_Structure(p);
! 95: bb := Permanent(Degree_Sets_Tables.Create);
! 96: when '2' =>
! 97: declare
! 98: ns : Standard_Natural_Vectors.Vector(p'range);
! 99: begin
! 100: for i in ns'range loop
! 101: put(" Give the number of sets for polynomial ");
! 102: put(i,1); put(" : "); 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: end;
! 108: bb := Permanent(Degree_Sets_Tables.Create);
! 109: when others => null;
! 110: end case;
! 111: Write_Results(Standard_Output,bb); Write_Results(file,bb);
! 112: end Dispatch_Menu;
! 113:
! 114: procedure Driver_for_Bezout_Number
! 115: ( file : in file_type; bb : in out natural ) is
! 116:
! 117: method : character;
! 118: timer : timing_widget;
! 119:
! 120: begin
! 121: new_line(file);
! 122: put_line(file,"SET STRUCTURE ANALYSIS :");
! 123: tstart(timer);
! 124: loop
! 125: Display_Menu(method,bb);
! 126: exit when method = '0';
! 127: Dispatch_Menu(file,method,bb);
! 128: end loop;
! 129: tstop(timer);
! 130: new_line(file);
! 131: print_times(file,timer,"set structure analysis");
! 132: end Driver_for_Bezout_Number;
! 133:
! 134: procedure Driver_for_Start_System
! 135: ( file : in file_type; bb : in natural ) is
! 136:
! 137: ans : character;
! 138: timer : timing_widget;
! 139: qq : Poly_Sys(p'range);
! 140: qqsols : Solution_List;
! 141:
! 142: begin
! 143: new_line;
! 144: put("Do you want a start system based on the set structure ? (y/n) ");
! 145: Ask_Yes_or_No(ans);
! 146: if ans = 'y'
! 147: then
! 148: declare
! 149: nl : natural;
! 150: n : natural := p'length;
! 151: begin
! 152: -- new_line;
! 153: -- put("Solving "); put(bb,1); put(" linear systems...");
! 154: tstart(timer);
! 155: Random_Product_System.Init(n);
! 156: Build_Random_Product_System(n);
! 157: Set_Structure.Clear;
! 158: qq := Random_Product_System.Polynomial_System;
! 159: -- Random_Product_System.Solve(qqsols,nl,lpos);
! 160: Random_Product_System.Solve(qqsols,nl);
! 161: Random_Product_System.Clear;
! 162: tstop(timer);
! 163: Save_Results(qq,qqsols);
! 164: q := qq; qsols := qqsols;
! 165: new_line(file);
! 166: put_line(file,"RANDOM LINEAR-PRODUCT START SYSTEM : ");
! 167: put_line(file,qq);
! 168: new_line(file);
! 169: put_line(file,"THE SOLUTIONS :");
! 170: new_line(file);
! 171: put(file,Length_Of(qqsols),Head_Of(qqsols).n,qqsols);
! 172: new_line(file);
! 173: print_times(file,timer,"constructing and solving the start system");
! 174: end;
! 175: else
! 176: Set_Structure.Clear;
! 177: -- Clear(lpos);
! 178: end if;
! 179: end Driver_for_Start_System;
! 180:
! 181: procedure Main_Driver is
! 182:
! 183: bb : natural := b;
! 184:
! 185: begin
! 186: Driver_for_Bezout_Number(file,bb);
! 187: if not Set_Structure.Empty
! 188: then b := bb;
! 189: Driver_for_Start_System(file,bb);
! 190: end if;
! 191: end Main_Driver;
! 192:
! 193: begin
! 194: Main_Driver;
! 195: end Driver_for_Set_Structure;
! 196:
! 197: end Drivers_for_Set_Structures;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to drivers_for_set_structures.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 / Product