Return to ts_mreseva.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Continuation

Annotation of OpenXM_contrib/PHC/Ada/Continuation/ts_mreseva.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 Multprec_Floating_Numbers;          use Multprec_Floating_Numbers;
                      4: with Multprec_Floating_Numbers_io;       use Multprec_Floating_Numbers_io;
                      5: with Standard_Complex_Poly_Systems;      use Standard_Complex_Poly_Systems;
                      6: with Standard_Complex_Poly_Systems_io;   use Standard_Complex_Poly_Systems_io;
                      7: with Standard_Complex_Solutions;         use Standard_Complex_Solutions;
                      8: with Standard_Complex_Solutions_io;      use Standard_Complex_Solutions_io;
                      9: with Standard_to_Multprec_Convertors;    use Standard_to_Multprec_Convertors;
                     10: with Multprec_Complex_Vectors;           use Multprec_Complex_Vectors;
                     11: with Multprec_Complex_Vectors_io;        use Multprec_Complex_Vectors_io;
                     12: with Multprec_Complex_Poly_Systems;      use Multprec_Complex_Poly_Systems;
                     13: with Multprec_Complex_Poly_SysFun;       use Multprec_Complex_Poly_SysFun;
                     14: with Multprec_Complex_Solutions;         use Multprec_Complex_Solutions;
                     15: with Multprec_Complex_Solutions_io;      use Multprec_Complex_Solutions_io;
                     16: with Multprec_Residual_Evaluations;      use Multprec_Residual_Evaluations;
                     17:
                     18: procedure ts_mreseva is
                     19:
                     20: -- DESCRIPTION : test on multi-precision residual computation.
                     21:
                     22:   procedure Test_Solution_Residuals
                     23:               ( p : in Multprec_Complex_Poly_Systems.Poly_Sys ) is
                     24:
                     25:     outfile,solsfile : file_type;
                     26:     p_eval : Multprec_Complex_Poly_SysFun.Eval_Poly_Sys(p'range) := Create(p);
                     27:     stsols : Standard_Complex_Solutions.Solution_List;
                     28:     mpsols : Multprec_Complex_Solutions.Solution_List;
                     29:
                     30:   begin
                     31:     new_line;
                     32:     put_line("Reading the name of the output file.");
                     33:     Read_Name_and_Create_File(outfile);
                     34:     new_line;
                     35:     put_line("Reading the name of the file with the solutions.");
                     36:     Read_Name_and_Open_File(solsfile);
                     37:     get(solsfile,stsols);
                     38:     mpsols := Create(stsols);
                     39:    -- get(solsfile,mpsols);
                     40:     put_line(outfile,"The list of solutions : ");
                     41:     put(outfile,mpsols);
                     42:     Residuals(outfile,p_eval,mpsols);
                     43:   end Test_Solution_Residuals;
                     44:
                     45:   procedure Interactive_Test_Residuals
                     46:               ( p : in Multprec_Complex_Poly_Systems.Poly_Sys ) is
                     47:
                     48:     p_eval : Multprec_Complex_Poly_SysFun.Eval_Poly_Sys(p'range) := Create(p);
                     49:     root,eva : Vector(p'range);
                     50:     res : Floating_Number;
                     51:     ans : character;
                     52:
                     53:   begin
                     54:     loop
                     55:       new_line;
                     56:       put("Give "); put(root'last,1);
                     57:       put_line(" complex numbers for the root : ");
                     58:       get(root);
                     59:       eva := Eval(p_eval,root);
                     60:       put_line("The evaluated root : "); put_line(eva);
                     61:       res := Residual(p_eval,root);
                     62:       put("The residual : "); put(res); new_line;
                     63:       put("Do you want more tests ? (y/n) "); Ask_Yes_or_No(ans);
                     64:       Clear(root); Clear(eva); Clear(res);
                     65:       exit when (ans /= 'y');
                     66:     end loop;
                     67:   end Interactive_Test_Residuals;
                     68:
                     69:   procedure Main is
                     70:
                     71:     lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
                     72:     ans : character;
                     73:
                     74:   begin
                     75:     put_line("Choose one of the following : ");
                     76:     put_line("  1. Evaluate user-given vectors");
                     77:     put_line("  2. Residuals for a solution list.");
                     78:     put("Type 1 or 2 to select : "); Ask_Alternative(ans,"12");
                     79:     new_line;
                     80:     get(lp);
                     81:     declare
                     82:       mp : Multprec_Complex_Poly_Systems.Poly_Sys(lp'range) := Convert(lp.all);
                     83:     begin
                     84:       if ans = '1'
                     85:        then Interactive_Test_Residuals(mp);
                     86:        else Test_Solution_Residuals(mp);
                     87:       end if;
                     88:     end;
                     89:   end Main;
                     90:
                     91: begin
                     92:   new_line;
                     93:   put_line("Test on the multi-precision residual computation.");
                     94:   new_line;
                     95:   Main;
                     96: end ts_mreseva;