Annotation of OpenXM_contrib/PHC/Ada/Schubert/ts_canocurv.adb, Revision 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