[BACK]Return to mainscal.adb CVS log [TXT][DIR] Up to [local] / OpenXM_contrib / PHC / Ada / Homotopy

Annotation of OpenXM_contrib/PHC/Ada/Homotopy/mainscal.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 File_Scanning;                      use File_Scanning;
                      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_Complex_Poly_Systems;      use Standard_Complex_Poly_Systems;
                      8: with Standard_Complex_Poly_Systems_io;   use Standard_Complex_Poly_Systems_io;
                      9: with Standard_Complex_Solutions;         use Standard_Complex_Solutions;
                     10: with Standard_Complex_Solutions_io;      use Standard_Complex_Solutions_io;
                     11: with Scaling;
                     12: with Drivers_for_Scaling;                use Drivers_for_Scaling;
                     13:
                     14: procedure mainscal ( infilename,outfilename : in string ) is
                     15:
                     16:   lp : Link_to_Poly_Sys;
                     17:   infile : file_type;
                     18:   outfile : file_type;
                     19:   n,basis : natural;
                     20:   scalvec : Link_to_Vector;
                     21:   ans : character;
                     22:   sysonfile : boolean;
                     23:
                     24:   procedure Read_System ( file : in out file_type; filename : in string ) is
                     25:   begin
                     26:     if filename /= ""
                     27:      then Open(file,in_file,filename);
                     28:           new_line;
                     29:           get(file,lp);
                     30:           n := lp'length;
                     31:           sysonfile := true;
                     32:      else sysonfile := false;
                     33:     end if;
                     34:   exception
                     35:     when others =>
                     36:       new_line;
                     37:       put("Could not open file with name "); put_line(filename);
                     38:       sysonfile := false; lp := null; return;
                     39:   end Read_System;
                     40:
                     41:   procedure Separate_File ( p : in Poly_Sys ) is
                     42:
                     43:     scafile : file_type;
                     44:
                     45:   begin
                     46:     new_line;
                     47:     put("Do you want the scaled system on separate file ? (y/n) ");
                     48:     Ask_Yes_or_No(ans);
                     49:     if ans = 'y'
                     50:      then put_line("Reading the name of the output file.");
                     51:           Read_Name_and_Create_File(scafile);
                     52:           put(scafile,lp.all);
                     53:           if basis /= 0
                     54:            then new_line(scafile);
                     55:                 put_line(scafile,"SCALING COEFFICIENTS :");
                     56:                 new_line(scafile);
                     57:                 put(scafile,basis,1); new_line(scafile);
                     58:                 put_line(scafile,scalvec);
                     59:           end if;
                     60:           Close(scafile);
                     61:     end if;
                     62:   end Separate_File;
                     63:
                     64:   procedure Rescale is
                     65:
                     66:     sols : Solution_List;
                     67:     found : boolean;
                     68:     m : natural;
                     69:
                     70:   begin
                     71:     if sysonfile                             -- scan for scaling coefficients
                     72:      then Scan_and_Skip(infile,"SCALING COEFFICIENTS",found);
                     73:           if found
                     74:            then get(infile,basis);
                     75:                 scalvec := new vector(1..2*n);
                     76:                 get(infile,scalvec.all);
                     77:           end if;
                     78:      else found := false;
                     79:     end if;
                     80:     if not found
                     81:      then put("Give the basis : "); get(basis);
                     82:           put("Give "); put(2*n,1); put_line(" complex scaling numbers : ");
                     83:           scalvec := new vector(1..2*n);
                     84:           for i in scalvec'range loop
                     85:             get(scalvec(i));
                     86:           end loop;
                     87:     end if;
                     88:     if sysonfile                                    -- scan for the solutions
                     89:      then Reset(infile);
                     90:           Scan_and_Skip(infile,"SOLUTIONS",found);
                     91:           if found
                     92:            then get(infile,sols);
                     93:           end if;
                     94:           Close(infile);
                     95:      else found := false;
                     96:     end if;
                     97:     if not found
                     98:      then put_line("Reading the name of the file for the solutions.");
                     99:           Read_Name_and_Open_File(infile);
                    100:           get(infile,sols);
                    101:           Close(infile);
                    102:     end if;
                    103:     put_line(outfile,"THE SCALING COEFFICIENTS : ");
                    104:     new_line(outfile);
                    105:     put(outfile,basis,1); new_line(outfile);
                    106:     put_line(outfile,scalvec);
                    107:     new_line(outfile);
                    108:     Scaling.Scale(basis,scalvec.all,sols);
                    109:     m := Length_Of(sols);
                    110:     if m > 0
                    111:      then put_line(outfile,"THE DE-SCALED SOLUTIONS : ");
                    112:           new_line(outfile);
                    113:           put(outfile,m,Head_Of(sols).n,sols);
                    114:     end if;
                    115:     Close(outfile);
                    116:   end Rescale;
                    117:
                    118:   procedure Display_and_Dispatch_Menu
                    119:                ( file : in file_type; p : in out Poly_Sys ) is
                    120:
                    121:   -- DESCRIPTION :
                    122:   --   Displays the menu and returns a choice, corresponding to one of the
                    123:   --   three available scaling procedures.
                    124:
                    125:   begin
                    126:     loop
                    127:       new_line;
                    128:       put_line("MENU for Scaling Polynomial Systems :");
                    129:       put_line("  1 : Equation Scaling : divide by average coefficient      ");
                    130:       put_line("  2 : Variable Scaling : change of variables, as z = (2^c)*x");
                    131:       put_line("  3 : Solution Scaling : back to original coordinates       ");
                    132:       put("Type 1, 2, or 3 to select scaling, or i for info : ");
                    133:       Ask_Alternative(ans,"123i");
                    134:       if ans = 'i'
                    135:        then new_line; Drivers_for_Scaling.Display_Info; new_line;
                    136:       end if;
                    137:       exit when ans /= 'i';
                    138:     end loop;
                    139:     case ans is
                    140:       when '1' => Equation_Scaling(file,p); basis := 0;
                    141:       when '2' => Variable_Scaling(file,p,basis,scalvec);
                    142:       when '3' => Rescale;
                    143:       when others => null;
                    144:     end case;
                    145:     case ans is
                    146:       when '1' | '2' => Write_Results(file,p,basis,scalvec);
                    147:       when others    => null;
                    148:     end case;
                    149:     if ans /= '3'
                    150:      then Separate_File(p);
                    151:     end if;
                    152:   end Display_and_Dispatch_Menu;
                    153:
                    154: begin
                    155:   Read_System(infile,infilename);
                    156:   if lp = null
                    157:    then loop
                    158:           new_line;
                    159:           put("Is the system on a file ? (y/n/i=info) ");
                    160:           Ask_Alternative(ans,"yni");
                    161:           if ans = 'i'
                    162:            then new_line;
                    163:                 Standard_Complex_Poly_Systems_io.Display_Format;
                    164:                 new_line;
                    165:           end if;
                    166:           exit when ans /= 'i';
                    167:         end loop;
                    168:         new_line;
                    169:         if ans = 'y'
                    170:          then put_line("Reading the name of the input file.");
                    171:               Read_Name_and_Open_File(infile);
                    172:               get(infile,lp);
                    173:               sysonfile := true;
                    174:               n := lp'length;
                    175:          else put("Give the dimension : "); get(n);
                    176:               lp := new Poly_Sys(1..n);
                    177:               put("Give "); put(n,1); put(" "); put(n,1);
                    178:               put_line("-variate polynomials :");
                    179:               get(n,lp.all);
                    180:               skip_line;  -- skip end_of_line symbol
                    181:               sysonfile := false;
                    182:         end if;
                    183:   end if;
                    184:   Create_Output_File(outfile,outfilename);
                    185:   put(outfile,lp.all); new_line(outfile);
                    186:   Display_and_Dispatch_Menu(outfile,lp.all);
                    187: end mainscal;

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