Annotation of OpenXM_contrib/PHC/Ada/Schubert/ts_sagbi.adb, Revision 1.1.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 Symbol_Table;
4: with Standard_Complex_Numbers_io; use Standard_Complex_Numbers_io;
5: with Standard_Natural_Vectors_io; use Standard_Natural_Vectors_io;
6: with Standard_Complex_Vectors; use Standard_Complex_Vectors;
7: with Standard_Complex_Vectors_io; use Standard_Complex_Vectors_io;
8: with Standard_Floating_Matrices; use Standard_Floating_Matrices;
9: with Standard_Floating_Matrices_io; use Standard_Floating_Matrices_io;
10: with Standard_Complex_Polynomials; use Standard_Complex_Polynomials;
11: with Standard_Complex_Polynomials_io; use Standard_Complex_Polynomials_io;
12: with Standard_Complex_Poly_Functions; use Standard_Complex_Poly_Functions;
13: with Matrix_Indeterminates; use Matrix_Indeterminates;
14: with Bracket_Expansions; use Bracket_Expansions;
15: with SAGBI_Homotopies; use SAGBI_Homotopies;
16: with Driver_for_SAGBI_Homotopies;
17:
18: procedure ts_sagbi is
19:
20: procedure Write ( p : in Poly ) is
21:
22: procedure Write_Term ( t : in Term; cont : out boolean ) is
23:
24: begin
25: put("t.cf : "); put(t.cf); new_line;
26: put("t.dg : ");
27: if t.dg /= null
28: then put(t.dg.all); new_line;
29: end if;
30: cont := true;
31: end Write_Term;
32: procedure Write_Terms is new Visiting_Iterator(Write_Term);
33:
34: begin
35: Write_Terms(p);
36: end Write;
37:
38: procedure Write_Coeff ( p : in Poly ) is
39:
40: cff : constant Vector := Coeff(p);
41:
42: begin
43: put_line("The coefficient vector : ");
44: put_line(cff);
45: end Write_Coeff;
46:
47: procedure Test_SAGBI_Homotopy ( file : in file_type; n,d : in natural ) is
48:
49: p,l,p1 : Poly;
50: mat : Matrix(1..n,1..d);
51: ans : character;
52:
53: begin
54: loop
55: Matrix_Indeterminates.Initialize_Symbols(n,d);
56: p := Lifted_Localized_Laplace_Expansion(n,d);
57: Symbol_Table.Replace((n-d)*d+1,"t ");
58: new_line;
59: put_line("The generic polynomial : "); put(p); new_line;
60: Write_Coeff(p);
61: p1 := Lifted_Localized_Laplace_Expansion(n,d);
62: put_line("The new generic polynomial : "); put(p1); new_line;
63: Write(p1);
64: put("Give a floating-point "); put(n,1); put("x"); put(d,1);
65: put_line("-matrix : "); get(mat);
66: l := Intersection_Condition(mat,p);
67: put_line("The specific polynomial : "); put(l); new_line;
68: Write_Coeff(l);
69: declare
70: cff : constant Vector := Intersection_Coefficients(mat,Coeff(p));
71: begin
72: put_line("The computed coefficient vector : ");
73: put_line(cff);
74: end;
75: Matrix_Indeterminates.Clear_Symbols;
76: put("Do you want more tests ? (y/n) "); get(ans);
77: exit when ans /= 'y';
78: end loop;
79: end Test_SAGBI_Homotopy;
80:
81: procedure Main is
82:
83: n,d : natural;
84: file : file_type;
85:
86: begin
87: new_line;
88: put_line("SAGBI Homotopies to intersect planes in projective space.");
89: new_line;
90: put_line("Reading the name of the output file.");
91: Read_Name_and_Create_File(file);
92: new_line;
93: put("Give number of elements to choose from : "); get(n);
94: put("Give the number of entries in bracket : "); get(d);
95: put(file,"SAGBI Homotopies for n = "); put(file,n,1);
96: put(file," and d = "); put(file,d,1); new_line(file);
97: Test_SAGBI_Homotopy(file,n,d);
98: -- Driver_for_SAGBI_Homotopies(file,n,d);
99: end Main;
100:
101: begin
102: Main;
103: end ts_sagbi;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>