Annotation of OpenXM_contrib/PHC/Ada/Schubert/ts_defpos.adb, Revision 1.1
1.1 ! maekawa 1: with text_io,integer_io; use text_io,integer_io;
! 2: with Communications_with_User; use Communications_with_User;
! 3: with Timing_Package; use Timing_Package;
! 4: with Standard_Complex_Matrices;
! 5: with Standard_Complex_Matrices_io; use Standard_Complex_Matrices_io;
! 6: with Standard_Random_Matrices; use Standard_Random_Matrices;
! 7: with Standard_Complex_VecMats; use Standard_Complex_VecMats;
! 8: with Symbol_Table; use Symbol_Table;
! 9: with Matrix_Indeterminates;
! 10: with Standard_Complex_Poly_Matrices;
! 11: with Standard_Complex_Poly_Matrices_io; use Standard_Complex_Poly_Matrices_io;
! 12: with Drivers_for_Poly_Continuation; use Drivers_for_Poly_Continuation;
! 13: with Brackets,Brackets_io; use Brackets,Brackets_io;
! 14: with Symbolic_Minor_Equations; use Symbolic_Minor_Equations;
! 15: with Pieri_Homotopies; use Pieri_Homotopies;
! 16: with Localization_Posets; use Localization_Posets;
! 17: with Localization_Posets_io; use Localization_Posets_io;
! 18: with Deformation_Posets; use Deformation_Posets;
! 19:
! 20: procedure ts_defpos is
! 21:
! 22: -- DESCRIPTION :
! 23: -- Test on the deformation posets.
! 24:
! 25: procedure Add_t_Symbol is
! 26:
! 27: -- DESCRIPTION :
! 28: -- Adds the symbol for the continuation parameter t to the symbol table.
! 29:
! 30: tsb : Symbol;
! 31:
! 32: begin
! 33: Symbol_Table.Enlarge(1);
! 34: tsb(1) := 't';
! 35: for i in 2..tsb'last loop
! 36: tsb(i) := ' ';
! 37: end loop;
! 38: Symbol_Table.Add(tsb);
! 39: end Add_t_Symbol;
! 40:
! 41: procedure Set_Parameters ( file : in file_type; report : out boolean ) is
! 42:
! 43: -- DESCRIPTION :
! 44: -- Interactive determination of the continuation and output parameters.
! 45:
! 46: oc : natural;
! 47:
! 48: begin
! 49: new_line;
! 50: Driver_for_Continuation_Parameters(file);
! 51: new_line;
! 52: Driver_for_Process_io(file,oc);
! 53: report := not (oc = 0);
! 54: new_line;
! 55: put_line("No more input expected. See output file for results...");
! 56: new_line;
! 57: new_line(file);
! 58: end Set_Parameters;
! 59:
! 60: function Random_Input_Planes ( m,p : natural ) return VecMat is
! 61:
! 62: -- DESCRIPTION :
! 63: -- Returns a vector of m*p random m-planes.
! 64:
! 65: res : VecMat(1..m*p);
! 66: n : constant natural := m+p;
! 67:
! 68: begin
! 69: for i in res'range loop
! 70: res(i) := new Standard_Complex_Matrices.Matrix'(Random_Matrix(n,m));
! 71: end loop;
! 72: return res;
! 73: end Random_Input_Planes;
! 74:
! 75: function Random_Input_Planes ( m,p : natural; k : Bracket ) return VecMat is
! 76:
! 77: -- DESCRIPTION :
! 78: -- Returns a vector of m*p random m-planes.
! 79:
! 80: res : VecMat(k'range);
! 81: n : constant natural := m+p;
! 82:
! 83: begin
! 84: for i in res'range loop
! 85: res(i)
! 86: := new Standard_Complex_Matrices.Matrix'(Random_Matrix(n,m+1-k(i)));
! 87: end loop;
! 88: return res;
! 89: end Random_Input_Planes;
! 90:
! 91: procedure Solve_Deformation_Poset
! 92: ( file : in file_type; m,p : in natural;
! 93: level_poset : in Array_of_Nodes;
! 94: index_poset : in Array_of_Array_of_Nodes ) is
! 95:
! 96: -- DESCRIPTION :
! 97: -- Creates a deformation poset and applies the Solve operator.
! 98:
! 99: deform_poset : Array_of_Array_of_VecMats(index_poset'range)
! 100: := Create(index_poset);
! 101: planes : VecMat(1..m*p) := Random_Input_Planes(m,p);
! 102: report : boolean;
! 103: timer : Timing_Widget;
! 104: target_level : natural := m*p;
! 105: nbp : natural := 0;
! 106:
! 107: begin
! 108: put_line("The size of the deformation poset : ");
! 109: put_line(file,"The size of the deformation poset : ");
! 110: put_roco(index_poset);
! 111: put_roco(file,index_poset);
! 112: new_line;
! 113: put("Give target level <= "); put(target_level,1);
! 114: put(" = root level : "); get(target_level);
! 115: for i in 1..target_level loop
! 116: nbp := nbp + Row_Root_Count_Sum(level_poset,i);
! 117: end loop;
! 118: put("The number of paths : "); put(nbp,1); new_line;
! 119: put(file,"The number of paths : "); put(file,nbp,1); new_line(file);
! 120: Matrix_Indeterminates.Initialize_Symbols(m+p,p);
! 121: Add_t_Symbol;
! 122: skip_line;
! 123: Set_Parameters(file,report);
! 124: tstart(timer);
! 125: for i in index_poset(target_level)'range loop
! 126: declare
! 127: root : Node := index_poset(target_level)(i).all;
! 128: begin
! 129: Solve(file,m+p,deform_poset,root,planes,report);
! 130: end;
! 131: end loop;
! 132: tstop(timer);
! 133: new_line(file);
! 134: print_times(file,timer,"Solving along the deformation poset");
! 135: end Solve_Deformation_Poset;
! 136:
! 137: procedure Solve_Deformation_Poset
! 138: ( file : in file_type; m,p : in natural; k : in Bracket;
! 139: index_poset : in Array_of_Array_of_Nodes ) is
! 140:
! 141: -- DESCRIPTION :
! 142: -- Applies the solver to general intersection conditions.
! 143:
! 144: deform_poset : Array_of_Array_of_VecMats(index_poset'range)
! 145: := Create(index_poset);
! 146: planes : VecMat(k'range) := Random_Input_Planes(m,p,k);
! 147: report : boolean;
! 148: timer : Timing_Widget;
! 149: target_level : natural := m*p;
! 150:
! 151: begin
! 152: put_line("The size of the deformation poset : ");
! 153: put_line(file,"The size of the deformation poset : ");
! 154: put_roco(index_poset);
! 155: put_roco(file,index_poset);
! 156: new_line;
! 157: put("Give target level <= "); put(target_level,1);
! 158: put(" = root level : "); get(target_level);
! 159: Matrix_Indeterminates.Initialize_Symbols(m+p,p);
! 160: Add_t_Symbol;
! 161: skip_line;
! 162: Set_Parameters(file,report);
! 163: tstart(timer);
! 164: for i in index_poset(target_level)'range loop
! 165: declare
! 166: root : Node := index_poset(target_level)(i).all;
! 167: begin
! 168: if ((root.tp = top) or (root.tp = bottom))
! 169: then --One_Solve(file,m+p,k,deform_poset,root,planes,report);
! 170: Solve(file,m+p,k,deform_poset,root,planes,report);
! 171: else Solve(file,m+p,k,deform_poset,root,planes,report);
! 172: end if;
! 173: end;
! 174: end loop;
! 175: tstop(timer);
! 176: new_line(file);
! 177: print_times(file,timer,"Solving along the deformation poset");
! 178: end Solve_Deformation_Poset;
! 179:
! 180: procedure Create_Top_Hypersurface_Poset
! 181: ( file : in file_type; m,p : in natural ) is
! 182:
! 183: -- DESCRIPTION :
! 184: -- Create the poset by incrementing only top pivots.
! 185:
! 186: root : Node(p) := Trivial_Root(m,p);
! 187: lnkroot : Link_to_Node := new Node'(root);
! 188: level_poset : Array_of_Nodes(0..m*p);
! 189: index_poset : Array_of_Array_of_Nodes(0..m*p);
! 190:
! 191: begin
! 192: Top_Create(lnkroot,m+p);
! 193: put_line("The poset created from the top : ");
! 194: put_line(file,"The poset created from the top : ");
! 195: level_poset := Create_Leveled_Poset(lnkroot);
! 196: Count_Roots(level_poset);
! 197: index_poset := Create_Indexed_Poset(level_poset);
! 198: put(index_poset);
! 199: put(file,index_poset);
! 200: Solve_Deformation_Poset(file,m,p,level_poset,index_poset);
! 201: end Create_Top_Hypersurface_Poset;
! 202:
! 203: procedure Create_Bottom_Hypersurface_Poset
! 204: ( file : in file_type; m,p : in natural ) is
! 205:
! 206: -- DESCRIPTION :
! 207: -- Create the poset by decrementing only bottom pivots.
! 208:
! 209: root : Node(p) := Trivial_Root(m,p);
! 210: lnkroot : Link_to_Node := new Node'(root);
! 211: level_poset : Array_of_Nodes(0..m*p);
! 212: index_poset : Array_of_Array_of_Nodes(0..m*p);
! 213:
! 214: begin
! 215: Bottom_Create(lnkroot);
! 216: put_line("The poset created from the bottom : ");
! 217: put_line(file,"The poset created from the bottom : ");
! 218: level_poset := Create_Leveled_Poset(lnkroot);
! 219: Count_Roots(level_poset);
! 220: index_poset := Create_Indexed_Poset(level_poset);
! 221: put(index_poset);
! 222: put(file,index_poset);
! 223: Solve_Deformation_Poset(file,m,p,level_poset,index_poset);
! 224: end Create_Bottom_Hypersurface_Poset;
! 225:
! 226: procedure Create_Mixed_Hypersurface_Poset
! 227: ( file : in file_type; m,p : in natural ) is
! 228:
! 229: -- DESCRIPTION :
! 230: -- Create the poset by incrementing top and decrementing bottom pivots.
! 231:
! 232: root : Node(p) := Trivial_Root(m,p);
! 233: lnkroot : Link_to_Node := new Node'(root);
! 234: level_poset : Array_of_Nodes(0..m*p);
! 235: index_poset : Array_of_Array_of_Nodes(0..m*p);
! 236:
! 237: begin
! 238: Top_Bottom_Create(lnkroot,m+p);
! 239: put_line("The poset created in a mixed fashion : ");
! 240: put_line(file,"The poset created in a mixed fashion : ");
! 241: level_poset := Create_Leveled_Poset(lnkroot);
! 242: Count_Roots(level_poset);
! 243: index_poset := Create_Indexed_Poset(level_poset);
! 244: put(index_poset);
! 245: put(file,index_poset);
! 246: Solve_Deformation_Poset(file,m,p,level_poset,index_poset);
! 247: end Create_Mixed_Hypersurface_Poset;
! 248:
! 249: function Finite ( dim : Bracket; m,p : natural ) return boolean is
! 250:
! 251: -- DESCRIPTION :
! 252: -- Returns true if the codimensions yield a finite number of solutions.
! 253:
! 254: sum : natural := 0;
! 255:
! 256: begin
! 257: for i in dim'range loop
! 258: sum := sum + dim(i);
! 259: end loop;
! 260: if sum = m*p
! 261: then return true;
! 262: else return false;
! 263: end if;
! 264: end Finite;
! 265:
! 266: function Read_Codimensions ( m,p : natural ) return Bracket is
! 267:
! 268: -- DESCRIPTION :
! 269: -- Reads the vector of codimensions and checks on finiteness.
! 270:
! 271: codim : Bracket(1..m*p);
! 272: n : natural;
! 273: poset : Array_of_Nodes(0..m*p);
! 274:
! 275: begin
! 276: loop
! 277: put("Give number of intersection conditions : "); get(n);
! 278: put("Give "); put(n,1); put(" codimensions : ");
! 279: for i in 1..n loop
! 280: get(codim(i));
! 281: end loop;
! 282: for i in 1..n-1 loop
! 283: put(codim(i),1); put(" + ");
! 284: end loop;
! 285: put(codim(n),1);
! 286: if Finite(codim(1..n),m,p)
! 287: then put(" = "); put(m*p,1); put_line(" Finite #sols.");
! 288: exit;
! 289: else put(" /= "); put(m*p,1);
! 290: put_line(" Please try again.");
! 291: end if;
! 292: end loop;
! 293: return codim(1..n);
! 294: end Read_Codimensions;
! 295:
! 296: procedure Create_Top_General_Poset
! 297: ( file : in file_type; m,p : in natural ) is
! 298:
! 299: -- DESCRIPTION :
! 300: -- Creates a poset for counting general subspace intersections,
! 301: -- by consistently incrementing the top pivots.
! 302:
! 303: root : Node(p) := Trivial_Root(m,p);
! 304: lnkroot : Link_to_Node := new Node'(root);
! 305: codim : constant Bracket := Read_Codimensions(m,p);
! 306: level_poset : Array_of_Nodes(0..m*p);
! 307: index_poset : Array_of_Array_of_Nodes(0..m*p);
! 308:
! 309: begin
! 310: put(file," k = "); put(file,codim); new_line(file);
! 311: Top_Create(lnkroot,codim,m+p);
! 312: put_line("The poset created from the top : ");
! 313: put_line(file,"The poset created from the top : ");
! 314: level_poset := Create_Leveled_Poset(lnkroot);
! 315: Count_Roots(level_poset);
! 316: index_poset := Create_Indexed_Poset(level_poset);
! 317: put(index_poset);
! 318: put(file,index_poset);
! 319: Solve_Deformation_Poset(file,m,p,codim,index_poset);
! 320: end Create_Top_General_Poset;
! 321:
! 322: procedure Create_Bottom_General_Poset
! 323: ( file : in file_type; m,p : in natural ) is
! 324:
! 325: -- DESCRIPTION :
! 326: -- Creates a poset for counting general subspace intersections,
! 327: -- by consistently incrementing the top pivots.
! 328:
! 329: root : Node(p) := Trivial_Root(m,p);
! 330: lnkroot : Link_to_Node := new Node'(root);
! 331: codim : constant Bracket := Read_Codimensions(m,p);
! 332: level_poset : Array_of_Nodes(0..m*p);
! 333: index_poset : Array_of_Array_of_Nodes(0..m*p);
! 334:
! 335: begin
! 336: put(file," k = "); put(file,codim); new_line(file);
! 337: Bottom_Create(lnkroot,codim);
! 338: put_line("The poset created from the bottom : ");
! 339: put_line(file,"The poset created from the bottom : ");
! 340: level_poset := Create_Leveled_Poset(lnkroot);
! 341: Count_Roots(level_poset);
! 342: index_poset := Create_Indexed_Poset(level_poset);
! 343: put(index_poset);
! 344: put(file,index_poset);
! 345: Solve_Deformation_Poset(file,m,p,codim,index_poset);
! 346: end Create_Bottom_General_Poset;
! 347:
! 348: procedure Create_Mixed_General_Poset
! 349: ( file : in file_type; m,p : in natural ) is
! 350:
! 351: -- DESCRIPTION :
! 352: -- Creates a poset for counting general subspace intersections,
! 353: -- by incrementing the top and decrementing the bottom pivots.
! 354:
! 355: root : Node(p) := Trivial_Root(m,p);
! 356: lnkroot : Link_to_Node := new Node'(root);
! 357: codim : constant Bracket := Read_Codimensions(m,p);
! 358: level_poset : Array_of_Nodes(0..m*p);
! 359: index_poset : Array_of_Array_of_Nodes(0..m*p);
! 360:
! 361: begin
! 362: put(file," k = "); put(file,codim); new_line(file);
! 363: Top_Bottom_Create(lnkroot,codim,m+p);
! 364: put_line("The poset created in a mixed fashion : ");
! 365: put_line(file,"The poset created in a mixed fashion : ");
! 366: level_poset := Create_Leveled_Poset(lnkroot);
! 367: Count_Roots(level_poset);
! 368: index_poset := Create_Indexed_Poset(level_poset);
! 369: put(index_poset);
! 370: put(file,index_poset);
! 371: Solve_Deformation_Poset(file,m,p,codim,index_poset);
! 372: end Create_Mixed_General_Poset;
! 373:
! 374: procedure Main is
! 375:
! 376: m,p : natural;
! 377: ans : character;
! 378: file : file_type;
! 379:
! 380: begin
! 381: new_line;
! 382: put_line("MENU for posets for deforming p-planes in (m+p)-space : ");
! 383: put_line(" 1. k_i = 1 consistently incrementing the top pivots.");
! 384: put_line(" 2. consistently decrementing the bottom pivots.");
! 385: put_line(" 3. mixed top-bottom sequence for poset creation.");
! 386: put_line(" 4. k_i >= 1 consistently incrementing the top pivots.");
! 387: put_line(" 5. consistently decrementing the bottom pivots.");
! 388: put_line(" 6. mixed top-bottom sequence for poset creation.");
! 389: put("Type 1, 2, 3, 4, 5, or 6 to choose : "); get(ans);
! 390: skip_line; new_line;
! 391: put_line("Reading the name of the file for the deformations.");
! 392: Read_Name_and_Create_File(file);
! 393: new_line;
! 394: put("Give p, the number of entries in bracket : "); get(p);
! 395: put("Give m, the complementary dimension : "); get(m);
! 396: put(file,"p = "); put(file,p,1); put(file," m = "); put(file,m,1);
! 397: new_line;
! 398: case ans is
! 399: when '1' => new_line(file); Create_Top_Hypersurface_Poset(file,m,p);
! 400: when '2' => new_line(file); Create_Bottom_Hypersurface_Poset(file,m,p);
! 401: when '3' => new_line(file); Create_Mixed_Hypersurface_Poset(file,m,p);
! 402: when '4' => Create_Top_General_Poset(file,m,p);
! 403: when '5' => Create_Bottom_General_Poset(file,m,p);
! 404: when '6' => Create_Mixed_General_Poset(file,m,p);
! 405: when others => put_line("Option not recognized. Please try again.");
! 406: end case;
! 407: end Main;
! 408:
! 409: begin
! 410: new_line;
! 411: put_line("Test on deformation posets for linear subspace intersections.");
! 412: Main;
! 413: end ts_defpos;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ts_defpos.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Schubert