Annotation of OpenXM_contrib/PHC/Ada/Schubert/deformation_posets.adb, Revision 1.1.1.1
1.1 maekawa 1: with unchecked_deallocation;
2: with integer_io; use integer_io;
3: with Timing_Package; use Timing_Package;
4: with Characters_and_Numbers; use Characters_and_Numbers;
5: with Standard_Floating_Numbers; use Standard_Floating_Numbers;
6: with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
7: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
8: with Standard_Complex_Numbers_io; use Standard_Complex_Numbers_io;
9: with Standard_Complex_Vectors_io; use Standard_Complex_Vectors_io;
10: with Standard_Natural_Matrices;
11: with Standard_Complex_Matrices;
12: with Standard_Complex_Matrices_io; use Standard_Complex_Matrices_io;
13: with Standard_Complex_Polynomials; use Standard_Complex_Polynomials;
14: with Symbol_Table; use Symbol_Table;
15: with Standard_Complex_Poly_Functions; use Standard_Complex_Poly_Functions;
16: with Standard_Complex_Poly_SysFun; use Standard_Complex_Poly_SysFun;
17: with Standard_Complex_Poly_Systems; use Standard_Complex_Poly_Systems;
18: with Standard_Complex_Poly_Systems_io; use Standard_Complex_Poly_Systems_io;
19: with Standard_Complex_Poly_Matrices;
20: with Standard_Complex_Poly_Matrices_io; use Standard_Complex_Poly_Matrices_io;
21: with Brackets,Brackets_io; use Brackets,Brackets_io;
22: with Bracket_Monomials; use Bracket_Monomials;
23: with Bracket_Polynomials; use Bracket_Polynomials;
24: with Bracket_Systems; use Bracket_Systems;
25: with Bracket_Systems_io; use Bracket_Systems_io;
26: with Plane_Representations; use Plane_Representations;
27: with Symbolic_Minor_Equations; use Symbolic_Minor_Equations;
28: with Numeric_Minor_Equations; use Numeric_Minor_Equations;
29: with Determinantal_Systems; use Determinantal_Systems;
30: with Specialization_of_Planes; use Specialization_of_Planes;
31: with Curves_into_Grassmannian; use Curves_into_Grassmannian;
32: with Curves_into_Grassmannian_io; use Curves_into_Grassmannian_io;
33: with Pieri_Homotopies; use Pieri_Homotopies;
34: with Pieri_Continuation; use Pieri_Continuation;
35:
36: package body Deformation_Posets is
37:
38: -- BRACKET AUXILIARITIES TO DETERMINE PIVOTS :
39:
40: function Complement ( n : natural; b : Bracket ) return Bracket is
41:
42: -- DESCRIPTION :
43: -- Returns the complement of the bracket b, defined as a bracket
44: -- of range 1..n-b'length as an ordered subset of {1..n} \ b.
45:
46: res : Bracket(1..n-b'last);
47: cnt : natural := 0;
48: ind : natural := 1;
49:
50: begin
51: for i in 1..n loop
52: if ((ind > b'last) or else (i < b(ind)))
53: then cnt := cnt+1;
54: res(cnt) := i;
55: elsif i = b(ind)
56: then ind := ind+1;
57: end if;
58: end loop;
59: return res;
60: end Complement;
61:
62: function Remove ( b : Bracket; l : natural ) return Bracket is
63:
64: -- DESCRIPTION :
65: -- Returns a smaller bracket that does not contain l.
66:
67: -- REQUIRED : there exists a k: b(k) = l.
68:
69: res : Bracket(1..b'last-1);
70: cnt : natural := 0;
71:
72: begin
73: for i in b'range loop
74: if b(i) /= l
75: then cnt := cnt+1;
76: res(cnt) := b(i);
77: end if;
78: end loop;
79: return res;
80: end Remove;
81:
82: function Is_In ( b : Bracket; l : natural ) return boolean is
83:
84: -- DESCRIPTION :
85: -- Returns true if there exists an index k such that b(k) = l.
86:
87: begin
88: for k in b'range loop
89: if b(k) = l
90: then return true;
91: end if;
92: end loop;
93: return false;
94: end Is_In;
95:
96: function Remove ( b1,b2 : Bracket ) return Bracket is
97:
98: -- DESCRIPTION :
99: -- Returns b1 minus the first element in b2 that also occurs in b1.
100:
101: begin
102: for i in b2'range loop
103: if Is_In(b1,b2(i))
104: then return Remove(b1,b2(i));
105: end if;
106: end loop;
107: return b1;
108: end Remove;
109:
110: function Remove ( cols,b,subb : Bracket ) return Bracket is
111:
112: -- DESCRIPTION :
113: -- The indices in cols correspond to the entries in b.
114: -- The bracket subb is a sub-bracket of b, with only one entry removed.
115: -- The indices on return correspond to the entries in subb.
116:
117: res : Bracket(subb'range);
118:
119: begin
120: for i in subb'range loop
121: if b(i) = subb(i)
122: then res(i) := cols(i);
123: else res(i) := cols(i+1);
124: end if;
125: end loop;
126: return res;
127: end Remove;
128:
129: -- POSET-ORIENTED PIERI DEFORMATIONS :
130:
131: function Leaf_Plane ( n : natural; nd : Node )
132: return Standard_Complex_Matrices.Matrix is
133:
134: -- DESCRIPTION :
135: -- Returns the solution plane that corresponds to a leaf of the poset.
136:
137: res : Standard_Complex_Matrices.Matrix(1..n,nd.top'range);
138:
139: begin
140: for i in res'range(1) loop
141: for j in res'range(2) loop
142: res(i,j) := Create(0.0);
143: end loop;
144: end loop;
145: for i in nd.top'range loop
146: res(nd.top(i),i) := Create(1.0);
147: end loop;
148: return res;
149: end Leaf_Plane;
150:
151: -- DEFORMATIONS :
152:
153: function Path_Coordinates ( level,label,child : natural )
154: return string is
155: begin
156: return "tracing (User time) at node("
157: & Convert(level) & ")("
158: & Convert(label) & ") from child "
159: & Convert(child);
160: end Path_Coordinates;
161:
162: procedure Write_Path_Coordinates
163: ( file : in file_type;
164: level,label,path,child,childpath : in natural ) is
165:
166: -- DESCRIPTION :
167: -- Writes all coordinates from the current path that is to be traced.
168:
169: begin
170: put(file,"Tracing at node("); put(file,level,1); put(file,")(");
171: put(file,label,1); put(file,") path "); put(file,path,1);
172: put(file," as path "); put(file,childpath,1);
173: put(file," from child "); put(file,child,1); new_line(file);
174: end Write_Path_Coordinates;
175:
176: procedure Write_Path_Coordinates
177: ( file : in file_type;
178: level,label,child : in natural ) is
179:
180: -- DESCRIPTION :
181: -- Writes all coordinates from the current path that is to be traced.
182:
183: begin
184: put(file,"Tracing paths at node("); put(file,level,1); put(file,")(");
185: put(file,label,1);
186: put(file,") from child "); put(file,child,1); new_line(file);
187: end Write_Path_Coordinates;
188:
189: procedure Deform_from_Children
190: ( file : in file_type;
191: poset : in out Array_of_Array_of_VecMats;
192: nd : in Node; n,uplevel : in natural;
193: homotopy : in Poly_Sys; report,outlog : in boolean;
194: x : in Standard_Complex_Poly_Matrices.Matrix;
195: npaths : in out Standard_Natural_Vectors.Vector;
196: timings : in out Duration_Array ) is
197:
198: -- DESCRIPTION :
199: -- Deforms from the i-th non-empty child of nd at uplevel.
200:
201: -- ON ENTRY :
202: -- file to write intermediate results on;
203: -- poset poset of solution p-planes;
204: -- nd current node in the localization poset;
205: -- n dimension of the working space;
206: -- uplevel level where to find the start planes in the poset;
207: -- homotopy family of moving planes;
208: -- report indicates whether intermediate output during continuation;
209: -- outlog flag to write homotopies on file if set to true.
210: -- x matrix of unknowns according to a localization pattern.
211:
212: -- ON RETURN :
213: -- poset updated poset of solution p-planes;
214: -- npaths updated number of paths traced at that level;
215: -- timings updated elapsed user timings.
216:
217: locmap : Standard_Natural_Matrices.Matrix(1..n,1..nd.p);
218: solcnt : natural := 0;
219: label : natural;
220:
221: begin
222: for i in nd.child_labels'range loop
223: label := nd.child_labels(i);
224: if not Empty(poset,uplevel,label) -- child.roco > 0
225: then
226: Write_Path_Coordinates(file,nd.level,nd.label,label);
227: declare
228: planes : VecMat(poset(uplevel)(label)'range);
229: timer : Timing_Widget;
230: begin
231: tstart(timer);
232: for i in planes'range loop -- create to avoid sharing
233: planes(i) := new Standard_Complex_Matrices.Matrix'
234: (poset(uplevel)(label)(i).all);
235: end loop;
236: locmap := Standard_Coordinate_Frame(x,planes(planes'first).all);
237: Trace_Paths(file,homotopy,locmap,report,outlog,planes);
238: for i in planes'range loop
239: solcnt := solcnt+1;
240: poset(nd.level)(nd.label)(solcnt) := planes(i);
241: end loop;
242: tstop(timer);
243: new_line(file);
244: print_times(file,timer,Path_Coordinates(nd.level,nd.label,label));
245: new_line(file);
246: timings(nd.level) := timings(nd.level) + Elapsed_User_Time(timer);
247: end;
248: end if;
249: end loop;
250: npaths(nd.level) := npaths(nd.level) + solcnt;
251: end Deform_from_Children;
252:
253: procedure Quantum_Deform_from_Children
254: ( file : in file_type;
255: poset : in out Array_of_Array_of_VecMats;
256: nd : in Node; n,q,uplevel : in natural;
257: homotopy : in Poly_Sys; conpar,s_mode : in natural;
258: report,outlog : in boolean;
259: x : in Standard_Complex_Poly_Matrices.Matrix;
260: npaths : in out Standard_Natural_Vectors.Vector;
261: timings : in out Duration_Array ) is
262:
263: -- DESCRIPTION :
264: -- Deforms from the i-th non-empty child of nd at uplevel.
265: -- This is the quantum analogue to the hypersurface Pieri.
266:
267: -- ON ENTRY :
268: -- file to write intermediate results on;
269: -- poset poset of solution p-planes;
270: -- nd current node in the localization poset;
271: -- n dimension of the working space;
272: -- q degree of the curve;
273: -- uplevel level where to find the start planes in the poset;
274: -- homotopy family of moving planes;
275: -- conpar number of the continuation parameter;
276: -- s_mode if = 0, then s = 0, otherwise s = 1 at start;
277: -- report indicates whether intermediate output during continuation;
278: -- outlog flag to write homotopies on file if set to true;
279: -- x symbolic representation of the curve matrix of polynomials.
280:
281: -- ON RETURN :
282: -- poset updated poset of solution p-planes;
283: -- npaths updated number of paths at each level;
284: -- timings updated CPU user timings for each level.
285:
286: m : constant natural := n - nd.p;
287: rws : constant natural := n*(q+1);
288: locmap : Standard_Natural_Matrices.Matrix(1..rws,1..nd.p);
289: solcnt : natural := 0;
290: label : natural;
291:
292: begin
293: for i in nd.child_labels'range loop
294: label := nd.child_labels(i);
295: if not Empty(poset,uplevel,label) -- child.roco > 0
296: then
297: Write_Path_Coordinates(file,nd.level,nd.label,label);
298: declare
299: planes : VecMat(poset(uplevel)(label)'range);
300: timer : Timing_Widget;
301: begin
302: tstart(timer);
303: for i in planes'range loop -- create to avoid sharing
304: planes(i) := new Standard_Complex_Matrices.Matrix'
305: (poset(uplevel)(label)(i).all);
306: end loop;
307: locmap := Standard_Coordinate_Frame
308: (m,nd.p,q,nd.top,nd.bottom,planes(planes'first).all);
309: Quantum_Trace_Paths
310: (file,m,nd.p,q,nd,homotopy,conpar,s_mode,locmap,
311: report,outlog,planes);
312: for i in planes'range loop
313: solcnt := solcnt+1;
314: poset(nd.level)(nd.label)(solcnt) := planes(i);
315: end loop;
316: tstop(timer);
317: new_line(file);
318: print_times(file,timer,Path_Coordinates(nd.level,nd.label,label));
319: new_line(file);
320: timings(nd.level) := timings(nd.level) + Elapsed_User_Time(timer);
321: end;
322: end if;
323: end loop;
324: npaths(nd.level) := npaths(nd.level) + solcnt;
325: end Quantum_Deform_from_Children;
326:
327: procedure Hypersurface_Deform
328: ( file : in file_type; n : in natural;
329: poset : in out Array_of_Array_of_VecMats;
330: nd : in Node; expbp : in Bracket_Polynomial;
331: planes : in VecMat; report,outlog : in boolean;
332: npaths : in out Standard_Natural_Vectors.Vector;
333: timings : in out Duration_Array ) is
334:
335: -- DESCRIPTION :
336: -- Does the Pieri deformations to the node, same specifications as Solve
337: -- for the hypersurface case.
338:
339: -- REQUIRED : nd.level > 0, solutions at children of nd are in poset.
340:
341: xpm : Standard_Complex_Poly_Matrices.Matrix(1..n,1..nd.p)
342: := Localization_Pattern(n,nd.top,nd.bottom);
343: homsys : Poly_Sys(1..nd.level);
344:
345: begin
346: if nd.tp = mixed
347: then homsys := Two_Hypersurface_Pieri_Homotopy(n,nd,expbp,xpm,planes);
348: Deform_from_Children
349: (file,poset,nd,n,nd.level-2,homsys,report,outlog,
350: xpm,npaths,timings);
351: else homsys := One_Hypersurface_Pieri_Homotopy(n,nd,expbp,xpm,planes);
352: Deform_from_Children
353: (file,poset,nd,n,nd.level-1,homsys,report,outlog,
354: xpm,npaths,timings);
355: end if;
356: Standard_Complex_Poly_Matrices.Clear(xpm);
357: Clear(homsys);
358: end Hypersurface_Deform;
359:
360: procedure One_General_Deform
361: ( file : in file_type; n,ind : in natural;
362: poset : in out Array_of_Array_of_VecMats; nd : in Node;
363: start,target : in Standard_Complex_Matrices.Matrix;
364: planes : in VecMat; bs : in Bracket_System;
365: report,outlog : in boolean;
366: npaths : in out Standard_Natural_Vectors.Vector;
367: timings : in out Duration_Array ) is
368:
369: -- DESCRIPTION :
370: -- Does the Pieri deformations to the node, same specifications as Solve
371: -- for the general case.
372:
373: -- REQUIRED : nd.level > 0, solutions at children of nd are in poset.
374:
375: -- ON ENTRY :
376: -- file to write intermediate output to;
377: -- n number of rows in the matrices;
378: -- ind planes(ind) is currently being folded in with this chain;
379: -- poset contains solution planes at higher levels;
380: -- nd current node in the localization poset;
381: -- start start (m+1-k)-plane for pivots;
382: -- target target (m+1-k)-plane for pivots;
383: -- planes target planes;
384: -- bs structure to expand the minors;
385: -- report switch to determine output during continuation;
386: -- outlog flag to write homotopies on file if set to true.
387:
388: -- ON RETURN :
389: -- poset solution planes at (nd.level)(nd.label) are determined;
390: -- npaths number of paths followed at each level;
391: -- timings CPU user time at each level.
392:
393: xpm : Standard_Complex_Poly_Matrices.Matrix(1..n,1..nd.p)
394: := Localization_Pattern(n,nd.top,nd.bottom);
395: hom : Link_to_Poly_Sys
396: := One_General_Pieri_Homotopy(n,ind,nd,bs,start,target,xpm,planes);
397:
398: begin
399: Deform_from_Children
400: (file,poset,nd,n,nd.level-1,hom.all,report,outlog,xpm,npaths,timings);
401: Standard_Complex_Poly_Matrices.Clear(xpm);
402: Clear(hom);
403: end One_General_Deform;
404:
405: procedure Two_General_Deform
406: ( file : in file_type; n,ind : in natural;
407: poset : in out Array_of_Array_of_VecMats; nd : in Node;
408: top_start,top_target,bot_start,bot_target
409: : in Standard_Complex_Matrices.Matrix;
410: planes : in VecMat; top_bs,bot_bs : in Bracket_System;
411: report,outlog : in boolean;
412: npaths : in out Standard_Natural_Vectors.Vector;
413: timings : in out Duration_Array ) is
414:
415: -- DESCRIPTION :
416: -- Does the Pieri deformations to the node, same specifications as Solve
417: -- for the general case.
418:
419: -- REQUIRED : nd.level > 0, solutions at children of nd are in poset.
420:
421: -- ON ENTRY :
422: -- file to write intermediate output to;
423: -- n number of rows in the matrices;
424: -- ind planes(ind) is currently being folded in with this chain;
425: -- poset contains solution planes at higher levels;
426: -- nd current node in the localization poset;
427: -- top_start start (m+1-k)-plane for top pivots;
428: -- top_target target (m+1-k)-plane for top pivots;
429: -- bot_start start (m+1-k)-plane for bottom pivots;
430: -- bot_target target (m+1-k)-plane for bottom pivots;
431: -- planes target planes;
432: -- top_bs structure to expand the minors for top pivots;
433: -- bot_bs structure to expand the minors for bottom pivots;
434: -- report switch to determine output during continuation;
435: -- outlog flag to write homotopies on file if set to true.
436:
437: -- ON RETURN :
438: -- poset solution planes at (nd.level)(nd.label) are determined;
439: -- npaths number of paths traced at each level;
440: -- timings updated CPU user times for each level.
441:
442: xpm : Standard_Complex_Poly_Matrices.Matrix(1..n,1..nd.p)
443: := Localization_Pattern(n,nd.top,nd.bottom);
444: homotopy : Link_to_Poly_Sys;
445:
446: begin
447: case nd.tp is
448: when top
449: => homotopy := One_General_Pieri_Homotopy
450: (n,ind,nd,top_bs,top_start,top_target,xpm,planes);
451: Deform_from_Children
452: (file,poset,nd,n,nd.level-1,homotopy.all,report,outlog,xpm,
453: npaths,timings);
454: when bottom
455: => homotopy := One_General_Pieri_Homotopy
456: (n,ind,nd,bot_bs,bot_start,bot_target,xpm,planes);
457: Deform_from_Children
458: (file,poset,nd,n,nd.level-1,homotopy.all,report,outlog,xpm,
459: npaths,timings);
460: when mixed
461: => homotopy := Two_General_Pieri_Homotopy
462: (n,ind,nd,top_bs,bot_bs,top_start,top_target,
463: bot_start,bot_target,xpm,planes);
464: Deform_from_Children
465: (file,poset,nd,n,nd.level-2,homotopy.all,report,outlog,xpm,
466: npaths,timings);
467: end case;
468: Standard_Complex_Poly_Matrices.Clear(xpm);
469: Clear(homotopy);
470: end Two_General_Deform;
471:
472: procedure Quantum_Deform
473: ( file : in file_type; n,q : in natural;
474: poset : in out Array_of_Array_of_VecMats;
475: nd : in Node; expbp : in Bracket_Polynomial;
476: planes : in VecMat; s : Standard_Complex_Vectors.Vector;
477: report,outlog : in boolean;
478: npaths : in out Standard_Natural_Vectors.Vector;
479: timings : in out Duration_Array ) is
480:
481: -- DESCRIPTION :
482: -- This is the q-analogue to the Hypersurface Deform.
483:
484: -- REQUIRED : nd.level > 0, solutions at children of nd are in poset.
485:
486: m : constant natural := n-nd.p;
487: xpm : Standard_Complex_Poly_Matrices.Matrix(1..n,1..nd.p)
488: := Symbolic_Create(m,nd.p,q,nd.top,nd.bottom);
489:
490: begin
491: if outlog
492: then put(file,"Curve at node(");
493: put(file,nd.level,1); put(file,")("); put(file,nd.label,1);
494: put(file,") for pivots (");
495: put(file,nd.top); put(file,","); put(file,nd.bottom);
496: put_line(file,") :");
497: One_Set_up_Symbol_Table(m,nd.p,q,nd.top,nd.bottom);
498: put(file,xpm);
499: end if;
500: if nd.tp = mixed
501: then
502: declare
503: homsys : Poly_Sys(1..nd.level+2);
504: begin
505: homsys := Two_Quantum_Pieri_Homotopy(n,nd,expbp,xpm,planes,s);
506: if outlog
507: then Two_Set_up_Symbol_Table(m,nd.p,q,nd.top,nd.bottom);
508: put_line(file,"The homotopy : "); put_line(file,homsys);
509: end if;
510: Quantum_Deform_from_Children
511: (file,poset,nd,n,q,nd.level-2,homsys,nd.level+3,1,
512: report,outlog,xpm,npaths,timings);
513: Clear(homsys);
514: end;
515: else
516: declare
517: homsys : Poly_Sys(1..nd.level+1);
518: begin
519: homsys := One_Quantum_Pieri_Homotopy(n,nd,expbp,xpm,planes,s);
520: if outlog
521: then put_line(file,"The homotopy : "); put_line(file,homsys);
522: end if;
523: Quantum_Deform_from_Children
524: (file,poset,nd,n,q,nd.level-1,homsys,nd.level+2,1,
525: report,outlog,xpm,npaths,timings);
526: Clear(homsys);
527: end;
528: end if;
529: Standard_Complex_Poly_Matrices.Clear(xpm);
530: end Quantum_Deform;
531:
532: function Moving_Point_Mode
533: ( l,k : natural; modpiv : Bracket ) return natural is
534:
535: -- DESCRIPTION :
536: -- Returns a natural number that indicates the moving of the
537: -- interpolation point. The value on return means the following
538: -- when = 0 : s goes from 0 to 1;
539: -- = 1 : s remains constant at 1;
540: -- = 2 : s goes from 1 to a target value.
541:
542: begin
543: if l = 0
544: then return 2;
545: elsif l = k-1 and modpiv(1) > 1
546: then return 0;
547: else return 1;
548: end if;
549: end Moving_Point_Mode;
550:
551: procedure One_General_Quantum_Deform
552: ( file : in file_type; n,q,l,k,ind : in natural;
553: poset : in out Array_of_Array_of_VecMats; nd : in Node;
554: modpiv : in Bracket;
555: start,target : in Standard_Complex_Matrices.Matrix;
556: planes : in VecMat; s : in Standard_Complex_Vectors.Vector;
557: bs : in Bracket_System; report,outlog : in boolean;
558: npaths : in out Standard_Natural_Vectors.Vector;
559: timings : in out Duration_Array ) is
560:
561: -- DESCRIPTION :
562: -- This is the quantum analogue to One_General_Deform.
563:
564: -- REQUIRED : nd.level > 0, solutions at children of nd are in poset.
565:
566: -- ON ENTRY :
567: -- file to write intermediate output to;
568: -- n number of rows in the matrices;
569: -- q degree of the map;
570: -- l runs from k-1 downto 0;
571: -- k co-dimension currently being treated;
572: -- ind planes(ind) is currently being folded in with this chain;
573: -- poset contains solution planes at higher levels;
574: -- nd current node in the localization poset;
575: -- modpiv bottom or top pivots modulo n;
576: -- start start (m+1-k)-plane for pivots;
577: -- target target (m+1-k)-plane for pivots;
578: -- planes target planes;
579: -- s interpolation points where the maps meets the planes;
580: -- bs structure to expand the minors;
581: -- report switch to determine output during continuation;
582: -- outlog flag to write homotopies on file if set to true.
583:
584: -- ON RETURN :
585: -- poset solution planes at (nd.level)(nd.label) are determined;
586: -- npaths number of paths followed at each level;
587: -- timings CPU user time at each level.
588:
589: m : constant natural := n-nd.p;
590: xpm : Standard_Complex_Poly_Matrices.Matrix(1..n,1..nd.p)
591: := Symbolic_Create(m,nd.p,q,nd.top,nd.bottom);
592: s_mode : constant natural := Moving_Point_Mode(l,k,modpiv);
593: hom : Link_to_Poly_Sys
594: := One_General_Quantum_Pieri_Homotopy
595: (n,ind,nd,s_mode,bs,start,target,xpm,planes,s);
596:
597: begin
598: if outlog
599: then put(file,"level l : "); put(file,l,1); put(file," ");
600: put(file,"codim k : "); put(file,k,1); new_line(file);
601: put(file,"Curve at node(");
602: put(file,nd.level,1); put(file,")("); put(file,nd.label,1);
603: put(file,") for pivots (");
604: put(file,nd.top); put(file,","); put(file,nd.bottom);
605: put_line(file,") :");
606: One_Set_up_Symbol_Table(m,nd.p,q,nd.top,nd.bottom);
607: put(file,xpm);
608: put_line(file,"The homotopy : "); put_line(file,hom.all);
609: end if;
610: Quantum_Deform_from_Children
611: (file,poset,nd,n,q,nd.level-1,hom.all,nd.level+2,s_mode,
612: report,outlog,xpm,npaths,timings);
613: Standard_Complex_Poly_Matrices.Clear(xpm);
614: Clear(hom);
615: end One_General_Quantum_Deform;
616:
617: -- CREATORS :
618:
619: function Create ( index_poset : Array_of_Array_of_Nodes )
620: return Array_of_Array_of_VecMats is
621:
622: res : Array_of_Array_of_VecMats(index_poset'range);
623: lnd : Link_to_Node;
624:
625: begin
626: for i in index_poset'range loop
627: if index_poset(i) /= null
628: then res(i) := new Array_of_VecMats(index_poset(i)'range);
629: for j in res(i)'range loop
630: lnd := index_poset(i)(j);
631: if lnd.roco /= 0
632: then res(i)(j) := new VecMat(1..lnd.roco);
633: end if;
634: end loop;
635: end if;
636: end loop;
637: return res;
638: end Create;
639:
640: -- SELECTORS :
641:
642: function Empty ( poset : Array_of_Array_of_VecMats; level,label : natural )
643: return boolean is
644:
645: use Standard_Complex_Matrices;
646:
647: begin
648: if poset(level) = null
649: then return true;
650: elsif poset(level)(label) = null
651: then return true;
652: else declare
653: lavm : Link_to_VecMat := poset(level)(label);
654: begin
655: return (lavm(lavm'first) = null);
656: end;
657: end if;
658: end Empty;
659:
660: -- ANALOGUES TO THE ROOT COUNTERS :
661:
662: procedure Recursive_Hypersurface_Solve
663: ( file : in file_type; n : in natural;
664: nd : in Node; expbp : in Bracket_Polynomial;
665: poset : in out Array_of_Array_of_VecMats;
666: planes : in VecMat; report,outlog : in boolean;
667: npaths : in out Standard_Natural_Vectors.Vector;
668: timings : in out Duration_Array ) is
669:
670: -- DESCRIPTION :
671: -- This additional layer is added to avoid the repeated construction
672: -- of the structure of the equations, that is now in expbp.
673:
674: begin
675: if Empty(poset,nd.level,nd.label)
676: then
677: if nd.level = 0
678: then
679: poset(nd.level)(nd.label)(1)
680: := new Standard_Complex_Matrices.Matrix'(Leaf_Plane(n,nd));
681: else
682: for i in nd.children'range(1) loop
683: for j in nd.children'range(2) loop
684: if nd.children(i,j) /= null
685: then Recursive_Hypersurface_Solve
686: (file,n,nd.children(i,j).all,expbp,
687: poset,planes,report,outlog,npaths,timings);
688: end if;
689: end loop;
690: end loop;
691: Hypersurface_Deform
692: (file,n,poset,nd,expbp,planes,report,outlog,npaths,timings);
693: end if;
694: end if;
695: end Recursive_Hypersurface_Solve;
696:
697: procedure Solve ( file : in file_type; n : in natural;
698: poset : in out Array_of_Array_of_VecMats;
699: nd : in Node; planes : in VecMat;
700: report,outlog : in boolean;
701: npaths : in out Standard_Natural_Vectors.Vector;
702: timings : in out Duration_Array ) is
703:
704: bm : Bracket_Monomial := Maximal_Minors(n,n);
705: bs : Bracket_System(0..Number_of_Brackets(bm))
706: := Minor_Equations(n,n-nd.p,bm);
707:
708: begin
709: Recursive_Hypersurface_Solve
710: (file,n,nd,bs(1),poset,planes,report,outlog,npaths,timings);
711: Clear(bm); Clear(bs);
712: end Solve;
713:
714: procedure One_Solve_along_Chains
715: ( file : in file_type; nd : in Node; n,l,k,ind : in natural;
716: poset : in out Array_of_Array_of_VecMats;
717: pivots,columns : in Bracket; bs : in Bracket_System;
718: special,start,target : in Standard_Complex_Matrices.Matrix;
719: planes : in VecMat; report,outlog : in boolean;
720: npaths : in out Standard_Natural_Vectors.Vector;
721: timings : in out Duration_Array ) is
722:
723: -- DESCRIPTION :
724: -- Applies the general solver along the nodes in all chains that end at
725: -- the current node. This is the analogue to the hypersurface solver,
726: -- for use in connection with the grandchildren first recursive solving.
727: -- This procedure is only called in "One_Solve".
728:
729: -- ON ENTRY :
730: -- file to write intermediate results on;
731: -- nd current node in the localization poset;
732: -- n working dimension, equation m+p;
733: -- l runs from 0 to k-1;
734: -- k current codimension condition;
735: -- poset structure with all solution p-planes;
736: -- ind ind-1 planes are already folded in;
737: -- pivots pivot elements used for the special m-plane;
738: -- columns which columns of the special m-plane are used;
739: -- bs Laplace expansion of the polynomial equations;
740: -- special special m-plane for top pivots;
741: -- start (m+1-k)-plane used at the start of the deformation;
742: -- target (m+1-k)-plane used as target;
743: -- planes sequence of (m+1-k)-planes;
744: -- report indicates whether intermediate output during continuation;
745: -- outlog flag to write homotopies on file if set to true.
746:
747: -- ON RETURN :
748: -- poset updated structure of all solution p-planes;
749: -- npaths updated numbers of paths traced at each level;
750: -- timings updated CPU user times at each level.
751:
752: m : constant natural := n - nd.p;
753: new_piv,new_col : Bracket(1..pivots'last-1);
754: new_start : Standard_Complex_Matrices.Matrix(1..n,start'range(2));
755:
756: begin
757: if empty(poset,nd.level,nd.label)
758: then
759: if l < k-1
760: then
761: for i in nd.children'range(1) loop
762: for j in nd.children'range(2) loop
763: if ((nd.children(i,j) /= null)
764: and then (nd.children(i,j).roco > 0))
765: then
766: if nd.children(i,j).tp = top
767: then new_piv := Remove(pivots,nd.children(i,j).top);
768: else new_piv := Remove(pivots,nd.children(i,j).bottom);
769: end if;
770: new_col := Remove(columns,pivots,new_piv);
771: new_start := Special_Plane(n,m,k,new_col,special);
772: One_Solve_along_Chains
773: (file,nd.children(i,j).all,n,l+1,k,ind,poset,new_piv,
774: new_col,bs,special,new_start,start,planes,report,outlog,
775: npaths,timings);
776: end if;
777: end loop;
778: end loop;
779: end if;
780: One_General_Deform
781: (file,n,ind,poset,nd,start,target,planes,bs,report,outlog,
782: npaths,timings);
783: end if;
784: end One_Solve_along_Chains;
785:
786: procedure One_Quantum_Solve_along_Chains
787: ( file : in file_type; nd : in Node; n,q,l,k,ind : in natural;
788: poset : in out Array_of_Array_of_VecMats;
789: pivots,columns : in Bracket; bs : in Bracket_System;
790: special,start,target : in Standard_Complex_Matrices.Matrix;
791: planes : in VecMat; s : in Standard_Complex_Vectors.Vector;
792: report,outlog : in boolean;
793: npaths : in out Standard_Natural_Vectors.Vector;
794: timings : in out Duration_Array ) is
795:
796: -- DESCRIPTION :
797: -- Applies the general solver along the nodes in all chains that end at
798: -- the current node. This is the analogue to the hypersurface solver,
799: -- for use in connection with the grandchildren first recursive solving.
800: -- This procedure is only called in the q-analogue of "One_Solve".
801:
802: -- ON ENTRY :
803: -- file to write intermediate results on;
804: -- nd current node in the localization poset;
805: -- n working dimension, equation m+p;
806: -- q degree of the map;
807: -- l runs from 0 to k-1;
808: -- k current codimension condition;
809: -- poset structure with all solution p-planes;
810: -- ind ind-1 planes are already folded in;
811: -- pivots pivot elements used for the special m-plane;
812: -- columns which columns of the special m-plane are used;
813: -- bs Laplace expansion of the polynomial equations;
814: -- special special m-plane for top pivots;
815: -- start (m+1-k)-plane used at the start of the deformation;
816: -- target (m+1-k)-plane used as target;
817: -- planes sequence of (m+1-k)-planes;
818: -- s interpolation points where the map meets the planes;
819: -- report indicates whether intermediate output during continuation;
820: -- outlog flag to write homotopies on file if set to true.
821:
822: -- ON RETURN :
823: -- poset updated structure of all solution p-planes;
824: -- npaths updated numbers of paths traced at each level;
825: -- timings updated CPU user times at each level.
826:
827: m : constant natural := n - nd.p;
828: new_piv,new_col : Bracket(1..pivots'last-1);
829: new_start : Standard_Complex_Matrices.Matrix(1..n,start'range(2));
830: mod_piv : Bracket(1..nd.p);
831:
832: begin
833: if empty(poset,nd.level,nd.label)
834: then
835: if l < k-1
836: then
837: for i in nd.children'range(1) loop
838: for j in nd.children'range(2) loop
839: if ((nd.children(i,j) /= null)
840: and then (nd.children(i,j).roco > 0))
841: then
842: if nd.children(i,j).tp = top
843: then mod_piv := Modulo(nd.children(i,j).top,n);
844: new_piv := Remove(pivots,mod_piv);
845: put(file,"Top pivots at node : ");
846: put(file,nd.top);
847: put(file," child top pivots : ");
848: put(file,nd.children(i,j).top); new_line(file);
849: else mod_piv := Modulo(nd.children(i,j).bottom,n);
850: new_piv := Remove(pivots,mod_piv);
851: put(file,"Bottom pivots at node : ");
852: put(file,nd.bottom);
853: put(file," child bottom pivots : ");
854: put(file,nd.children(i,j).bottom); new_line(file);
855: end if;
856: put(file,"Modular pivots : "); put(file,mod_piv);
857: put(file," new pivots : "); put(file,new_piv);
858: new_line(file);
859: put(file,"Pivot columns : "); put(file,columns);
860: put(file," new columns : "); put(file,new_piv);
861: new_line(file);
862: new_col := Remove(columns,pivots,new_piv);
863: new_start := Special_Plane(n,m,k,new_col,special);
864: One_Quantum_Solve_along_Chains
865: (file,nd.children(i,j).all,n,q,l+1,k,ind,poset,new_piv,
866: new_col,bs,special,new_start,start,planes,s,report,outlog,
867: npaths,timings);
868: end if;
869: end loop;
870: end loop;
871: end if;
872: One_General_Quantum_Deform
873: (file,n,q,l,k,ind,poset,nd,mod_piv,start,target,planes,s,bs,
874: report,outlog,npaths,timings);
875: end if;
876: end One_Quantum_Solve_along_Chains;
877:
878: procedure Solve_along_One_Chain
879: ( file : in file_type; nd : in Node; n,l,k,ind : in natural;
880: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
881: pivots,columns : in Bracket; bs : in Bracket_System;
882: special,start,target : in Standard_Complex_Matrices.Matrix;
883: planes : in VecMat; report,outlog : in boolean;
884: npaths : in out Standard_Natural_Vectors.Vector;
885: timings : in out Duration_Array ) is
886:
887: -- DESCRIPTION :
888: -- Applies the general solver along the nodes in all chains that end at
889: -- the current node. This is the analogue to the hypersurface solver,
890: -- which can be used in a general control structure.
891:
892: -- ON ENTRY :
893: -- file to write intermediate results on;
894: -- nd current node in the localization poset;
895: -- n working dimension, equation m+p;
896: -- l runs from 0 to k-1;
897: -- k current codimension condition;
898: -- poset structure with all solution p-planes;
899: -- ind ind-1 planes are already folded in;
900: -- pivots pivot elements used for the special m-plane;
901: -- columns which columns of the special m-plane are used;
902: -- bs Laplace expansion of the polynomial equations;
903: -- special special m-plane for top pivots;
904: -- start (m+1-k)-plane used at the start of the deformation;
905: -- target (m+1-k)-plane used as target;
906: -- planes sequence of (m+1-k)-planes;
907: -- report indicates whether intermediate output during continuation;
908: -- outlog file to write homotopies on if set to true.
909:
910: -- ON RETURN :
911: -- poset updated structure of solution p-planes;
912: -- npaths updated number of paths traced at each level;
913: -- timings updated CPU user times for each level.
914:
915: m : constant natural := n - nd.p;
916:
917: begin
918: if empty(poset,nd.level,nd.label)
919: then
920: if nd.level = 0
921: then poset(nd.level)(nd.label)(1)
922: := new Standard_Complex_Matrices.Matrix'(Leaf_Plane(n,nd));
923: elsif nd.roco > 0
924: then
925: if l = k
926: then
927: if cod'last > cod'first
928: then
929: declare
930: kk : constant natural := cod(cod'last-1);
931: kd : constant natural := n+1-kk;
932: new_piv,new_col : Bracket(1..m);
933: new_special : Standard_Complex_Matrices.Matrix(1..n,1..m);
934: new_target : constant Standard_Complex_Matrices.Matrix
935: := planes(cod'last-1).all;
936: new_start
937: : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk);
938: new_bm : Bracket_Monomial := Maximal_Minors(n,kd);
939: new_bs : Bracket_System(0..Number_of_Brackets(new_bm))
940: := Minor_Equations(kd,kd-nd.p,new_bm);
941: begin
942: for i in new_col'range loop
943: new_col(i) := i;
944: end loop;
945: if nd.tp = top
946: then new_piv := Complement(n,nd.top);
947: new_special := Special_Top_Plane(m,nd.top);
948: else new_piv := Complement(n,nd.bottom);
949: new_special := Special_Bottom_Plane(m,nd.bottom);
950: end if;
951: new_start := Special_Plane(n,m,kk,new_col,new_special);
952: Solve_along_One_Chain
953: (file,nd,n,0,kk,cod'last-1,cod(cod'first..cod'last-1),
954: poset,new_piv,new_col,new_bs,new_special,new_start,
955: new_target,planes,report,outlog,npaths,timings);
956: Clear(new_bm); Clear(new_bs);
957: end;
958: end if;
959: else
960: declare
961: new_piv,new_col : Bracket(1..pivots'last-1);
962: new_start
963: : Standard_Complex_Matrices.Matrix(1..n,start'range(2));
964: begin
965: for i in nd.children'range(1) loop
966: for j in nd.children'range(2) loop
967: if ((nd.children(i,j) /= null)
968: and then (nd.children(i,j).roco > 0))
969: then
970: if nd.children(i,j).tp = top
971: then new_piv := Remove(pivots,nd.children(i,j).top);
972: else new_piv
973: := Remove(pivots,nd.children(i,j).bottom);
974: end if;
975: new_col := Remove(columns,pivots,new_piv);
976: new_start := Special_Plane(n,m,k,new_col,special);
977: Solve_along_One_Chain
978: (file,nd.children(i,j).all,n,l+1,k,ind,cod,poset,
979: new_piv,new_col,bs,special,new_start,start,
980: planes,report,outlog,npaths,timings);
981: end if;
982: end loop;
983: end loop;
984: One_General_Deform
985: (file,n,ind,poset,nd,start,target,planes,bs,
986: report,outlog,npaths,timings);
987: end;
988: end if;
989: end if;
990: end if;
991: end Solve_along_One_Chain;
992:
993: procedure Solve_along_Two_Chains
994: ( file : in file_type; nd : in Node;
995: n,l_top,k_top,l_bot,k_bot,ind : in natural;
996: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
997: top_pivots,top_columns,bot_pivots,bot_columns : in Bracket;
998: top_bs,bot_bs : in Bracket_System;
999: top_special,top_start,top_target,bot_special,bot_start,
1000: bot_target : in Standard_Complex_Matrices.Matrix;
1001: planes : in VecMat; report,outlog : in boolean;
1002: npaths : in out Standard_Natural_Vectors.Vector;
1003: timings : in out Duration_Array );
1004:
1005: -- DESCRIPTION :
1006: -- Applies the general solver along the nodes in all chains that end at
1007: -- the current node. This is the analogue to the hypersurface solver
1008: -- where the type of the node may be anything.
1009:
1010: -- ON ENTRY :
1011: -- file to write intermediate results on;
1012: -- nd current node in the localization poset;
1013: -- n working dimension, equation m+p;
1014: -- l_top runs from 0 to k_top-1;
1015: -- k_top co-dimension condition satisfied incrementing top pivots;
1016: -- l_bot runs from 0 to k_bot-1;
1017: -- k_bot co-dimension condition satisfied decrementing bottom pivots;
1018: -- poset structure with all solution p-planes;
1019: -- ind ind-1 planes are already folded in;
1020: -- top_pivots pivot elements used for the special top m-plane;
1021: -- top_columns which columns of the special top m-plane are used;
1022: -- bot_pivots pivot elements used for the special bottom m-plane;
1023: -- bot_columns which columns of the special bottom m-plane are used;
1024: -- top_bs Laplace expansion of the polynomial equations;
1025: -- bot_bs Laplace expansion of the polynomial equations;
1026: -- top_special special m-plane for top pivots;
1027: -- top_start (m+1-k)-plane used at the start of the deformation;
1028: -- top_target (m+1-k)-plane used as target satisfied with top pivots;
1029: -- bot_special special m-plane for top pivots;
1030: -- bot_start (m+1-k)-plane used at the start of the deformation;
1031: -- bot_target (m+1-k)-plane used as target satisfied with bottom pivots;
1032: -- planes sequence of (m+1-k)-planes;
1033: -- report indicates whether intermediate output during continuation;
1034: -- outlog flag to write homotopies on file if set to true.
1035:
1036: -- ON RETURN :
1037: -- poset updated structure of solution p-planes;
1038: -- npaths updated number of paths traced at each level;
1039: -- timings updated CPU user timings at each level.
1040:
1041: procedure Solve_along_Two_Chains_Deforming_Top_and_Bottom
1042: ( file : in file_type; nd : in Node;
1043: n,l_top,k_top,l_bot,k_bot,ind : in natural;
1044: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
1045: top_pivots,top_columns,bot_pivots,bot_columns : in Bracket;
1046: top_bs,bot_bs : in Bracket_System;
1047: top_special,top_start,top_target,bot_special,bot_start,
1048: bot_target : in Standard_Complex_Matrices.Matrix;
1049: planes : in VecMat; report,outlog : in boolean;
1050: npaths : in out Standard_Natural_Vectors.Vector;
1051: timings : in out Duration_Array ) is
1052:
1053: -- DESCRIPTION :
1054: -- Assumes that k_top > l_top and k_bot > l_bot so that the deformations
1055: -- involve both incrementing top and decrementing bottom pivots.
1056:
1057: m : constant natural := n - nd.p;
1058: top_piv,top_col : Bracket(1..top_pivots'last-1);
1059: bot_piv,bot_col : Bracket(1..bot_pivots'last-1);
1060: new_top_start : Standard_Complex_Matrices.Matrix(1..n,top_start'range(2));
1061: new_bot_start : Standard_Complex_Matrices.Matrix(1..n,bot_start'range(2));
1062:
1063: begin
1064: for i in nd.children'range(1) loop
1065: for j in nd.children'range(2) loop
1066: if ((nd.children(i,j) /= null)
1067: and then (nd.children(i,j).roco > 0))
1068: then if nd.children(i,j).tp = top or nd.children(i,j).tp = mixed
1069: then top_piv := Remove(top_pivots,nd.children(i,j).top);
1070: top_col := Remove(top_columns,top_pivots,top_piv);
1071: new_top_start
1072: := Special_Plane(n,m,k_top,top_col,top_special);
1073: end if;
1074: if nd.children(i,j).tp = bottom or nd.children(i,j).tp = mixed
1075: then bot_piv := Remove(bot_pivots,nd.children(i,j).bottom);
1076: bot_col := Remove(bot_columns,bot_pivots,bot_piv);
1077: new_bot_start
1078: := Special_Plane(n,m,k_bot,bot_col,bot_special);
1079: end if;
1080: Solve_along_Two_Chains
1081: (file,nd.children(i,j).all,
1082: n,l_top+1,k_top,l_bot+1,k_bot,ind,cod,poset,
1083: top_piv,top_col,bot_piv,bot_col,top_bs,bot_bs,
1084: top_special,new_top_start,top_start,
1085: bot_special,new_bot_start,bot_start,
1086: planes,report,outlog,npaths,timings);
1087: end if;
1088: end loop;
1089: end loop;
1090: Two_General_Deform
1091: (file,n,ind,poset,nd,top_start,top_target,bot_start,
1092: bot_target,planes,top_bs,bot_bs,report,outlog,npaths,timings);
1093: end Solve_along_Two_Chains_Deforming_Top_and_Bottom;
1094:
1095: procedure Switch_Top_and_Solve_along_Two_Chains
1096: ( file : in file_type; nd : in Node;
1097: n,l_bot,k_bot,ind : in natural; cod : in Bracket;
1098: poset : in out Array_of_Array_of_VecMats;
1099: bot_pivots,bot_columns : in Bracket;
1100: bot_bs : in Bracket_System;
1101: bot_special,bot_start,bot_target
1102: : in Standard_Complex_Matrices.Matrix;
1103: planes : in VecMat; report,outlog : in boolean;
1104: npaths : in out Standard_Natural_Vectors.Vector;
1105: timings : in out Duration_Array ) is
1106:
1107: -- DESCRIPTION :
1108: -- Assumes that l_top = k_top, l_bot < k_bot, and ind > cod'first so
1109: -- that first a new top chain can be started, which is then solved
1110: -- along with the existing chain for decrementing bottom pivots.
1111:
1112: m : constant natural := n - nd.p;
1113: new_k_top : constant natural := cod(ind);
1114: kd : constant natural := n+1-new_k_top;
1115: new_top_pivots : Bracket(1..m) := Complement(n,nd.top);
1116: new_top_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
1117: := Special_Top_Plane(m,nd.top);
1118: new_top_target : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_top)
1119: := planes(ind).all;
1120: new_top_columns : Bracket(1..m);
1121: new_top_start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_top);
1122: new_top_bm : Bracket_Monomial := Maximal_Minors(n,kd);
1123: new_top_bs : Bracket_System(0..Number_of_Brackets(new_top_bm))
1124: := Minor_Equations(kd,kd-nd.p,new_top_bm);
1125:
1126: begin
1127: for i in new_top_columns'range loop
1128: new_top_columns(i) := i;
1129: end loop;
1130: new_top_start
1131: := Special_Plane(n,m,new_k_top,new_top_columns,new_top_special);
1132: Solve_along_Two_Chains_Deforming_Top_and_Bottom
1133: (file,nd,n,0,new_k_top,l_bot,k_bot,ind,cod,poset,
1134: new_top_pivots,new_top_columns,bot_pivots,bot_columns,
1135: new_top_bs,bot_bs,new_top_special,new_top_start,new_top_target,
1136: bot_special,bot_start,bot_target,planes,
1137: report,outlog,npaths,timings);
1138: Clear(new_top_bm); Clear(new_top_bs);
1139: end Switch_Top_and_Solve_along_Two_Chains;
1140:
1141: procedure Switch_Top_and_Solve_along_One_Chain
1142: ( file : in file_type; nd : in Node; n,ind : in natural;
1143: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
1144: planes : in VecMat; report,outlog : in boolean;
1145: npaths : in out Standard_Natural_Vectors.Vector;
1146: timings : in out Duration_Array ) is
1147:
1148: -- DESCRIPTION :
1149: -- Assumes that l_top = k_top, l_bot = k_bot, with nd.tp = top
1150: -- and ind > cod'first so that a new top chain can be started.
1151:
1152: m : constant natural := n - nd.p;
1153: new_k_top : constant natural := cod(ind);
1154: kd : constant natural := n+1-new_k_top;
1155: new_top_pivots : Bracket(1..m) := Complement(n,nd.top);
1156: new_top_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
1157: := Special_Top_Plane(m,nd.top);
1158: new_top_target : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_top)
1159: := planes(ind).all;
1160: new_top_columns : Bracket(1..m);
1161: new_top_start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_top);
1162: new_top_bm : Bracket_Monomial := Maximal_Minors(n,kd);
1163: new_top_bs : Bracket_System(0..Number_of_Brackets(new_top_bm))
1164: := Minor_Equations(kd,kd-nd.p,new_top_bm);
1165:
1166: begin
1167: for i in new_top_columns'range loop
1168: new_top_columns(i) := i;
1169: end loop;
1170: new_top_start
1171: := Special_Plane(n,m,new_k_top,new_top_columns,new_top_special);
1172: Solve_along_One_Chain
1173: (file,nd,n,0,new_k_top,ind,cod(cod'first..ind),poset,
1174: new_top_pivots,new_top_columns,new_top_bs,
1175: new_top_special,new_top_start,new_top_target,
1176: planes,report,outlog,npaths,timings);
1177: Clear(new_top_bm); Clear(new_top_bs);
1178: end Switch_Top_and_Solve_along_One_Chain;
1179:
1180: procedure Switch_Bottom_and_Solve_along_Two_Chains
1181: ( file : in file_type; nd : in Node;
1182: n,l_top,k_top,ind : in natural; cod : in Bracket;
1183: poset : in out Array_of_Array_of_VecMats;
1184: top_pivots,top_columns : in Bracket;
1185: top_bs : in Bracket_System;
1186: top_special,top_start,top_target
1187: : in Standard_Complex_Matrices.Matrix;
1188: planes : in VecMat; report,outlog : in boolean;
1189: npaths : in out Standard_Natural_Vectors.Vector;
1190: timings : in out Duration_Array ) is
1191:
1192: -- DESCRIPTION :
1193: -- Assumes that l_top < k_top, l_bot = k_bot, and ind > cod'first so
1194: -- that first a new bottom chain can be launched, which is then solved
1195: -- along with the existing chain for incrementing top pivots.
1196:
1197: m : constant natural := n - nd.p;
1198: new_k_bot : constant natural := cod(ind);
1199: kd : constant natural := n+1-new_k_bot;
1200: new_bot_pivots : Bracket(1..m) := Complement(n,nd.bottom);
1201: new_bot_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
1202: := Special_Bottom_Plane(m,nd.bottom);
1203: new_bot_target : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_bot)
1204: := planes(ind).all;
1205: new_bot_columns : Bracket(1..m);
1206: new_bot_start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_bot);
1207: new_bot_bm : Bracket_Monomial := Maximal_Minors(n,kd);
1208: new_bot_bs : Bracket_System(0..Number_of_Brackets(new_bot_bm))
1209: := Minor_Equations(kd,kd-nd.p,new_bot_bm);
1210:
1211: begin
1212: for i in new_bot_columns'range loop
1213: new_bot_columns(i) := i;
1214: end loop;
1215: new_bot_start
1216: := Special_Plane(n,m,new_k_bot,new_bot_columns,new_bot_special);
1217: Solve_along_Two_Chains_Deforming_Top_and_Bottom
1218: (file,nd,n,l_top,k_top,0,new_k_bot,ind,cod,poset,
1219: top_pivots,top_columns,new_bot_pivots,new_bot_columns,
1220: top_bs,new_bot_bs,top_special,top_start,top_target,
1221: new_bot_special,new_bot_start,new_bot_target,
1222: planes,report,outlog,npaths,timings);
1223: Clear(new_bot_bm); Clear(new_bot_bs);
1224: end Switch_Bottom_and_Solve_along_Two_Chains;
1225:
1226: procedure Switch_Bottom_and_Solve_along_One_Chain
1227: ( file : in file_type; nd : in Node; n,ind : in natural;
1228: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
1229: planes : in VecMat; report,outlog : in boolean;
1230: npaths : in out Standard_Natural_Vectors.Vector;
1231: timings : in out Duration_Array ) is
1232:
1233: -- DESCRIPTION :
1234: -- Assumes that l_top < k_top, l_bot = k_bot, and ind > cod'first so
1235: -- that first a new bottom chain can be launched, which is then solved
1236: -- along with the existing chain for incrementing top pivots.
1237:
1238: m : constant natural := n - nd.p;
1239: new_k_bot : constant natural := cod(ind);
1240: kd : constant natural := n+1-new_k_bot;
1241: new_bot_pivots : Bracket(1..m) := Complement(n,nd.bottom);
1242: new_bot_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
1243: := Special_Bottom_Plane(m,nd.bottom);
1244: new_bot_target : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_bot)
1245: := planes(ind).all;
1246: new_bot_columns : Bracket(1..m);
1247: new_bot_start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_bot);
1248: new_bot_bm : Bracket_Monomial := Maximal_Minors(n,kd);
1249: new_bot_bs : Bracket_System(0..Number_of_Brackets(new_bot_bm))
1250: := Minor_Equations(kd,kd-nd.p,new_bot_bm);
1251:
1252: begin
1253: for i in new_bot_columns'range loop
1254: new_bot_columns(i) := i;
1255: end loop;
1256: new_bot_start
1257: := Special_Plane(n,m,new_k_bot,new_bot_columns,new_bot_special);
1258: Solve_along_One_Chain
1259: (file,nd,n,0,new_k_bot,ind,cod(cod'first..ind),poset,
1260: new_bot_pivots,new_bot_columns,new_bot_bs,
1261: new_bot_special,new_bot_start,new_bot_target,
1262: planes,report,outlog,npaths,timings);
1263: Clear(new_bot_bm); Clear(new_bot_bs);
1264: end Switch_Bottom_and_Solve_along_One_Chain;
1265:
1266: procedure Switch_Top_Bottom_and_Solve_along_Two_Chains
1267: ( file : in file_type; nd : in Node; n,ind : in natural;
1268: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
1269: planes : in VecMat; report,outlog : in boolean;
1270: npaths : in out Standard_Natural_Vectors.Vector;
1271: timings : in out Duration_Array ) is
1272:
1273: -- DESCRIPTION :
1274: -- Assumes that l_top = k_top, l_bot = k_bot, and ind > cod'first+1
1275: -- so that first new top and bottom chains can be started which are
1276: -- then solved along.
1277:
1278: m : constant natural := n - nd.p;
1279: new_k_top : constant natural := cod(ind);
1280: new_k_bot : constant natural := cod(ind+1);
1281: kd_top : constant natural := n+1-new_k_top;
1282: kd_bot : constant natural := n+1-new_k_bot;
1283: new_top_pivots : Bracket(1..m) := Complement(n,nd.top);
1284: new_bot_pivots : Bracket(1..m) := Complement(n,nd.bottom);
1285: new_top_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
1286: := Special_Top_Plane(m,nd.top);
1287: new_bot_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
1288: := Special_Bottom_Plane(m,nd.bottom);
1289: new_top_target : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_top)
1290: := planes(ind).all;
1291: new_bot_target : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_bot)
1292: := planes(ind+1).all;
1293: new_top_columns,new_bot_columns : Bracket(1..m);
1294: new_top_start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_top);
1295: new_bot_start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_bot);
1296: new_top_bm : Bracket_Monomial := Maximal_Minors(n,kd_top);
1297: new_bot_bm : Bracket_Monomial := Maximal_Minors(n,kd_bot);
1298: new_top_bs : Bracket_System(0..Number_of_Brackets(new_top_bm))
1299: := Minor_Equations(kd_top,kd_top-nd.p,new_top_bm);
1300: new_bot_bs : Bracket_System(0..Number_of_Brackets(new_bot_bm))
1301: := Minor_Equations(kd_bot,kd_bot-nd.p,new_bot_bm);
1302:
1303: begin
1304: for i in new_bot_columns'range loop
1305: new_top_columns(i) := i;
1306: new_bot_columns(i) := i;
1307: end loop;
1308: new_top_start
1309: := Special_Plane(n,m,new_k_top,new_top_columns,new_top_special);
1310: new_bot_start
1311: := Special_Plane(n,m,new_k_bot,new_bot_columns,new_bot_special);
1312: Solve_along_Two_Chains_Deforming_Top_and_Bottom
1313: (file,nd,n,0,new_k_top,0,new_k_bot,ind,cod,poset,
1314: new_top_pivots,new_top_columns,new_bot_pivots,new_bot_columns,
1315: new_top_bs,new_bot_bs,new_top_special,new_top_start,new_top_target,
1316: new_bot_special,new_bot_start,new_bot_target,
1317: planes,report,outlog,npaths,timings);
1318: Clear(new_top_bm); Clear(new_top_bs);
1319: Clear(new_bot_bm); Clear(new_bot_bs);
1320: end Switch_Top_Bottom_and_Solve_along_Two_Chains;
1321:
1322: procedure Solve_along_Two_Chains
1323: ( file : in file_type; nd : in Node;
1324: n,l_top,k_top,l_bot,k_bot,ind : in natural;
1325: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
1326: top_pivots,top_columns,bot_pivots,bot_columns : in Bracket;
1327: top_bs,bot_bs : in Bracket_System;
1328: top_special,top_start,top_target,bot_special,bot_start,
1329: bot_target : in Standard_Complex_Matrices.Matrix;
1330: planes : in VecMat; report,outlog : in boolean;
1331: npaths : in out Standard_Natural_Vectors.Vector;
1332: timings : in out Duration_Array ) is
1333:
1334: -- DESCRIPTION :
1335: -- Does the dispatching according to the case analysis.
1336:
1337: -- IMPORTANT :
1338: -- The control structure in the case analysis matches the structure
1339: -- in Localization_Posets.Recursive_Top_Bottom_Create.
1340:
1341: begin
1342: if empty(poset,nd.level,nd.label)
1343: then
1344: if nd.level = 0
1345: then poset(nd.level)(nd.label)(1)
1346: := new Standard_Complex_Matrices.Matrix'(Leaf_Plane(n,nd));
1347: elsif nd.roco > 0
1348: then
1349: if ((l_top < k_top) and (l_bot < k_bot))
1350: then Solve_along_Two_Chains_Deforming_Top_and_Bottom
1351: (file,nd,n,l_top,k_top,l_bot,k_bot,ind,cod,poset,
1352: top_pivots,top_columns,bot_pivots,bot_columns,
1353: top_bs,bot_bs,top_special,top_start,top_target,
1354: bot_special,bot_start,bot_target,planes,
1355: report,outlog,npaths,timings);
1356: elsif ((l_top = k_top) and (l_bot < k_bot))
1357: then
1358: if ind = cod'first
1359: then Solve_along_One_Chain
1360: (file,nd,n,l_bot,k_bot,ind,cod,poset,
1361: bot_pivots,bot_columns,bot_bs,bot_special,
1362: bot_start,bot_target,planes,report,outlog,
1363: npaths,timings);
1364: else Switch_Top_and_Solve_along_Two_Chains
1365: (file,nd,n,l_bot,k_bot,ind-1,cod,poset,
1366: bot_pivots,bot_columns,bot_bs,bot_special,
1367: bot_start,bot_target,planes,report,outlog,
1368: npaths,timings);
1369: end if;
1370: elsif ((l_top < k_top) and (l_bot = k_bot))
1371: then
1372: if ind = cod'first
1373: then Solve_along_One_Chain
1374: (file,nd,n,l_top,k_top,ind,cod,poset,
1375: top_pivots,top_columns,top_bs,top_special,
1376: top_start,top_target,planes,report,outlog,
1377: npaths,timings);
1378: else Switch_Bottom_and_Solve_along_Two_Chains
1379: (file,nd,n,l_top,k_top,ind-1,cod,poset,
1380: top_pivots,top_columns,top_bs,top_special,
1381: top_start,top_target,planes,report,outlog,
1382: npaths,timings);
1383: end if;
1384: else -- ((l_top = k_top) and (l_bot = k_bot))
1385: if ind > cod'first+1
1386: then Switch_Top_Bottom_and_Solve_along_Two_Chains
1387: (file,nd,n,ind-2,cod,poset,planes,
1388: report,outlog,npaths,timings);
1389: elsif ind > cod'first
1390: then
1391: if nd.tp = bottom
1392: then
1393: Switch_Bottom_and_Solve_along_One_Chain
1394: (file,nd,n,ind-1,cod,poset,planes,
1395: report,outlog,npaths,timings);
1396: else
1397: Switch_Top_and_Solve_along_One_Chain
1398: (file,nd,n,ind-1,cod,poset,planes,
1399: report,outlog,npaths,timings);
1400: end if;
1401: end if;
1402: end if;
1403: end if;
1404: end if;
1405: end Solve_along_Two_Chains;
1406:
1407: procedure One_Solve
1408: ( file : in file_type; n : in natural; cod : in Bracket;
1409: poset : in out Array_of_Array_of_VecMats;
1410: nd : in Node; planes : in VecMat;
1411: report,outlog : in boolean;
1412: npaths : in out Standard_Natural_Vectors.Vector;
1413: timings : in out Duration_Array ) is
1414:
1415: -- NOTE :
1416: -- We assume that we are always folding in the last condition, with
1417: -- codimension cod(cod'last). In passing recursively to higher levels
1418: -- in the deformation poset, we take a slice of k, omitting the last one.
1419: -- Applies the solver first to all grandchildren of the current node,
1420: -- which is the additional layer compared to the hypersurface case.
1421: -- This implementation will only work in the non-mixed case.
1422:
1423: m : constant natural := n - nd.p;
1424: kk : constant natural := cod(cod'last);
1425: kd : constant natural := n+1-kk;
1426:
1427: procedure Solve_Grand_Child
1428: ( lnd : in Link_to_Node; continue : out boolean ) is
1429:
1430: -- DESCRIPTION :
1431: -- This node lnd is a grandchild of the current node.
1432:
1433: begin
1434: if Empty(poset,lnd.level,lnd.label)
1435: then if lnd.level = 0
1436: then poset(lnd.level)(lnd.label)(1)
1437: := new Standard_Complex_Matrices.Matrix'
1438: (Leaf_Plane(n,lnd.all));
1439: elsif lnd.roco > 0
1440: then One_Solve(file,n,cod(cod'first..cod'last-1),poset,
1441: lnd.all,planes,report,outlog,npaths,timings);
1442: end if;
1443: end if;
1444: continue := true;
1445: end Solve_Grand_Child;
1446:
1447: procedure Solve_Grand_Children is
1448: new Enumerate_Grand_Children(Solve_Grand_Child);
1449:
1450: begin
1451: if (Empty(poset,nd.level,nd.label) and (nd.roco > 0))
1452: then
1453: if cod'last >= cod'first
1454: then Solve_Grand_Children(nd,kk);
1455: end if;
1456: declare
1457: pivots,columns : Bracket(1..m);
1458: special : Standard_Complex_Matrices.Matrix(1..n,1..m);
1459: target : constant Standard_Complex_Matrices.Matrix
1460: := planes(cod'last).all;
1461: start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk);
1462: bm : Bracket_Monomial := Maximal_Minors(n,kd);
1463: bs : Bracket_System(0..Number_of_Brackets(bm))
1464: := Minor_Equations(kd,kd-nd.p,bm);
1465: begin
1466: for i in columns'range loop
1467: columns(i) := i;
1468: end loop;
1469: if nd.tp = top
1470: then pivots := Complement(n,nd.top);
1471: special := Special_Top_Plane(m,nd.top);
1472: else pivots := Complement(n,nd.bottom);
1473: special := Special_Bottom_Plane(m,nd.bottom);
1474: end if;
1475: start := Special_Plane(n,m,kk,columns,special);
1476: One_Solve_along_Chains
1477: (file,nd,n,0,kk,cod'last,poset,pivots,columns,bs,
1478: special,start,target,planes,report,outlog,npaths,timings);
1479: Clear(bm); Clear(bs);
1480: end;
1481: end if;
1482: end One_Solve;
1483:
1484: procedure Chain_Solve
1485: ( file : in file_type; n : in natural; cod : in Bracket;
1486: poset : in out Array_of_Array_of_VecMats; nd : in Node;
1487: planes : in VecMat; report,outlog : in boolean;
1488: npaths : in out Standard_Natural_Vectors.Vector;
1489: timings : in out Duration_Array ) is
1490:
1491: -- NOTE :
1492: -- The convention is that the last co-dimension condition is treated
1493: -- when the type of the node is not mixed, otherwise the last two entries
1494: -- of the vector of co-dimension conditions are sliced off when moving
1495: -- to the upper levels.
1496: -- This is another organization of One_Solve and only works when the
1497: -- type of the nodes are not mixed.
1498:
1499: begin
1500: if Empty(poset,nd.level,nd.label)
1501: then
1502: if nd.level = 0
1503: then poset(nd.level)(nd.label)(1)
1504: := new Standard_Complex_Matrices.Matrix'(Leaf_Plane(n,nd));
1505: elsif nd.roco > 0
1506: then declare
1507: m : constant natural := n - nd.p;
1508: pivots,columns : Bracket(1..m);
1509: special : Standard_Complex_Matrices.Matrix(1..n,1..m);
1510: kk : constant natural := cod(cod'last);
1511: kd : constant natural := n+1-kk;
1512: start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk);
1513: target : constant Standard_Complex_Matrices.Matrix
1514: := planes(planes'last).all;
1515: bm : Bracket_Monomial := Maximal_Minors(n,kd);
1516: bs : Bracket_System(0..Number_of_Brackets(bm))
1517: := Minor_Equations(kd,kd-nd.p,bm);
1518: begin
1519: for i in columns'range loop
1520: columns(i) := i;
1521: end loop;
1522: if nd.tp = top
1523: then pivots := Complement(n,nd.top);
1524: special := Special_Top_Plane(m,nd.top);
1525: else pivots := Complement(n,nd.bottom);
1526: special := Special_Bottom_Plane(m,nd.bottom);
1527: end if;
1528: start := Special_Plane(n,m,kk,columns,special);
1529: Solve_along_One_Chain
1530: (file,nd,n,0,cod(cod'last),cod'last,cod,poset,
1531: pivots,columns,bs,special,start,target,planes,
1532: report,outlog,npaths,timings);
1533: Clear(bm); Clear(bs);
1534: end;
1535: end if;
1536: end if;
1537: end Chain_Solve;
1538:
1539: procedure Solve ( file : in file_type; n : in natural; cod : in Bracket;
1540: poset : in out Array_of_Array_of_VecMats; nd : in Node;
1541: planes : in VecMat; report,outlog : in boolean;
1542: npaths : in out Standard_Natural_Vectors.Vector;
1543: timings : in out Duration_Array ) is
1544:
1545: -- REQUIREMENT ONE :
1546: -- The convention is that the last co-dimension condition is treated
1547: -- when the type of the node is not mixed, otherwise the last two entries
1548: -- of the vector of co-dimension conditions are sliced off when moving
1549: -- to the upper levels.
1550: -- REQUIREMENT TWO :
1551: -- The nodes that are not mixed appear at the top of the poset.
1552:
1553: begin
1554: if Empty(poset,nd.level,nd.label)
1555: then
1556: if nd.level = 0
1557: then poset(nd.level)(nd.label)(1)
1558: := new Standard_Complex_Matrices.Matrix'(Leaf_Plane(n,nd));
1559: elsif nd.roco > 0
1560: then
1561: if nd.tp /= mixed
1562: then
1563: declare
1564: m : constant natural := n - nd.p;
1565: pivots,columns : Bracket(1..m);
1566: special : Standard_Complex_Matrices.Matrix(1..n,1..m);
1567: kk : constant natural := cod(cod'last);
1568: kd : constant natural := n+1-kk;
1569: start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk);
1570: target : constant Standard_Complex_Matrices.Matrix
1571: := planes(planes'last).all;
1572: bm : Bracket_Monomial := Maximal_Minors(n,kd);
1573: bs : Bracket_System(0..Number_of_Brackets(bm))
1574: := Minor_Equations(kd,kd-nd.p,bm);
1575: begin
1576: for i in columns'range loop
1577: columns(i) := i;
1578: end loop;
1579: if nd.tp = top
1580: then pivots := Complement(n,nd.top);
1581: special := Special_Top_Plane(m,nd.top);
1582: else pivots := Complement(n,nd.bottom);
1583: special := Special_Bottom_Plane(m,nd.bottom);
1584: end if;
1585: start := Special_Plane(n,m,kk,columns,special);
1586: Solve_along_One_Chain
1587: (file,nd,n,0,cod(cod'last),cod'last,cod,poset,
1588: pivots,columns,bs,special,start,target,planes,
1589: report,outlog,npaths,timings);
1590: Clear(bm); Clear(bs);
1591: end;
1592: else
1593: declare
1594: m : constant natural := n - nd.p;
1595: top_col,bot_col : Bracket(1..m);
1596: kk_top : constant natural := cod(cod'last-1);
1597: kk_bot : constant natural := cod(cod'last);
1598: kd_top : constant natural := n+1-kk_top;
1599: kd_bot : constant natural := n+1-kk_bot;
1600: top_bm : Bracket_Monomial := Maximal_Minors(n,kd_top);
1601: bot_bm : Bracket_Monomial := Maximal_Minors(n,kd_bot);
1602: top_bs : Bracket_System(0..Number_of_Brackets(top_bm))
1603: := Minor_Equations(kd_top,kd_top-nd.p,top_bm);
1604: bot_bs : Bracket_System(0..Number_of_Brackets(bot_bm))
1605: := Minor_Equations(kd_bot,kd_bot-nd.p,bot_bm);
1606: top_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
1607: := Special_Top_Plane(m,nd.top);
1608: bot_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
1609: := Special_Bottom_Plane(m,nd.bottom);
1610: top_piv : Bracket(1..m) := Complement(n,nd.top);
1611: bot_piv : Bracket(1..m) := Complement(n,nd.bottom);
1612: top_start,top_target
1613: : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk_top);
1614: bot_start,bot_target
1615: : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk_bot);
1616: begin
1617: for i in top_col'range loop
1618: top_col(i) := i;
1619: end loop;
1620: top_start := Special_Plane(n,m,kk_top,top_col,top_special);
1621: top_target := planes(planes'last-1).all;
1622: for i in bot_col'range loop
1623: bot_col(i) := i;
1624: end loop;
1625: bot_start := Special_Plane(n,m,kk_bot,bot_col,bot_special);
1626: bot_target := planes(planes'last).all;
1627: Solve_along_Two_Chains
1628: (file,nd,n,0,kk_top,0,kk_bot,cod'last-1,cod,poset,
1629: top_piv,top_col,bot_piv,bot_col,top_bs,bot_bs,
1630: top_special,top_start,top_target,bot_special,bot_start,
1631: bot_target,planes,report,outlog,npaths,timings);
1632: Clear(top_bm); Clear(top_bs); Clear(bot_bm); Clear(bot_bs);
1633: end;
1634: end if;
1635: end if;
1636: end if;
1637: end Solve;
1638:
1639: procedure Recursive_Quantum_Solve
1640: ( file : in file_type; n,q : in natural;
1641: nd : in Node; expbp : in Bracket_Polynomial;
1642: poset : in out Array_of_Array_of_VecMats;
1643: planes : in VecMat; s : in Standard_Complex_Vectors.Vector;
1644: report,outlog : in boolean;
1645: npaths : in out Standard_Natural_Vectors.Vector;
1646: timings : in out Duration_Array ) is
1647:
1648: -- DESCRIPTION :
1649: -- This additional layer is added to avoid the repeated construction
1650: -- of the structure of the equations, that is now in expbp.
1651: -- This is the q-analogue to the Recursive Hypersurface Solver.
1652:
1653: begin
1654: if Empty(poset,nd.level,nd.label)
1655: then
1656: if nd.level = 0
1657: then
1658: poset(nd.level)(nd.label)(1)
1659: := new Standard_Complex_Matrices.Matrix'(Leaf_Plane(n*(q+1),nd));
1660: else
1661: for i in nd.children'range(1) loop
1662: for j in nd.children'range(2) loop
1663: if nd.children(i,j) /= null
1664: then Recursive_Quantum_Solve
1665: (file,n,q,nd.children(i,j).all,expbp,poset,
1666: planes,s,report,outlog,npaths,timings);
1667: end if;
1668: end loop;
1669: end loop;
1670: Quantum_Deform(file,n,q,poset,nd,expbp,planes,s,report,outlog,
1671: npaths,timings);
1672: end if;
1673: end if;
1674: end Recursive_Quantum_Solve;
1675:
1676: procedure Solve ( file : in file_type; n,q : in natural;
1677: poset : in out Array_of_Array_of_VecMats; nd : in Node;
1678: planes : in VecMat; s : in Standard_Complex_Vectors.Vector;
1679: report,outlog : in boolean;
1680: npaths : in out Standard_Natural_Vectors.Vector;
1681: timings : in out Duration_Array ) is
1682:
1683: bm : Bracket_Monomial := Maximal_Minors(n,n);
1684: bs : Bracket_System(0..Number_of_Brackets(bm))
1685: := Minor_Equations(n,n-nd.p,bm);
1686:
1687: begin
1688: Recursive_Quantum_Solve(file,n,q,nd,bs(1),poset,planes,s,report,outlog,
1689: npaths,timings);
1690: Clear(bm); Clear(bs);
1691: end Solve;
1692:
1693: procedure One_Solve
1694: ( file : in file_type; n,q : in natural; cod : in Bracket;
1695: poset : in out Array_of_Array_of_VecMats; nd : in Node;
1696: planes : in VecMat; s : in Standard_Complex_Vectors.Vector;
1697: report,outlog : in boolean;
1698: npaths : in out Standard_Natural_Vectors.Vector;
1699: timings : in out Duration_Array ) is
1700:
1701: m : constant natural := n - nd.p;
1702: kk : constant natural := cod(cod'last);
1703: kd : constant natural := n+1-kk;
1704:
1705: procedure Solve_Grand_Child
1706: ( lnd : in Link_to_Node; continue : out boolean ) is
1707:
1708: -- DESCRIPTION :
1709: -- This node lnd is a grandchild of the current node.
1710:
1711: begin
1712: if Empty(poset,lnd.level,lnd.label)
1713: then if lnd.level = 0
1714: then poset(lnd.level)(lnd.label)(1)
1715: := new Standard_Complex_Matrices.Matrix'
1716: (Leaf_Plane(n*(q+1),lnd.all));
1717: elsif lnd.roco > 0
1718: then One_Solve(file,n,q,cod(cod'first..cod'last-1),poset,
1719: lnd.all,planes,s,report,outlog,npaths,timings);
1720: end if;
1721: end if;
1722: continue := true;
1723: end Solve_Grand_Child;
1724:
1725: procedure Solve_Grand_Children is
1726: new Enumerate_Grand_Children(Solve_Grand_Child);
1727:
1728: begin
1729: if (Empty(poset,nd.level,nd.label) and (nd.roco > 0))
1730: then
1731: if cod'last >= cod'first
1732: then Solve_Grand_Children(nd,kk);
1733: end if;
1734: declare
1735: pivots,columns : Bracket(1..m);
1736: mod_piv : Bracket(1..nd.p);
1737: special : Standard_Complex_Matrices.Matrix(1..n,1..m);
1738: target : constant Standard_Complex_Matrices.Matrix
1739: := planes(cod'last).all;
1740: start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk);
1741: bm : Bracket_Monomial := Maximal_Minors(n,kd);
1742: bs : Bracket_System(0..Number_of_Brackets(bm))
1743: := Minor_Equations(kd,kd-nd.p,bm);
1744: begin
1745: for i in columns'range loop
1746: columns(i) := i;
1747: end loop;
1748: if nd.tp = top
1749: then mod_piv := Modulo(nd.top,n);
1750: pivots := Complement(n,mod_piv);
1751: special := Special_Top_Plane(m,mod_piv);
1752: else mod_piv := Modulo(nd.bottom,n);
1753: pivots := Complement(n,mod_piv);
1754: special := Special_Bottom_Plane(m,mod_piv);
1755: end if;
1756: start := Special_Plane(n,m,kk,columns,special);
1757: One_Quantum_Solve_along_Chains
1758: (file,nd,n,q,0,kk,cod'last,poset,pivots,columns,bs,
1759: special,start,target,planes,s,report,outlog,npaths,timings);
1760: Clear(bm); Clear(bs);
1761: end;
1762: end if;
1763: end One_Solve;
1764:
1765: procedure Solve ( file : in file_type; n,q : in natural; cod : in Bracket;
1766: poset : in out Array_of_Array_of_VecMats; nd : in Node;
1767: planes : in VecMat; s : in Standard_Complex_Vectors.Vector;
1768: report,outlog : in boolean;
1769: npaths : in out Standard_Natural_Vectors.Vector;
1770: timings : in out Duration_Array ) is
1771:
1772: begin
1773: null;
1774: end Solve;
1775:
1776: -- DESTRUCTORS :
1777:
1778: procedure Clear ( avm : in out Array_of_VecMats ) is
1779: begin
1780: for i in avm'range loop
1781: Deep_Clear(avm(i));
1782: end loop;
1783: end Clear;
1784:
1785: procedure Clear ( avm : in out Link_to_Array_of_VecMats ) is
1786:
1787: procedure free is
1788: new unchecked_deallocation(Array_of_VecMats,Link_to_Array_of_VecMats);
1789:
1790: begin
1791: if avm /= null
1792: then Clear(avm.all);
1793: free(avm);
1794: end if;
1795: end Clear;
1796:
1797: procedure Clear ( avm : in out Array_of_Array_of_VecMats ) is
1798: begin
1799: for i in avm'range loop
1800: if avm(i) /= null
1801: then Clear(avm(i).all);
1802: end if;
1803: end loop;
1804: end Clear;
1805:
1806: end Deformation_Posets;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to deformation_posets.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