Annotation of OpenXM_contrib/PHC/Ada/Schubert/ts_canocurv.adb, Revision 1.1.1.1
1.1 maekawa 1: with text_io,integer_io; use text_io,integer_io;
2: with Characters_and_Numbers; use Characters_and_Numbers;
3: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
4: with Standard_Natural_Vectors;
5: with Standard_Natural_Matrices;
6: with Symbol_Table,Symbol_Table_io; use Symbol_Table;
7: with Standard_Complex_Polynomials; use Standard_Complex_Polynomials;
8: with Standard_Complex_Poly_Matrices;
9: with Standard_Complex_Poly_Matrices_io; use Standard_Complex_Poly_Matrices_io;
10: with Brackets,Brackets_io; use Brackets,Brackets_io;
11: with Symbolic_Minor_Equations; use Symbolic_Minor_Equations;
12:
13: procedure ts_canocurv is
14:
15: -- DESCRIPTION :
16: -- Test for localization patterns of q-curves.
17:
18: procedure Write_Separator ( p,k : in natural ) is
19:
20: -- DESCRIPTION :
21: -- Writes a separating bar between blocks in a stretched representation
22: -- of a q-curve that produces p-planes.
23: -- The elements in the columns occupy each k spaces.
24:
25: begin
26: for j in 1..p loop
27: for i in 1..k loop
28: put("-");
29: end loop;
30: end loop;
31: put_line("-");
32: end Write_Separator;
33:
34: procedure Write_Pattern ( m,p,q : in natural; top,bottom : in Bracket;
35: locpat : in Standard_Natural_Matrices.Matrix ) is
36:
37: -- DESCRIPTION :
38: -- Writes the pattern for top and bottom pivots of a q-curve that
39: -- produces p-planes into (m+p)-dimensional space.
40:
41: begin
42: put("The pattern of the "); put(q,1); put("-curve into G(");
43: put(m,1); put(","); put(m+p,1); put(") for (");
44: put(top); put(","); put(bottom); put_line(") :");
45: Write_Separator(p,2);
46: for i in locpat'range(1) loop
47: for j in locpat'range(2) loop
48: if locpat(i,j) = 0
49: then put(" 0");
50: else put(" *");
51: end if;
52: end loop;
53: new_line;
54: if i mod (m+p) = 0
55: then Write_Separator(p,2);
56: end if;
57: end loop;
58: end Write_Pattern;
59:
60: procedure Write_Variables ( m,p,q : in natural; top,bottom : in Bracket;
61: locpat : in Standard_Natural_Matrices.Matrix ) is
62:
63: -- DESCRIPTION :
64: -- Writes the variables in the pattern for top and bottom pivots of a
65: -- q-curve that produces p-planes into (m+p)-dimensional space.
66:
67: row,deg : natural := 0;
68:
69: begin
70: put("Variable pattern of the "); put(q,1); put("-curve into G(");
71: put(m,1); put(","); put(m+p,1); put(") for (");
72: put(top); put(","); put(bottom); put_line(") :");
73: Write_Separator(p,6);
74: for i in locpat'range(1) loop
75: row := row + 1;
76: for j in locpat'range(2) loop
77: put(" ");
78: if locpat(i,j) = 0
79: then for k in 1..4 loop
80: put(" ");
81: end loop;
82: put("0");
83: else put("x"); put(row,1); put(j,1); put("s"); put(deg,1);
84: end if;
85: end loop;
86: new_line;
87: if i mod (m+p) = 0
88: then Write_Separator(p,6);
89: row := 0; deg := deg+1;
90: end if;
91: end loop;
92: end Write_Variables;
93:
94: procedure Write_Localization_Pattern
95: ( m,p,q : in natural; top,bottom : in Bracket ) is
96:
97: -- DESCRIPTION :
98: -- Writes the variables in the pattern for top and bottom pivots of a
99: -- q-curve that produces p-planes into (m+p)-dimensional space.
100:
101: rws : constant natural := (m+p)*(q+1);
102: row,deg : natural := 0;
103:
104: begin
105: put("Variable pattern of the "); put(q,1); put("-curve into G(");
106: put(m,1); put(","); put(m+p,1); put(") for (");
107: put(top); put(","); put(bottom); put_line(") :");
108: Write_Separator(p,6);
109: for i in 1..rws loop
110: row := row + 1;
111: for j in 1..p loop
112: put(" ");
113: if (i < top(j) or i > bottom(j))
114: then for k in 1..4 loop
115: put(" ");
116: end loop;
117: put("0");
118: else put("x"); put(row,1); put(j,1); put("s"); put(deg,1);
119: end if;
120: end loop;
121: new_line;
122: if i mod (m+p) = 0
123: then Write_Separator(p,6);
124: row := 0; deg := deg+1;
125: end if;
126: end loop;
127: end Write_Localization_Pattern;
128:
129: function Number_of_Variables ( top,bottom : Bracket ) return natural is
130:
131: -- DESCRIPTION :
132: -- Counts the number of x_ij-variables needed to represent the pattern
133: -- prescribed with top and bottom pivots.
134: -- Note that the actual dimension of the corresponding space is p less.
135:
136: cnt : natural := 0;
137:
138: begin
139: for j in top'range loop
140: cnt := cnt + (bottom(j) - top(j) + 1);
141: end loop;
142: return cnt;
143: end Number_of_Variables;
144:
145: procedure Set_up_Symbol_Table ( m,p,q : natural; top,bottom : in Bracket ) is
146:
147: -- DESCRIPTION :
148: -- Fills the symbol table with those symbols needed to represent a
149: -- q-curve into the Grassmannian of p-planes into (m+p)-space,
150: -- represented in the pattern prescribed by top and bottom pivots.
151: -- The "s" and the "t" variables are the first ones that occur.
152:
153: cnt : constant natural := 2 + Number_of_Variables(top,bottom);
154: rws : constant natural := (m+p)*(q+1);
155: row,deg : natural;
156: sb : Symbol;
157:
158: begin
159: Symbol_Table.Init(cnt); -- initialization with #variables
160: sb := (sb'range => ' ');
161: sb(1) := 's';
162: Symbol_Table.Add(sb); -- adding "s"
163: sb(1) := 't';
164: Symbol_Table.Add(sb); -- adding "t"
165: sb(1) := 'x';
166: sb(4) := 's';
167: for j in 1..p loop -- adding the rest columnwise
168: row := 0; deg := 0;
169: for i in 1..rws loop
170: row := row + 1;
171: if i >= top(j) and i <= bottom(j)
172: then sb(2) := Convert_Hexadecimal(row);
173: sb(3) := Convert_Hexadecimal(j);
174: sb(5) := Convert_Hexadecimal(deg);
175: Symbol_Table.Add(sb);
176: end if;
177: if i mod (m+p) = 0
178: then row := 0; deg := deg+1;
179: end if;
180: end loop;
181: end loop;
182: end Set_up_Symbol_Table;
183:
184: procedure Write_Symbol_Table is
185:
186: -- DESCRIPTION :
187: -- Writes the content of the symbol table.
188:
189: begin
190: put_line("The symbols currently in the symbol table : ");
191: for i in 1..Symbol_Table.Number loop
192: Symbol_Table_io.put(Symbol_Table.Get(i)); new_line;
193: end loop;
194: end Write_Symbol_Table;
195:
196: function Polynomial_Pattern ( m,p,q : natural; top,bottom : Bracket )
197: return Standard_Complex_Poly_Matrices.Matrix is
198:
199: -- DESCRIPTION :
200: -- Returns the representation of a q-curve that produces p-planes in
201: -- (m+p)-dimensional space, in the localization pattern prescribed by
202: -- top and bottom pivots. The columns of the matrix on return contain
203: -- the polynomial functions that generate the p-plane.
204:
205: res : Standard_Complex_Poly_Matrices.Matrix(1..(m+p),1..p);
206: rws : constant natural := (m+p)*(q+1);
207: n : constant natural := 2 + Number_of_Variables(top,bottom);
208: row,ind,s_deg,t_deg : natural;
209: t : Term;
210:
211: begin
212: for i in res'range(1) loop -- initialization
213: for j in res'range(2) loop
214: res(i,j) := Null_Poly;
215: end loop;
216: end loop;
217: t.dg := new Standard_Natural_Vectors.Vector'(1..n => 0);
218: t.cf := Create(1.0);
219: ind := 2; -- ind counts #variables
220: for j in 1..p loop -- assign columnwise
221: t_deg := (bottom(j)-1)/(m+p); -- degree in t to homogenize
222: row := 0; s_deg := 0;
223: for i in 1..rws loop
224: row := row + 1;
225: if i >= top(j) and i <= bottom(j)
226: then ind := ind+1;
227: t.dg(1) := s_deg; t.dg(2) := t_deg;
228: t.dg(ind) := 1;
229: Add(res(row,j),t);
230: t.dg(1) := 0; t.dg(2) := 0;
231: t.dg(ind) := 0;
232: end if;
233: if i mod (m+p) = 0
234: then row := 0; s_deg := s_deg+1; t_deg := t_deg-1;
235: end if;
236: end loop;
237: end loop;
238: Clear(t);
239: return res;
240: end Polynomial_Pattern;
241:
242: procedure Main is
243:
244: m,p,q : natural;
245: ans : character;
246:
247: begin
248: put("Give m : "); get(m);
249: put("Give p : "); get(p);
250: put("Give q : "); get(q);
251: put(" m = "); put(m,1);
252: put(" p = "); put(p,1);
253: put(" q = "); put(q,1); new_line;
254: loop
255: declare
256: top,bottom : Bracket(1..p);
257: begin
258: put("Give top pivots : "); get(top);
259: put("Give bottom pivots : "); get(bottom);
260: put(" top pivots : "); put(top);
261: put(" bottom pivots : "); put(bottom); new_line;
262: Write_Localization_Pattern(m,p,q,top,bottom);
263: Set_up_Symbol_Table(m,p,q,top,bottom);
264: Write_Symbol_Table;
265: put_line("The representation as a matrix of polynomials : ");
266: put(Polynomial_Pattern(m,p,q,top,bottom));
267: end;
268: put("Do you want patterns for other pivots ? (y/n) "); get(ans);
269: exit when (ans /= 'y');
270: end loop;
271: end Main;
272:
273: begin
274: new_line;
275: put_line("Test on canonical form of a curve into the Grassmannian");
276: new_line;
277: Main;
278: end ts_canocurv;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ts_canocurv.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