[BACK]Return to ts_sagbi.adb CVS log [TXT][DIR] Up to [local] / OpenXM_contrib / PHC / Ada / Schubert

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>