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

File: [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Implift / ts_binsolve.adb (download)

Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:29 2000 UTC (23 years, 7 months ago) by maekawa
Branch: PHC, MAIN
CVS Tags: v2, maekawa-ipv6, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, HEAD
Changes since 1.1: +0 -0 lines

Import the second public release of PHCpack.

OKed by Jan Verschelde.

with text_io,integer_io;                 use text_io,integer_io;
with Standard_Floating_Numbers_io;       use Standard_Floating_Numbers_io;
with Standard_Complex_Numbers;           use Standard_Complex_Numbers;
with Standard_Complex_Numbers_io;        use Standard_Complex_Numbers_io;
with Standard_Complex_Vectors;           use Standard_Complex_Vectors;
with Standard_Complex_Vectors_io;        use Standard_Complex_Vectors_io;
with Standard_Integer_VecVecs;           use Standard_Integer_VecVecs;
with Standard_Integer_VecVecs_io;        use Standard_Integer_VecVecs_io;
with Standard_Complex_Solutions;         use Standard_Complex_Solutions;
with Standard_Complex_Solutions_io;      use Standard_Complex_Solutions_io;
with Binomial_System_Solvers;            use Binomial_System_Solvers;

procedure ts_binsolve is

-- DESCRIPTION :
--   Test on the solver of binomial systems.

  ans : character;
  n : natural;

  procedure put_Bar is
  begin
    for i in 1..50 loop
      put('*');
    end loop;
    new_line;
  end put_Bar;

  procedure put ( n : in natural; v : in Vector; sols : in Solution_List ) is

    tmp : Solution_List;
    s : Solution(n);
    nb : natural;

  begin
    tmp := sols;
    nb := 1;
    while not Is_Null(tmp) loop
      s := Head_Of(tmp).all;
      put_Bar;
      put("Solution number "); put(nb,1); put_line(" :"); put(s);
      put("The residual : "); put(REAL_PART(v(nb))); new_line;
      nb := nb + 1;
      put_Bar;
      tmp := Tail_Of(tmp);
    end loop;
  end put;

begin
  loop
    put("Give the dimension : "); get(n);
    declare
      vv : VecVec(1..n);
      cv : Standard_Complex_Vectors.Vector(1..n);
      sols : Solution_List;
    begin
      put("Give "); put(n,1); put(' '); put_line("integer vectors :");
      get(n,vv);
      put_line("Give a vector of nonzero constants : ");
      get(cv);
      Solve(vv,cv,n,sols);
      declare
	nb : natural := Length_Of(sols);
	res : Standard_Complex_Vectors.Vector(1..nb);
      begin
	Residuals(vv,cv,n,sols,res);
        put("There are "); put(nb,1); put_line(" solutions :");
        put(n,res,sols);
      end;
      Clear(sols);
    end;
    put("Do you want more tests ? (y/n) "); get(ans);
    exit when ans /= 'y';
  end loop;
end ts_binsolve;