Annotation of OpenXM_contrib/PHC/Ada/Schubert/ts_sagbi.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 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>