Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Polynomials/standard_evaluator_packages.adb, Revision 1.1
1.1 ! maekawa 1: with integer_io; use integer_io;
! 2: with Communications_with_User; use Communications_with_User;
! 3: with Characters_and_Numbers; use Characters_and_Numbers;
! 4: with Standard_Floating_Numbers; use Standard_Floating_Numbers;
! 5: with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
! 6: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
! 7: with Symbol_Table; use Symbol_Table;
! 8: with Standard_Complex_Polynomials; use Standard_Complex_Polynomials;
! 9: with Standard_Complex_Polynomials_io; use Standard_Complex_Polynomials_io;
! 10: with Standard_Complex_Jaco_Matrices; use Standard_Complex_Jaco_Matrices;
! 11:
! 12: package body Standard_Evaluator_Packages is
! 13:
! 14: function Vector_Symbol ( i : natural ) return Symbol is
! 15:
! 16: res : Symbol;
! 17: s : constant String := "x(" & Convert(i) & ")";
! 18: cnt : natural := res'first;
! 19:
! 20: begin
! 21: for i in s'range loop
! 22: res(cnt) := s(i);
! 23: cnt := cnt+1;
! 24: exit when cnt > res'last;
! 25: end loop;
! 26: for i in cnt..res'last loop
! 27: res(i) := ' ';
! 28: end loop;
! 29: return res;
! 30: end Vector_Symbol;
! 31:
! 32: procedure Replace_Symbols is
! 33:
! 34: -- DESCRIPTION :
! 35: -- Replaces all symbols in the symbol table with vector entries:
! 36: -- x(1), x(2), up to x(n).
! 37:
! 38: n : constant natural := Symbol_Table.Number;
! 39:
! 40: begin
! 41: Symbol_Table.Clear;
! 42: Symbol_Table.Init(n);
! 43: for i in 1..n loop
! 44: Symbol_Table.Add(Vector_Symbol(i));
! 45: end loop;
! 46: end Replace_Symbols;
! 47:
! 48: procedure Create_Inline_Term_Evaluator
! 49: ( file : in file_type; t : in Term ) is
! 50:
! 51: -- DESCRIPTION :
! 52: -- Writes the code to evaluate one term on file.
! 53:
! 54: cff : boolean := false;
! 55:
! 56: begin
! 57: new_line(file);
! 58: if t.cf = Create(1.0)
! 59: then if Sum(t.dg) = 0
! 60: then put(file," + Create(1.0)");
! 61: else put(file," + ");
! 62: end if;
! 63: elsif t.cf = Create(-1.0)
! 64: then if Sum(t.dg) = 0
! 65: then put(file," - Create(1.0)");
! 66: else put(file," - ");
! 67: end if;
! 68: else put(file," + Create(");
! 69: put(file,REAL_PART(t.cf));
! 70: put(file,",");
! 71: put(file,IMAG_PART(t.cf));
! 72: put(file,")");
! 73: cff := true;
! 74: end if;
! 75: for i in t.dg'range loop
! 76: if t.dg(i) /= 0
! 77: then if cff
! 78: then put(file,"*");
! 79: else cff := true;
! 80: end if;
! 81: put(file,"x(" & Convert(i) & ")");
! 82: if t.dg(i) > 1
! 83: then put(file,"**");
! 84: put(file,t.dg(i),1);
! 85: end if;
! 86: end if;
! 87: end loop;
! 88: end Create_Inline_Term_Evaluator;
! 89:
! 90: procedure Create_Inline_Polynomial_Evaluator
! 91: ( file : in file_type; p : in Poly ) is
! 92:
! 93: procedure Visit_Term ( t : in Term; continue : out boolean ) is
! 94: begin
! 95: Create_Inline_Term_Evaluator(file,t);
! 96: continue := true;
! 97: end Visit_Term;
! 98: procedure Visit_Terms is new Visiting_Iterator(Visit_Term);
! 99:
! 100: begin
! 101: Visit_Terms(p);
! 102: put_line(file,";");
! 103: end Create_Inline_Polynomial_Evaluator;
! 104:
! 105: procedure Create_Inline_System_Evaluator
! 106: ( file : in file_type; funname : in String; p : in Poly_Sys ) is
! 107:
! 108: -- DESCRIPTION :
! 109: -- Writes the body of a function for an evaluator for p on file.
! 110:
! 111: begin
! 112: put_line(file," function " & funname
! 113: & " ( x : Vector ) return Vector is");
! 114: new_line(file);
! 115: put_line(file," y : Vector(x'range);");
! 116: new_line(file);
! 117: put_line(file," begin");
! 118: for i in p'range loop
! 119: put(file," y(" & Convert(i) & ") := ");
! 120: Create_Inline_Polynomial_Evaluator(file,p(i));
! 121: end loop;
! 122: put_line(file," return y;");
! 123: put_line(file," end " & funname & ";");
! 124: end Create_Inline_System_Evaluator;
! 125:
! 126: procedure Create_Inline_Jacobian_Evaluator
! 127: ( file : in file_type; funname : in String; p : in Poly_Sys ) is
! 128:
! 129: -- DESCRIPTION :
! 130: -- Writes the body of a function to evaluate the Jacobian matrix of
! 131: -- p on file.
! 132:
! 133: jm : Jaco_Mat(p'range,p'range) := Create(p);
! 134:
! 135: begin
! 136: put_line(file," function " & funname
! 137: & " ( x : Vector ) return Matrix is");
! 138: new_line(file);
! 139: put_line(file," y : Matrix(x'range,x'range);");
! 140: new_line(file);
! 141: put_line(file," begin");
! 142: for i in p'range loop
! 143: for j in p'range loop
! 144: put(file," y(" & Convert(i) & "," & Convert(j) & ") := ");
! 145: Create_Inline_Polynomial_Evaluator(file,jm(i,j));
! 146: end loop;
! 147: end loop;
! 148: put_line(file," return y;");
! 149: put_line(file," end " & funname & ";");
! 150: Clear(jm);
! 151: end Create_Inline_Jacobian_Evaluator;
! 152:
! 153: function Read_Package_Name return String is
! 154:
! 155: -- DESCRIPTION :
! 156: -- Reads the package name from standard input and returns the string.
! 157:
! 158: begin
! 159: put_line("Reading the name of the package.");
! 160: declare
! 161: s : String := Read_String;
! 162: begin
! 163: return s;
! 164: end;
! 165: end Read_Package_Name;
! 166:
! 167: procedure Create ( packname : in String; p : in Poly_Sys ) is
! 168:
! 169: -- DESCRIPTION :
! 170: -- Creates a package that allows to evaluate the polynomial system p.
! 171:
! 172: specfile,bodyfile : file_type;
! 173:
! 174: begin
! 175: Replace_Symbols;
! 176: Create(specfile,out_file,packname & ".ads");
! 177: put_line(specfile,"with Standard_Complex_Vectors; "
! 178: & "use Standard_Complex_Vectors;");
! 179: put_line(specfile,"with Standard_Complex_Matrices; "
! 180: & "use Standard_Complex_Matrices;");
! 181: new_line(specfile);
! 182: put_line(specfile,"package " & packname & " is");
! 183: new_line(specfile);
! 184: put_line(specfile," function Eval_Sys ( x : Vector ) return Vector;");
! 185: put_line(specfile," function Eval_Jaco ( x : Vector ) return Matrix;");
! 186: new_line(specfile);
! 187: put_line(specfile,"end " & packname & ";");
! 188: Close(specfile);
! 189: Create(bodyfile,out_file,packname & ".adb");
! 190: put_line(bodyfile,"with Standard_Floating_Numbers; "
! 191: & "use Standard_Floating_Numbers;");
! 192: put_line(bodyfile,"with Standard_Complex_Numbers; "
! 193: & "use Standard_Complex_Numbers;");
! 194: new_line(bodyfile);
! 195: put_line(bodyfile,"package body " & packname & " is");
! 196: new_line(bodyfile);
! 197: Create_Inline_System_Evaluator(bodyfile,"Eval_Sys",p);
! 198: new_line(bodyfile);
! 199: Create_Inline_Jacobian_Evaluator(bodyfile,"Eval_Jaco",p);
! 200: new_line(bodyfile);
! 201: put_line(bodyfile,"end " & packname & ";");
! 202: Close(bodyfile);
! 203: end Create;
! 204:
! 205: procedure Create ( p : in Poly_Sys ) is
! 206:
! 207: -- DESCRIPTION :
! 208: -- Creates a package that allows to evaluate the polynomial system p.
! 209:
! 210: packname : String := Read_Package_Name;
! 211:
! 212: begin
! 213: Create(packname,p);
! 214: end Create;
! 215:
! 216: end Standard_Evaluator_Packages;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to standard_evaluator_packages.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Polynomials