with integer_io; use integer_io;
with Characters_and_Numbers; use Characters_and_Numbers;
with Standard_Floating_Numbers; use Standard_Floating_Numbers;
with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
with Standard_Complex_Numbers; use Standard_Complex_Numbers;
with Standard_Natural_Vectors;
with Symbol_Table,Symbol_Table_io; use Symbol_Table;
package body Standard_Complex_Polynomials_io is
-- INTERNAL VARIABLES :
right : constant natural := 75; -- these variables are needed
column : natural := 0; -- for the output of long polynomials
procedure init_line is
begin
column := 0;
end init_line;
procedure line ( file : in file_type; n : natural ) is
-- DESCRIPTION :
-- this routine decides when a new line on the output has to be taken;
-- n is the number of characters that will be written on the output.
-- This routine must be invoked before the actual output operation.
begin
if n >= right - column
then new_line(file);
column := 0;
else column := column + n;
end if;
end line;
-- AUXILIARIES FOR THE INPUT ROUTINES :
procedure Build_Number ( file : in file_type;
char : in out character; i1,i2 : out integer;
ni1,ni2 : out natural; sign : out character ) is
-- DESCRIPTION :
-- characters are read from the input and a number is build up;
-- the result is the number : i1*10^ni2 + i2.
-- ON ENTRY :
-- file file type of a file that must be opened for input;
-- char first character to be analized.
-- ON RETURN :
-- char first character that is not a digit;
-- i1, i2 digits read;
-- ni1, ni2 number of digits in i1 and i2;
-- sign sign of the number.
res1,res2 : integer := 0;
min : boolean := false;
k1,k2,temp : natural := 0;
begin
sign := '+';
while (char = ' ') loop get(file,char); end loop;
if (char = '+') or (char = '-')
then min := (char = '-');
sign := char;
get(file,char);
end if;
while (char = ' ') loop get(file,char); end loop;
loop
temp := Convert(char);
if temp < 10
then if k1 < 9
then res1 := res1*10 + temp;
k1 := k1 + 1;
elsif k2 < 9
then res2 := res2*10 + temp;
k2 := k2 + 1;
else null; -- skip the rest of the numbers
end if;
get(file,char);
else exit;
end if;
end loop;
if min
then i1 := -res1; i2 := -res2;
else i1 := res1; i2 := res2;
end if;
ni1 := k1;
ni2 := k2;
end Build_Number;
procedure Build_Number ( file : in file_type;
char : in out character; f : out double_float ) is
-- DESCRIPTION :
-- a floating point number is read
f_int1,f_int2,f_quot1,f_quot2,expo,expo2 : integer := 0;
f_int,f_quot : double_float := 0.0;
k1,k2,nq1,nq2,np1,np2,temp : natural := 0;
sign : character;
min : boolean;
begin
Build_Number(file,char,f_int1,f_int2,np1,np2,sign);
f_int := double_float(f_int1) * 10.0**np2 + double_float(f_int2);
min := (sign = '-');
case char is
when '.' => get(file,char); -- skip the point
temp := Convert(char);
if temp < 10
then Build_Number(file,char,f_quot1,f_quot2,nq1,nq2,sign);
f_quot := double_float(f_quot1) * 10.0**nq2
+ double_float(f_quot2);
end if;
if char = 'E'
then get(file,char); -- skip the 'E'
Build_Number(file,char,expo,expo2,k1,k2,sign);
end if;
when 'E' => if char = 'E'
then get(file,char); -- skip the 'E'
Build_Number(file,char,expo,expo2,k1,k2,sign);
end if;
when others => null;
end case;
if min
then if (f_int = 0.0) and (f_quot = 0.0) and (nq1 = 0) and (np1 = 0)
then f := -1.0; -- "-x" = -1*x
else f := ( f_int - f_quot*10.0**(-nq1-nq2) )*10.0**expo ;
end if;
else f := ( f_int + f_quot*10.0**(-nq1-nq2) )*10.0**expo ;
end if;
end Build_Number;
procedure Build_Number ( file : in file_type;
char : in out character; c : out Complex_Number ) is
-- DESCRIPTION :
-- a floating point number is read and converted into a complex number;
-- the number may be the quotient of two floating point numbers
f1,f2 : double_float;
begin
Build_Number(file,char,f1);
if char = '/'
then get(file,char); -- skip the '/'
Build_Number(file,char,f2);
c := Create(f1/f2);
else c := Create(f1);
end if;
exception
when numeric_error => raise INFINITE_NUMBER;
end Build_Number;
procedure Read_Term ( file : in file_type; char : in out character;
n : in natural; termp : in out Poly );
-- DESCRIPTION :
-- Reads a term from file, char is the first character of the term.
procedure Read_Factor ( file : in file_type;
char : in out character; n : in natural;
d : in out Degrees; pb : in out Poly );
-- DESCRIPTION :
-- Reads a factor from file, char is the first character of the factor.
procedure Read_Factor ( file : in file_type;
char : in out character; n : in natural;
d : in out Degrees; pb : in out Poly ) is
sb : symbol;
i : positive := 1;
k,ne,ne2 : natural := 0;
expo,expo2 : integer := 1;
sign : character;
begin
sb := (sb'range => ' ');
while (char = ' ') loop get(file,char); end loop;
if char = '('
then get(file,pb);
get(file,char); -- get a new symbol, skip '('
return;
end if;
-- read the symbol :
loop
case char is
when '+' | '-' | '*' | '^' => exit;
when delimiter | ' ' | ')' => exit;
when '(' => raise ILLEGAL_SYMBOL;
when others => sb(i) := char;
i := i+1; get(file,char);
end case;
end loop;
-- check for legality of the symbol :
if Convert(sb(1)) < 10
then raise ILLEGAL_SYMBOL;
else for j in 2..3 loop
case sb(j) is
when '*' | '+' | '-' | '^' | '/' | ';' | '(' | ')'
=> raise ILLEGAL_SYMBOL;
when others => null;
end case;
end loop;
end if;
-- search for the number of the symbol :
k := Symbol_Table.get(sb);
if k = 0
then declare
begin
Symbol_Table.add(sb,k);
exception
when OVERFLOW_IN_THE_SYMBOL_TABLE => raise OVERFLOW_OF_UNKNOWNS;
end;
end if;
if k > n
then raise OVERFLOW_OF_UNKNOWNS;
end if;
-- read further :
while (char = ' ') loop get(file,char); end loop;
if char = '^'
then get(file,char); -- skip the '^'
Build_Number(file,char,expo,expo2,ne,ne2,sign);
d(k) := d(k) + natural(expo);
while char = ' ' loop get(file,char); end loop;
if char /= '*' -- the case x^2*...
then return; -- end of factor
else get(file,char); -- skip the '*'
end if;
elsif char = '*'
then get(file,char);
if char = '*'
then get(file,char); -- the case " x ** expo "
Build_Number(file,char,expo,expo2,ne,ne2,sign);
d(k) := d(k) + natural(expo);
while (char = ' ') loop get(file,char); end loop;
if char /= '*'
then return; -- end of factor
else get(file,char); -- skip the '*'
end if;
else d(k) := d(k) + 1; -- the case " x * ? "
end if;
else -- the case " x ?", with ? /= '*' or ' ' or '^' :
d(k) := d(k) + 1;
return;
end if;
while (char = ' ') loop get(file,char); end loop;
if (char = '-') or (char = '+')
then return;
end if;
if Convert(char) < 10
then -- the case " x * c " or " x ** c * c " :
Read_Term(file,char,n,pb);
else -- the case " x * y " :
Read_Factor(file,char,n,d,pb);
end if;
exception
when ILLEGAL_CHARACTER => raise ILLEGAL_CHARACTER;
when ILLEGAL_SYMBOL => raise ILLEGAL_SYMBOL;
when ILLEGAL_OPERATION => raise ILLEGAL_OPERATION;
when INFINITE_NUMBER => raise INFINITE_NUMBER;
when OVERFLOW_OF_UNKNOWNS => raise OVERFLOW_OF_UNKNOWNS;
when BAD_BRACKET => raise BAD_BRACKET;
end Read_Factor;
procedure Read_Term ( file : in file_type; char : in out character;
n : in natural; termp : in out Poly ) is
c : Complex_Number;
d : Degrees := new Standard_Natural_Vectors.Vector'(1..n => 0);
pb,res,temp : Poly;
tmp : Term;
procedure Collect_Factor_Polynomial is
begin
if pb /= Null_Poly
then if res = Null_Poly
then Copy(pb,res); Clear(pb);
else Mul(res,pb); Clear(pb);
end if;
end if;
end Collect_Factor_Polynomial;
begin
Build_Number(file,char,c);
-- look for 'i' :
while (char = ' ') loop get(file,char); end loop;
if ( c = Create(0.0) ) and then (char = 'i')
then -- the case "+ i" :
c := Create(0.0,1.0);
get(file,char); -- skip 'i'
elsif ( c = Create(-1.0) ) and then (char = 'i')
then -- the case "- i" :
c := Create(0.0,-1.0);
get(file,char); -- skip 'i'
elsif char = '*'
then -- the case ".. c *.." :
while (char = ' ') loop get(file,char); end loop;
get(file,char); -- skip '*'
while (char = ' ') loop get(file,char); end loop;
if char = 'i'
then -- the case ".. c * i.." :
c := Create(0.0,REAL_PART(c));
get(file,char); -- skip 'i'
else -- the case ".. c * x.." :
Read_Factor(file,char,n,d,pb);
if pb /= Null_Poly
then Clear(res); Copy(pb,res); Clear(pb);
end if;
end if;
else -- the case ".. c ?" :
-- will be treated in the loop
null;
end if;
loop
case char is
when ' ' => get(file,char);
when '*' => get(file,char); Read_Factor(file,char,n,d,pb);
Collect_Factor_Polynomial;
when '+' | '-' => if c = Create(0.0)
then raise ILLEGAL_CHARACTER;
else exit;
end if;
when delimiter => exit;
when '(' => if c = Create(0.0) or else c = Create(-1.0)
then -- the case "+ (" or "- (" :
c := Create(0.0);
exit;
else -- the case "c (" :
raise BAD_BRACKET;
end if;
when ')' => exit;
when others => if c = Create(0.0)
then c := Create(1.0);
Read_Factor(file,char,n,d,pb);
elsif c = Create(-1.0)
then Read_Factor(file,char,n,d,pb);
else raise ILLEGAL_CHARACTER;
end if;
Collect_Factor_Polynomial;
end case;
end loop;
tmp.cf := c;
tmp.dg := d;
termp := create(tmp);
if Number_Of_Unknowns(res) > 0
then Mul(termp,res); Clear(res);
end if;
exception
when ILLEGAL_CHARACTER => raise ILLEGAL_CHARACTER;
when ILLEGAL_SYMBOL => raise ILLEGAL_SYMBOL;
when ILLEGAL_OPERATION => raise ILLEGAL_OPERATION;
when INFINITE_NUMBER => raise INFINITE_NUMBER;
when OVERFLOW_OF_UNKNOWNS => raise OVERFLOW_OF_UNKNOWNS;
when BAD_BRACKET => raise BAD_BRACKET;
end Read_Term;
----------------------------------
-- THE INPUT OPERATIONS : --
----------------------------------
procedure get ( p : in out Poly ) is
begin
get(Standard_Input,p);
exception
when ILLEGAL_CHARACTER => raise ILLEGAL_CHARACTER;
when ILLEGAL_SYMBOL => raise ILLEGAL_SYMBOL;
when ILLEGAL_OPERATION => raise ILLEGAL_OPERATION;
when INFINITE_NUMBER => raise INFINITE_NUMBER;
when OVERFLOW_OF_UNKNOWNS => raise OVERFLOW_OF_UNKNOWNS;
when BAD_BRACKET => raise BAD_BRACKET;
end get;
procedure get ( file : in file_type; p : in out Poly ) is
n : constant natural := Symbol_Table.Maximal_Size;
char,oper : character;
term,res,acc : Poly;
begin
oper := '+';
get(file,char);
while (char = ' ') loop get(file,char); end loop;
if char = '-'
then oper := '-';
end if;
-- the first term can have no sign
Read_Term(file,char,n,res); -- therefore read it first
loop
case char is
when ' ' => get(file,char); -- skip blanks
when '+' | '-' => oper := char;
Read_Term(file,char,n,term);
Add(res,term); Clear(term);
when delimiter => exit;
when '(' => get(file,term);
case oper is
when '+' => Add(acc,res); Clear(res);
Copy(term,res);
when '-' => Add(acc,res);Clear(res);
Copy(term,res); Min(res);
when '*' => Mul(res,term);
when others => raise ILLEGAL_OPERATION;
end case;
Clear(term);
get(file,char); -- get new character
when ')' => exit;
when '*' => if res = Null_Poly
then raise ILLEGAL_CHARACTER;
else -- the case " ) * " :
oper := char; get(file,char); -- skip '*'
Read_Term(file,char,n,term);
if char /= '('
then case oper is
when '+' => Add(res,term);
when '-' => Sub(res,term);
when '*' => Mul(res,term);
when others => raise ILLEGAL_OPERATION;
end case;
end if;
Clear(term);
end if;
when others => raise ILLEGAL_CHARACTER;
end case;
end loop;
p := acc + res;
Clear(acc); Clear(res);
exception
when ILLEGAL_CHARACTER => raise ILLEGAL_CHARACTER;
when ILLEGAL_SYMBOL => raise ILLEGAL_SYMBOL;
when ILLEGAL_OPERATION => raise ILLEGAL_OPERATION;
when INFINITE_NUMBER => raise INFINITE_NUMBER;
when OVERFLOW_OF_UNKNOWNS => raise OVERFLOW_OF_UNKNOWNS;
when BAD_BRACKET => raise BAD_BRACKET;
end get;
procedure get ( n : in out natural; p : in out Poly ) is
begin
get(Standard_Input,n,p);
exception
when ILLEGAL_CHARACTER => raise ILLEGAL_CHARACTER;
when ILLEGAL_SYMBOL => raise ILLEGAL_SYMBOL;
when ILLEGAL_OPERATION => raise ILLEGAL_OPERATION;
when INFINITE_NUMBER => raise INFINITE_NUMBER;
when OVERFLOW_OF_UNKNOWNS => raise OVERFLOW_OF_UNKNOWNS;
when BAD_BRACKET => raise BAD_BRACKET;
end get;
procedure get ( file : in file_type; n : in out natural; p : in out Poly ) is
begin
get(file,n);
if Symbol_Table.Empty
then Symbol_Table.Init(n);
end if;
get(file,p);
exception
when ILLEGAL_CHARACTER => raise ILLEGAL_CHARACTER;
when ILLEGAL_SYMBOL => raise ILLEGAL_SYMBOL;
when ILLEGAL_OPERATION => raise ILLEGAL_OPERATION;
when INFINITE_NUMBER => raise INFINITE_NUMBER;
when OVERFLOW_OF_UNKNOWNS => raise OVERFLOW_OF_UNKNOWNS;
when BAD_BRACKET => raise BAD_BRACKET;
end get;
-- AUXILIARIES FOR OUTPUT ROUTINES :
function Is_Imag ( c : Complex_Number ) return boolean is
begin
return ( REAL_PART(c) = 0.0 );
end is_imag;
function Is_Real ( c : Complex_Number ) return boolean is
begin
return ( IMAG_PART(c) = 0.0 );
end is_real;
function Is_Integer ( f : double_float ) return boolean is
begin
return ( (f - double_float(integer(f))) = 0.0 );
exception
when numeric_error => return false;
end is_integer;
procedure Write_Number ( file : in file_type; i : in integer ) is
-- DESCRIPTION :
-- writes the integer number with only one blank before it
begin
for j in 1..8 loop
if i < integer(10.0**j)
then line(file,j+1);
put(file,i,j+1);
return;
end if;
end loop;
line(file,11); put(file,i);
end Write_Number;
procedure Write_Number ( file : in file_type; f : in double_float ) is
begin
if is_integer(f)
then Write_Number(file,integer(f));
else line(file,21); put(file,f);
end if;
end Write_Number;
procedure Write_Number ( file : in file_type; c : in Complex_Number ) is
begin
if Is_Real(c)
then Write_Number(file,REAL_PART(c));
elsif Is_Imag(c)
then Write_Number(file,IMAG_PART(c));
line(file,2); put(file,"*i");
else line(file,1); put(file,"(");
Write_Number(file,REAL_PART(c));
if IMAG_PART(c) > 0.0
then line(file,2); put(file," +");
else line(file,2); put(file," -");
end if;
if IMAG_PART(c) = 1.0
then line(file,1); put(file,"i");
elsif IMAG_PART(c) = -1.0
then line(file,3); put(file," -i");
else Write_Number(file,abs(IMAG_PART(c)));
line(file,2); put(file,"*i");
end if;
line(file,1); put(file,")");
end if;
end Write_Number;
function Length_Factor ( d,i : natural; standard : boolean;
pow : power ) return natural is
-- DESCRIPTION :
-- this procedure computes the number of characters needed
-- for the output of one factor
l : natural := 0;
sb : symbol;
begin
if standard
then if i < 10
then l := l + 2;
else l := l + 3;
end if;
else sb := Symbol_Table.get(i);
if sb(3) /= ' '
then l := l + 3;
elsif sb(2) /= ' '
then l := l + 2;
else l := l + 1;
end if;
end if;
if d > 1
then if pow = '^'
then l := l + 1;
else l := l + 2;
end if;
if d < 10
then l := l + 1;
else l := l + 2;
end if;
end if;
return l;
end Length_Factor;
procedure Write_Factor ( file : in file_type; d,i : in natural;
standard : in boolean; pow : in power ) is
-- DESCRIPTION :
-- Writes the factor corresponding with the ith unknown on file.
sb : Symbol;
begin
if standard
then put(file,'x');
if i<10
then put(file,i,1);
else put(file,i,2);
end if;
else sb := Symbol_Table.get(i); Symbol_Table_io.put(file,sb);
end if;
if d > 1
then if pow = '^'
then put(file,'^');
else put(file,"**");
end if;
if d < 10
then put(file,d,1);
else put(file,d,2);
end if;
end if;
end Write_Factor;
-- THE OUTPUT OPERATIONS :
procedure put ( p : in Poly; pow : in power ) is
begin
put(Standard_Output,p,pow);
end put;
procedure put ( file : in file_type; p : in Poly; pow : in power ) is
nn : constant natural := Number_of_Unknowns(p);
standard : constant boolean := ( Symbol_Table.Number < nn );
first_time : boolean := true;
procedure Write_Term ( t : in Term; continue : out boolean ) is
-- DESCRIPTION :
-- Writes a term is written on file.
passed : boolean;
begin
if first_time
then first_time := false;
else if (is_real(t.cf) and then REAL_PART(t.cf) > 0.0)
or else (is_imag(t.cf) and then IMAG_PART(t.cf) > 0.0)
or else (not is_real(t.cf) and then not is_imag(t.cf))
then line(file,1); put(file,'+');
end if;
end if;
if Sum(t.dg) = 0
then Write_Number(file,t.cf);
else if ( t.cf - Create(-1.0) ) + Create(1.0) = Create(1.0)
then line(file,1); put(file,'-');
elsif ( t.cf - Create(0.0,1.0) ) + Create(1.0) = Create(1.0)
then line(file,2); put(file,"i*");
elsif ( t.cf - Create(0.0,-1.0) ) + Create(1.0) = Create(1.0)
then line(file,3); put(file,"-i*");
elsif (t.cf /= Create(1.0))
then Write_Number(file,t.cf);
line(file,1); put(file,'*');
end if;
passed := false;
for i in t.dg'range loop
if t.dg(i) > 0
then if passed
then line(file,1); put(file,'*');
else passed := true;
end if;
Line(file,Length_Factor(t.dg(i),i,standard,pow));
Write_Factor(file,t.dg(i),i,standard,pow);
end if;
end loop;
end if;
continue := true;
end Write_Term;
procedure Write_Terms is new Visiting_Iterator (process => Write_Term);
begin
init_line;
Write_Terms(p);
line(file,1); put(file,delimiter);
end put;
procedure put ( n : in natural; p : in Poly; pow : in power ) is
begin
put(Standard_Output,n,p,pow);
end put;
procedure put ( file : in file_type; n : in natural;
p : in Poly; pow : in power ) is
begin
put(file,n,1);
put_line(file," ");
put(file,p,pow);
end put;
procedure put ( p : in Poly ) is
begin
put(Standard_Output,p,'*');
end put;
procedure put ( file : in file_type; p : in Poly ) is
begin
put(file,p,'*');
end put;
procedure put ( p : in Poly; dp : in natural ) is
begin
put(Standard_Output,p,dp);
end put;
procedure put ( file : in file_type; p : in Poly; dp : in natural ) is
begin
put(file,p);
end put;
procedure put_line ( file : in file_type; p : in Poly; pow : in power ) is
n : constant natural := Number_of_Unknowns(p);
standard : constant boolean := ( Symbol_Table.Number < n );
procedure Write_Term ( t : in Term; continue : out boolean ) is
begin
new_line(file);
if Is_Real(t.cf)
then if REAL_PART(t.cf) >= 0.0
then put(file,"+");
end if;
else put(file,"+");
end if;
Init_Line; Write_Number(file,t.cf);
if Sum(t.dg) /= 0
then for i in t.dg'range loop
if t.dg(i) > 0
then put(file,'*');
Write_Factor(file,t.dg(i),i,standard,pow);
end if;
end loop;
end if;
continue := true;
end Write_Term;
procedure Write_Terms is new Visiting_Iterator (process => Write_Term);
begin
Write_Terms(p);
put_line(file,";");
end put_line;
procedure put_line ( p : in Poly; pow : in power ) is
begin
put_line(Standard_Output,p,pow);
end put_line;
procedure put_line ( p : in Poly ) is
begin
put_line(Standard_Output,p,'*');
end put_line;
procedure put_line ( file : in file_type; p : in Poly ) is
begin
put_line(file,p,'*');
end put_line;
procedure Display_Format is
s : array(1..24) of string(1..65);
begin
s( 1):=" A complex multivariate polynomial is denoted as a sequence of";
s( 2):="terms, separated by `+' and terminated by the semicolon `;'. The";
s( 3):="brackets '(' and ')' must be used to isolate a sequence of terms";
s( 4):="as a factor in a complex multivariate polynomial. ";
s( 5):=" A term can be either a coefficient or a coefficient, followed";
s( 6):="by '*' and a monomial. If in the latter case the coefficient";
s( 7):="equals one, then it may be omitted. ";
s( 8):=" A coefficient may be denoted as an integer, a rational, a";
s( 9):="floating-point or a complex number. ";
s(10):=" A monomial is a sequence of powers of unknowns, separated by";
s(11):="'*'. The power operator is represented by '**' or '^'. It must";
s(12):="be followed by a positive natural number. If the power equals";
s(13):="one, then it may be omitted. ";
s(14):=" An unknown can be denoted by at most 3 characters. The first";
s(15):="character must be a letter and the other two characters must be";
s(16):="different from '+', '-', '*', '^', '/', ';', '(' and ')'. The";
s(17):="letter i means sqrt(-1), whence it does not represent an unknown.";
s(18):="The number of unknowns may not exceed the declared dimension.";
s(19):=" Some examples of valid notations of complex multivariate";
s(20):="polynomials: ";
s(21):=" x**2*y + 1/2*z*y**2 - 2*z + y**3 + x - 1E9/-8.E-6* y + 3; ";
s(22):=" x^2*y + z*y^2 - 2*z + y^3 + x - y + 3; ";
s(23):=" (1.01 + 2.8*i)*x1**2*x2 + x3**2*x1 - 3*x1 + 2*x2*x3 - 3; ";
s(24):=" (x1^2*x2 + x3^2*x1 - 3*x1 + 2*x2*x3 - 3)*x2**2*(x2-1+i); ";
for i in s'range loop
put_line(s(i));
end loop;
end Display_Format;
end Standard_Complex_Polynomials_io;
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to standard_complex_polynomials_io.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