[BACK]Return to ts_binsolve.adb CVS log [TXT][DIR] Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Implift

Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Implift/ts_binsolve.adb, Revision 1.1

1.1     ! maekawa     1: with text_io,integer_io;                 use text_io,integer_io;
        !             2: with Standard_Floating_Numbers_io;       use Standard_Floating_Numbers_io;
        !             3: with Standard_Complex_Numbers;           use Standard_Complex_Numbers;
        !             4: with Standard_Complex_Numbers_io;        use Standard_Complex_Numbers_io;
        !             5: with Standard_Complex_Vectors;           use Standard_Complex_Vectors;
        !             6: with Standard_Complex_Vectors_io;        use Standard_Complex_Vectors_io;
        !             7: with Standard_Integer_VecVecs;           use Standard_Integer_VecVecs;
        !             8: with Standard_Integer_VecVecs_io;        use Standard_Integer_VecVecs_io;
        !             9: with Standard_Complex_Solutions;         use Standard_Complex_Solutions;
        !            10: with Standard_Complex_Solutions_io;      use Standard_Complex_Solutions_io;
        !            11: with Binomial_System_Solvers;            use Binomial_System_Solvers;
        !            12:
        !            13: procedure ts_binsolve is
        !            14:
        !            15: -- DESCRIPTION :
        !            16: --   Test on the solver of binomial systems.
        !            17:
        !            18:   ans : character;
        !            19:   n : natural;
        !            20:
        !            21:   procedure put_Bar is
        !            22:   begin
        !            23:     for i in 1..50 loop
        !            24:       put('*');
        !            25:     end loop;
        !            26:     new_line;
        !            27:   end put_Bar;
        !            28:
        !            29:   procedure put ( n : in natural; v : in Vector; sols : in Solution_List ) is
        !            30:
        !            31:     tmp : Solution_List;
        !            32:     s : Solution(n);
        !            33:     nb : natural;
        !            34:
        !            35:   begin
        !            36:     tmp := sols;
        !            37:     nb := 1;
        !            38:     while not Is_Null(tmp) loop
        !            39:       s := Head_Of(tmp).all;
        !            40:       put_Bar;
        !            41:       put("Solution number "); put(nb,1); put_line(" :"); put(s);
        !            42:       put("The residual : "); put(REAL_PART(v(nb))); new_line;
        !            43:       nb := nb + 1;
        !            44:       put_Bar;
        !            45:       tmp := Tail_Of(tmp);
        !            46:     end loop;
        !            47:   end put;
        !            48:
        !            49: begin
        !            50:   loop
        !            51:     put("Give the dimension : "); get(n);
        !            52:     declare
        !            53:       vv : VecVec(1..n);
        !            54:       cv : Standard_Complex_Vectors.Vector(1..n);
        !            55:       sols : Solution_List;
        !            56:     begin
        !            57:       put("Give "); put(n,1); put(' '); put_line("integer vectors :");
        !            58:       get(n,vv);
        !            59:       put_line("Give a vector of nonzero constants : ");
        !            60:       get(cv);
        !            61:       Solve(vv,cv,n,sols);
        !            62:       declare
        !            63:        nb : natural := Length_Of(sols);
        !            64:        res : Standard_Complex_Vectors.Vector(1..nb);
        !            65:       begin
        !            66:        Residuals(vv,cv,n,sols,res);
        !            67:         put("There are "); put(nb,1); put_line(" solutions :");
        !            68:         put(n,res,sols);
        !            69:       end;
        !            70:       Clear(sols);
        !            71:     end;
        !            72:     put("Do you want more tests ? (y/n) "); get(ans);
        !            73:     exit when ans /= 'y';
        !            74:   end loop;
        !            75: end ts_binsolve;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>