[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     ! 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>