[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

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>