Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Polynomials/standard_complex_polynomials_io.adb, Revision 1.1
1.1 ! maekawa 1: with integer_io; use integer_io;
! 2: with Characters_and_Numbers; use Characters_and_Numbers;
! 3: with Standard_Floating_Numbers; use Standard_Floating_Numbers;
! 4: with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
! 5: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
! 6: with Standard_Natural_Vectors;
! 7: with Symbol_Table,Symbol_Table_io; use Symbol_Table;
! 8:
! 9: package body Standard_Complex_Polynomials_io is
! 10:
! 11: -- INTERNAL VARIABLES :
! 12:
! 13: right : constant natural := 75; -- these variables are needed
! 14: column : natural := 0; -- for the output of long polynomials
! 15:
! 16: procedure init_line is
! 17: begin
! 18: column := 0;
! 19: end init_line;
! 20:
! 21: procedure line ( file : in file_type; n : natural ) is
! 22:
! 23: -- DESCRIPTION :
! 24: -- this routine decides when a new line on the output has to be taken;
! 25: -- n is the number of characters that will be written on the output.
! 26: -- This routine must be invoked before the actual output operation.
! 27:
! 28: begin
! 29: if n >= right - column
! 30: then new_line(file);
! 31: column := 0;
! 32: else column := column + n;
! 33: end if;
! 34: end line;
! 35:
! 36: -- AUXILIARIES FOR THE INPUT ROUTINES :
! 37:
! 38: procedure Build_Number ( file : in file_type;
! 39: char : in out character; i1,i2 : out integer;
! 40: ni1,ni2 : out natural; sign : out character ) is
! 41: -- DESCRIPTION :
! 42: -- characters are read from the input and a number is build up;
! 43: -- the result is the number : i1*10^ni2 + i2.
! 44:
! 45: -- ON ENTRY :
! 46: -- file file type of a file that must be opened for input;
! 47: -- char first character to be analized.
! 48:
! 49: -- ON RETURN :
! 50: -- char first character that is not a digit;
! 51: -- i1, i2 digits read;
! 52: -- ni1, ni2 number of digits in i1 and i2;
! 53: -- sign sign of the number.
! 54:
! 55: res1,res2 : integer := 0;
! 56: min : boolean := false;
! 57: k1,k2,temp : natural := 0;
! 58:
! 59: begin
! 60: sign := '+';
! 61: while (char = ' ') loop get(file,char); end loop;
! 62: if (char = '+') or (char = '-')
! 63: then min := (char = '-');
! 64: sign := char;
! 65: get(file,char);
! 66: end if;
! 67: while (char = ' ') loop get(file,char); end loop;
! 68: loop
! 69: temp := Convert(char);
! 70: if temp < 10
! 71: then if k1 < 9
! 72: then res1 := res1*10 + temp;
! 73: k1 := k1 + 1;
! 74: elsif k2 < 9
! 75: then res2 := res2*10 + temp;
! 76: k2 := k2 + 1;
! 77: else null; -- skip the rest of the numbers
! 78: end if;
! 79: get(file,char);
! 80: else exit;
! 81: end if;
! 82: end loop;
! 83: if min
! 84: then i1 := -res1; i2 := -res2;
! 85: else i1 := res1; i2 := res2;
! 86: end if;
! 87: ni1 := k1;
! 88: ni2 := k2;
! 89: end Build_Number;
! 90:
! 91: procedure Build_Number ( file : in file_type;
! 92: char : in out character; f : out double_float ) is
! 93: -- DESCRIPTION :
! 94: -- a floating point number is read
! 95:
! 96: f_int1,f_int2,f_quot1,f_quot2,expo,expo2 : integer := 0;
! 97: f_int,f_quot : double_float := 0.0;
! 98: k1,k2,nq1,nq2,np1,np2,temp : natural := 0;
! 99: sign : character;
! 100: min : boolean;
! 101:
! 102: begin
! 103: Build_Number(file,char,f_int1,f_int2,np1,np2,sign);
! 104: f_int := double_float(f_int1) * 10.0**np2 + double_float(f_int2);
! 105: min := (sign = '-');
! 106: case char is
! 107: when '.' => get(file,char); -- skip the point
! 108: temp := Convert(char);
! 109: if temp < 10
! 110: then Build_Number(file,char,f_quot1,f_quot2,nq1,nq2,sign);
! 111: f_quot := double_float(f_quot1) * 10.0**nq2
! 112: + double_float(f_quot2);
! 113: end if;
! 114: if char = 'E'
! 115: then get(file,char); -- skip the 'E'
! 116: Build_Number(file,char,expo,expo2,k1,k2,sign);
! 117: end if;
! 118: when 'E' => if char = 'E'
! 119: then get(file,char); -- skip the 'E'
! 120: Build_Number(file,char,expo,expo2,k1,k2,sign);
! 121: end if;
! 122: when others => null;
! 123: end case;
! 124: if min
! 125: then if (f_int = 0.0) and (f_quot = 0.0) and (nq1 = 0) and (np1 = 0)
! 126: then f := -1.0; -- "-x" = -1*x
! 127: else f := ( f_int - f_quot*10.0**(-nq1-nq2) )*10.0**expo ;
! 128: end if;
! 129: else f := ( f_int + f_quot*10.0**(-nq1-nq2) )*10.0**expo ;
! 130: end if;
! 131: end Build_Number;
! 132:
! 133: procedure Build_Number ( file : in file_type;
! 134: char : in out character; c : out Complex_Number ) is
! 135: -- DESCRIPTION :
! 136: -- a floating point number is read and converted into a complex number;
! 137: -- the number may be the quotient of two floating point numbers
! 138:
! 139: f1,f2 : double_float;
! 140:
! 141: begin
! 142: Build_Number(file,char,f1);
! 143: if char = '/'
! 144: then get(file,char); -- skip the '/'
! 145: Build_Number(file,char,f2);
! 146: c := Create(f1/f2);
! 147: else c := Create(f1);
! 148: end if;
! 149: exception
! 150: when numeric_error => raise INFINITE_NUMBER;
! 151: end Build_Number;
! 152:
! 153: procedure Read_Term ( file : in file_type; char : in out character;
! 154: n : in natural; termp : in out Poly );
! 155: -- DESCRIPTION :
! 156: -- Reads a term from file, char is the first character of the term.
! 157:
! 158: procedure Read_Factor ( file : in file_type;
! 159: char : in out character; n : in natural;
! 160: d : in out Degrees; pb : in out Poly );
! 161: -- DESCRIPTION :
! 162: -- Reads a factor from file, char is the first character of the factor.
! 163:
! 164: procedure Read_Factor ( file : in file_type;
! 165: char : in out character; n : in natural;
! 166: d : in out Degrees; pb : in out Poly ) is
! 167:
! 168: sb : symbol;
! 169: i : positive := 1;
! 170: k,ne,ne2 : natural := 0;
! 171: expo,expo2 : integer := 1;
! 172: sign : character;
! 173:
! 174: begin
! 175: sb := (sb'range => ' ');
! 176: while (char = ' ') loop get(file,char); end loop;
! 177: if char = '('
! 178: then get(file,pb);
! 179: get(file,char); -- get a new symbol, skip '('
! 180: return;
! 181: end if;
! 182: -- read the symbol :
! 183: loop
! 184: case char is
! 185: when '+' | '-' | '*' | '^' => exit;
! 186: when delimiter | ' ' | ')' => exit;
! 187: when '(' => raise ILLEGAL_SYMBOL;
! 188: when others => sb(i) := char;
! 189: i := i+1; get(file,char);
! 190: end case;
! 191: end loop;
! 192: -- check for legality of the symbol :
! 193: if Convert(sb(1)) < 10
! 194: then raise ILLEGAL_SYMBOL;
! 195: else for j in 2..3 loop
! 196: case sb(j) is
! 197: when '*' | '+' | '-' | '^' | '/' | ';' | '(' | ')'
! 198: => raise ILLEGAL_SYMBOL;
! 199: when others => null;
! 200: end case;
! 201: end loop;
! 202: end if;
! 203: -- search for the number of the symbol :
! 204: k := Symbol_Table.get(sb);
! 205: if k = 0
! 206: then declare
! 207: begin
! 208: Symbol_Table.add(sb,k);
! 209: exception
! 210: when OVERFLOW_IN_THE_SYMBOL_TABLE => raise OVERFLOW_OF_UNKNOWNS;
! 211: end;
! 212: end if;
! 213: if k > n
! 214: then raise OVERFLOW_OF_UNKNOWNS;
! 215: end if;
! 216: -- read further :
! 217: while (char = ' ') loop get(file,char); end loop;
! 218: if char = '^'
! 219: then get(file,char); -- skip the '^'
! 220: Build_Number(file,char,expo,expo2,ne,ne2,sign);
! 221: d(k) := d(k) + natural(expo);
! 222: while char = ' ' loop get(file,char); end loop;
! 223: if char /= '*' -- the case x^2*...
! 224: then return; -- end of factor
! 225: else get(file,char); -- skip the '*'
! 226: end if;
! 227: elsif char = '*'
! 228: then get(file,char);
! 229: if char = '*'
! 230: then get(file,char); -- the case " x ** expo "
! 231: Build_Number(file,char,expo,expo2,ne,ne2,sign);
! 232: d(k) := d(k) + natural(expo);
! 233: while (char = ' ') loop get(file,char); end loop;
! 234: if char /= '*'
! 235: then return; -- end of factor
! 236: else get(file,char); -- skip the '*'
! 237: end if;
! 238: else d(k) := d(k) + 1; -- the case " x * ? "
! 239: end if;
! 240: else -- the case " x ?", with ? /= '*' or ' ' or '^' :
! 241: d(k) := d(k) + 1;
! 242: return;
! 243: end if;
! 244: while (char = ' ') loop get(file,char); end loop;
! 245: if (char = '-') or (char = '+')
! 246: then return;
! 247: end if;
! 248: if Convert(char) < 10
! 249: then -- the case " x * c " or " x ** c * c " :
! 250: Read_Term(file,char,n,pb);
! 251: else -- the case " x * y " :
! 252: Read_Factor(file,char,n,d,pb);
! 253: end if;
! 254: exception
! 255: when ILLEGAL_CHARACTER => raise ILLEGAL_CHARACTER;
! 256: when ILLEGAL_SYMBOL => raise ILLEGAL_SYMBOL;
! 257: when ILLEGAL_OPERATION => raise ILLEGAL_OPERATION;
! 258: when INFINITE_NUMBER => raise INFINITE_NUMBER;
! 259: when OVERFLOW_OF_UNKNOWNS => raise OVERFLOW_OF_UNKNOWNS;
! 260: when BAD_BRACKET => raise BAD_BRACKET;
! 261: end Read_Factor;
! 262:
! 263: procedure Read_Term ( file : in file_type; char : in out character;
! 264: n : in natural; termp : in out Poly ) is
! 265:
! 266: c : Complex_Number;
! 267: d : Degrees := new Standard_Natural_Vectors.Vector'(1..n => 0);
! 268: pb,res,temp : Poly;
! 269: tmp : Term;
! 270:
! 271: procedure Collect_Factor_Polynomial is
! 272: begin
! 273: if pb /= Null_Poly
! 274: then if res = Null_Poly
! 275: then Copy(pb,res); Clear(pb);
! 276: else Mul(res,pb); Clear(pb);
! 277: end if;
! 278: end if;
! 279: end Collect_Factor_Polynomial;
! 280:
! 281: begin
! 282: Build_Number(file,char,c);
! 283:
! 284: -- look for 'i' :
! 285:
! 286: while (char = ' ') loop get(file,char); end loop;
! 287:
! 288: if ( c = Create(0.0) ) and then (char = 'i')
! 289: then -- the case "+ i" :
! 290: c := Create(0.0,1.0);
! 291: get(file,char); -- skip 'i'
! 292: elsif ( c = Create(-1.0) ) and then (char = 'i')
! 293: then -- the case "- i" :
! 294: c := Create(0.0,-1.0);
! 295: get(file,char); -- skip 'i'
! 296: elsif char = '*'
! 297: then -- the case ".. c *.." :
! 298: while (char = ' ') loop get(file,char); end loop;
! 299: get(file,char); -- skip '*'
! 300: while (char = ' ') loop get(file,char); end loop;
! 301: if char = 'i'
! 302: then -- the case ".. c * i.." :
! 303: c := Create(0.0,REAL_PART(c));
! 304: get(file,char); -- skip 'i'
! 305: else -- the case ".. c * x.." :
! 306: Read_Factor(file,char,n,d,pb);
! 307: if pb /= Null_Poly
! 308: then Clear(res); Copy(pb,res); Clear(pb);
! 309: end if;
! 310: end if;
! 311: else -- the case ".. c ?" :
! 312: -- will be treated in the loop
! 313: null;
! 314: end if;
! 315:
! 316: loop
! 317: case char is
! 318: when ' ' => get(file,char);
! 319: when '*' => get(file,char); Read_Factor(file,char,n,d,pb);
! 320: Collect_Factor_Polynomial;
! 321: when '+' | '-' => if c = Create(0.0)
! 322: then raise ILLEGAL_CHARACTER;
! 323: else exit;
! 324: end if;
! 325: when delimiter => exit;
! 326: when '(' => if c = Create(0.0) or else c = Create(-1.0)
! 327: then -- the case "+ (" or "- (" :
! 328: c := Create(0.0);
! 329: exit;
! 330: else -- the case "c (" :
! 331: raise BAD_BRACKET;
! 332: end if;
! 333: when ')' => exit;
! 334: when others => if c = Create(0.0)
! 335: then c := Create(1.0);
! 336: Read_Factor(file,char,n,d,pb);
! 337: elsif c = Create(-1.0)
! 338: then Read_Factor(file,char,n,d,pb);
! 339: else raise ILLEGAL_CHARACTER;
! 340: end if;
! 341: Collect_Factor_Polynomial;
! 342: end case;
! 343: end loop;
! 344: tmp.cf := c;
! 345: tmp.dg := d;
! 346: termp := create(tmp);
! 347: if Number_Of_Unknowns(res) > 0
! 348: then Mul(termp,res); Clear(res);
! 349: end if;
! 350: exception
! 351: when ILLEGAL_CHARACTER => raise ILLEGAL_CHARACTER;
! 352: when ILLEGAL_SYMBOL => raise ILLEGAL_SYMBOL;
! 353: when ILLEGAL_OPERATION => raise ILLEGAL_OPERATION;
! 354: when INFINITE_NUMBER => raise INFINITE_NUMBER;
! 355: when OVERFLOW_OF_UNKNOWNS => raise OVERFLOW_OF_UNKNOWNS;
! 356: when BAD_BRACKET => raise BAD_BRACKET;
! 357: end Read_Term;
! 358:
! 359: ----------------------------------
! 360: -- THE INPUT OPERATIONS : --
! 361: ----------------------------------
! 362:
! 363: procedure get ( p : in out Poly ) is
! 364: begin
! 365: get(Standard_Input,p);
! 366: exception
! 367: when ILLEGAL_CHARACTER => raise ILLEGAL_CHARACTER;
! 368: when ILLEGAL_SYMBOL => raise ILLEGAL_SYMBOL;
! 369: when ILLEGAL_OPERATION => raise ILLEGAL_OPERATION;
! 370: when INFINITE_NUMBER => raise INFINITE_NUMBER;
! 371: when OVERFLOW_OF_UNKNOWNS => raise OVERFLOW_OF_UNKNOWNS;
! 372: when BAD_BRACKET => raise BAD_BRACKET;
! 373: end get;
! 374:
! 375: procedure get ( file : in file_type; p : in out Poly ) is
! 376:
! 377: n : constant natural := Symbol_Table.Maximal_Size;
! 378: char,oper : character;
! 379: term,res,acc : Poly;
! 380:
! 381: begin
! 382: oper := '+';
! 383: get(file,char);
! 384: while (char = ' ') loop get(file,char); end loop;
! 385: if char = '-'
! 386: then oper := '-';
! 387: end if;
! 388: -- the first term can have no sign
! 389: Read_Term(file,char,n,res); -- therefore read it first
! 390: loop
! 391: case char is
! 392: when ' ' => get(file,char); -- skip blanks
! 393: when '+' | '-' => oper := char;
! 394: Read_Term(file,char,n,term);
! 395: Add(res,term); Clear(term);
! 396: when delimiter => exit;
! 397: when '(' => get(file,term);
! 398: case oper is
! 399: when '+' => Add(acc,res); Clear(res);
! 400: Copy(term,res);
! 401: when '-' => Add(acc,res);Clear(res);
! 402: Copy(term,res); Min(res);
! 403: when '*' => Mul(res,term);
! 404: when others => raise ILLEGAL_OPERATION;
! 405: end case;
! 406: Clear(term);
! 407: get(file,char); -- get new character
! 408: when ')' => exit;
! 409: when '*' => if res = Null_Poly
! 410: then raise ILLEGAL_CHARACTER;
! 411: else -- the case " ) * " :
! 412: oper := char; get(file,char); -- skip '*'
! 413: Read_Term(file,char,n,term);
! 414: if char /= '('
! 415: then case oper is
! 416: when '+' => Add(res,term);
! 417: when '-' => Sub(res,term);
! 418: when '*' => Mul(res,term);
! 419: when others => raise ILLEGAL_OPERATION;
! 420: end case;
! 421: end if;
! 422: Clear(term);
! 423: end if;
! 424: when others => raise ILLEGAL_CHARACTER;
! 425: end case;
! 426: end loop;
! 427: p := acc + res;
! 428: Clear(acc); Clear(res);
! 429: exception
! 430: when ILLEGAL_CHARACTER => raise ILLEGAL_CHARACTER;
! 431: when ILLEGAL_SYMBOL => raise ILLEGAL_SYMBOL;
! 432: when ILLEGAL_OPERATION => raise ILLEGAL_OPERATION;
! 433: when INFINITE_NUMBER => raise INFINITE_NUMBER;
! 434: when OVERFLOW_OF_UNKNOWNS => raise OVERFLOW_OF_UNKNOWNS;
! 435: when BAD_BRACKET => raise BAD_BRACKET;
! 436: end get;
! 437:
! 438: procedure get ( n : in out natural; p : in out Poly ) is
! 439: begin
! 440: get(Standard_Input,n,p);
! 441: exception
! 442: when ILLEGAL_CHARACTER => raise ILLEGAL_CHARACTER;
! 443: when ILLEGAL_SYMBOL => raise ILLEGAL_SYMBOL;
! 444: when ILLEGAL_OPERATION => raise ILLEGAL_OPERATION;
! 445: when INFINITE_NUMBER => raise INFINITE_NUMBER;
! 446: when OVERFLOW_OF_UNKNOWNS => raise OVERFLOW_OF_UNKNOWNS;
! 447: when BAD_BRACKET => raise BAD_BRACKET;
! 448: end get;
! 449:
! 450: procedure get ( file : in file_type; n : in out natural; p : in out Poly ) is
! 451: begin
! 452: get(file,n);
! 453: if Symbol_Table.Empty
! 454: then Symbol_Table.Init(n);
! 455: end if;
! 456: get(file,p);
! 457: exception
! 458: when ILLEGAL_CHARACTER => raise ILLEGAL_CHARACTER;
! 459: when ILLEGAL_SYMBOL => raise ILLEGAL_SYMBOL;
! 460: when ILLEGAL_OPERATION => raise ILLEGAL_OPERATION;
! 461: when INFINITE_NUMBER => raise INFINITE_NUMBER;
! 462: when OVERFLOW_OF_UNKNOWNS => raise OVERFLOW_OF_UNKNOWNS;
! 463: when BAD_BRACKET => raise BAD_BRACKET;
! 464: end get;
! 465:
! 466: -- AUXILIARIES FOR OUTPUT ROUTINES :
! 467:
! 468: function Is_Imag ( c : Complex_Number ) return boolean is
! 469: begin
! 470: return ( REAL_PART(c) = 0.0 );
! 471: end is_imag;
! 472:
! 473: function Is_Real ( c : Complex_Number ) return boolean is
! 474: begin
! 475: return ( IMAG_PART(c) = 0.0 );
! 476: end is_real;
! 477:
! 478: function Is_Integer ( f : double_float ) return boolean is
! 479: begin
! 480: return ( (f - double_float(integer(f))) = 0.0 );
! 481: exception
! 482: when numeric_error => return false;
! 483: end is_integer;
! 484:
! 485: procedure Write_Number ( file : in file_type; i : in integer ) is
! 486:
! 487: -- DESCRIPTION :
! 488: -- writes the integer number with only one blank before it
! 489:
! 490: begin
! 491: for j in 1..8 loop
! 492: if i < integer(10.0**j)
! 493: then line(file,j+1);
! 494: put(file,i,j+1);
! 495: return;
! 496: end if;
! 497: end loop;
! 498: line(file,11); put(file,i);
! 499: end Write_Number;
! 500:
! 501: procedure Write_Number ( file : in file_type; f : in double_float ) is
! 502: begin
! 503: if is_integer(f)
! 504: then Write_Number(file,integer(f));
! 505: else line(file,21); put(file,f);
! 506: end if;
! 507: end Write_Number;
! 508:
! 509: procedure Write_Number ( file : in file_type; c : in Complex_Number ) is
! 510: begin
! 511: if Is_Real(c)
! 512: then Write_Number(file,REAL_PART(c));
! 513: elsif Is_Imag(c)
! 514: then Write_Number(file,IMAG_PART(c));
! 515: line(file,2); put(file,"*i");
! 516: else line(file,1); put(file,"(");
! 517: Write_Number(file,REAL_PART(c));
! 518: if IMAG_PART(c) > 0.0
! 519: then line(file,2); put(file," +");
! 520: else line(file,2); put(file," -");
! 521: end if;
! 522: if IMAG_PART(c) = 1.0
! 523: then line(file,1); put(file,"i");
! 524: elsif IMAG_PART(c) = -1.0
! 525: then line(file,3); put(file," -i");
! 526: else Write_Number(file,abs(IMAG_PART(c)));
! 527: line(file,2); put(file,"*i");
! 528: end if;
! 529: line(file,1); put(file,")");
! 530: end if;
! 531: end Write_Number;
! 532:
! 533: function Length_Factor ( d,i : natural; standard : boolean;
! 534: pow : power ) return natural is
! 535: -- DESCRIPTION :
! 536: -- this procedure computes the number of characters needed
! 537: -- for the output of one factor
! 538:
! 539: l : natural := 0;
! 540: sb : symbol;
! 541:
! 542: begin
! 543: if standard
! 544: then if i < 10
! 545: then l := l + 2;
! 546: else l := l + 3;
! 547: end if;
! 548: else sb := Symbol_Table.get(i);
! 549: if sb(3) /= ' '
! 550: then l := l + 3;
! 551: elsif sb(2) /= ' '
! 552: then l := l + 2;
! 553: else l := l + 1;
! 554: end if;
! 555: end if;
! 556: if d > 1
! 557: then if pow = '^'
! 558: then l := l + 1;
! 559: else l := l + 2;
! 560: end if;
! 561: if d < 10
! 562: then l := l + 1;
! 563: else l := l + 2;
! 564: end if;
! 565: end if;
! 566: return l;
! 567: end Length_Factor;
! 568:
! 569: procedure Write_Factor ( file : in file_type; d,i : in natural;
! 570: standard : in boolean; pow : in power ) is
! 571: -- DESCRIPTION :
! 572: -- Writes the factor corresponding with the ith unknown on file.
! 573:
! 574: sb : Symbol;
! 575:
! 576: begin
! 577: if standard
! 578: then put(file,'x');
! 579: if i<10
! 580: then put(file,i,1);
! 581: else put(file,i,2);
! 582: end if;
! 583: else sb := Symbol_Table.get(i); Symbol_Table_io.put(file,sb);
! 584: end if;
! 585: if d > 1
! 586: then if pow = '^'
! 587: then put(file,'^');
! 588: else put(file,"**");
! 589: end if;
! 590: if d < 10
! 591: then put(file,d,1);
! 592: else put(file,d,2);
! 593: end if;
! 594: end if;
! 595: end Write_Factor;
! 596:
! 597: -- THE OUTPUT OPERATIONS :
! 598:
! 599: procedure put ( p : in Poly; pow : in power ) is
! 600: begin
! 601: put(Standard_Output,p,pow);
! 602: end put;
! 603:
! 604: procedure put ( file : in file_type; p : in Poly; pow : in power ) is
! 605:
! 606: nn : constant natural := Number_of_Unknowns(p);
! 607: standard : constant boolean := ( Symbol_Table.Number < nn );
! 608: first_time : boolean := true;
! 609:
! 610: procedure Write_Term ( t : in Term; continue : out boolean ) is
! 611:
! 612: -- DESCRIPTION :
! 613: -- Writes a term is written on file.
! 614:
! 615: passed : boolean;
! 616:
! 617: begin
! 618: if first_time
! 619: then first_time := false;
! 620: else if (is_real(t.cf) and then REAL_PART(t.cf) > 0.0)
! 621: or else (is_imag(t.cf) and then IMAG_PART(t.cf) > 0.0)
! 622: or else (not is_real(t.cf) and then not is_imag(t.cf))
! 623: then line(file,1); put(file,'+');
! 624: end if;
! 625: end if;
! 626: if Sum(t.dg) = 0
! 627: then Write_Number(file,t.cf);
! 628: else if ( t.cf - Create(-1.0) ) + Create(1.0) = Create(1.0)
! 629: then line(file,1); put(file,'-');
! 630: elsif ( t.cf - Create(0.0,1.0) ) + Create(1.0) = Create(1.0)
! 631: then line(file,2); put(file,"i*");
! 632: elsif ( t.cf - Create(0.0,-1.0) ) + Create(1.0) = Create(1.0)
! 633: then line(file,3); put(file,"-i*");
! 634: elsif (t.cf /= Create(1.0))
! 635: then Write_Number(file,t.cf);
! 636: line(file,1); put(file,'*');
! 637: end if;
! 638: passed := false;
! 639: for i in t.dg'range loop
! 640: if t.dg(i) > 0
! 641: then if passed
! 642: then line(file,1); put(file,'*');
! 643: else passed := true;
! 644: end if;
! 645: Line(file,Length_Factor(t.dg(i),i,standard,pow));
! 646: Write_Factor(file,t.dg(i),i,standard,pow);
! 647: end if;
! 648: end loop;
! 649: end if;
! 650: continue := true;
! 651: end Write_Term;
! 652:
! 653: procedure Write_Terms is new Visiting_Iterator (process => Write_Term);
! 654:
! 655: begin
! 656: init_line;
! 657: Write_Terms(p);
! 658: line(file,1); put(file,delimiter);
! 659: end put;
! 660:
! 661: procedure put ( n : in natural; p : in Poly; pow : in power ) is
! 662: begin
! 663: put(Standard_Output,n,p,pow);
! 664: end put;
! 665:
! 666: procedure put ( file : in file_type; n : in natural;
! 667: p : in Poly; pow : in power ) is
! 668: begin
! 669: put(file,n,1);
! 670: put_line(file," ");
! 671: put(file,p,pow);
! 672: end put;
! 673:
! 674: procedure put ( p : in Poly ) is
! 675: begin
! 676: put(Standard_Output,p,'*');
! 677: end put;
! 678:
! 679: procedure put ( file : in file_type; p : in Poly ) is
! 680: begin
! 681: put(file,p,'*');
! 682: end put;
! 683:
! 684: procedure put ( p : in Poly; dp : in natural ) is
! 685: begin
! 686: put(Standard_Output,p,dp);
! 687: end put;
! 688:
! 689: procedure put ( file : in file_type; p : in Poly; dp : in natural ) is
! 690: begin
! 691: put(file,p);
! 692: end put;
! 693:
! 694: procedure put_line ( file : in file_type; p : in Poly; pow : in power ) is
! 695:
! 696: n : constant natural := Number_of_Unknowns(p);
! 697: standard : constant boolean := ( Symbol_Table.Number < n );
! 698:
! 699: procedure Write_Term ( t : in Term; continue : out boolean ) is
! 700: begin
! 701: new_line(file);
! 702: if Is_Real(t.cf)
! 703: then if REAL_PART(t.cf) >= 0.0
! 704: then put(file,"+");
! 705: end if;
! 706: else put(file,"+");
! 707: end if;
! 708: Init_Line; Write_Number(file,t.cf);
! 709: if Sum(t.dg) /= 0
! 710: then for i in t.dg'range loop
! 711: if t.dg(i) > 0
! 712: then put(file,'*');
! 713: Write_Factor(file,t.dg(i),i,standard,pow);
! 714: end if;
! 715: end loop;
! 716: end if;
! 717: continue := true;
! 718: end Write_Term;
! 719: procedure Write_Terms is new Visiting_Iterator (process => Write_Term);
! 720:
! 721: begin
! 722: Write_Terms(p);
! 723: put_line(file,";");
! 724: end put_line;
! 725:
! 726: procedure put_line ( p : in Poly; pow : in power ) is
! 727: begin
! 728: put_line(Standard_Output,p,pow);
! 729: end put_line;
! 730:
! 731: procedure put_line ( p : in Poly ) is
! 732: begin
! 733: put_line(Standard_Output,p,'*');
! 734: end put_line;
! 735:
! 736: procedure put_line ( file : in file_type; p : in Poly ) is
! 737: begin
! 738: put_line(file,p,'*');
! 739: end put_line;
! 740:
! 741: procedure Display_Format is
! 742:
! 743: s : array(1..24) of string(1..65);
! 744:
! 745: begin
! 746: s( 1):=" A complex multivariate polynomial is denoted as a sequence of";
! 747: s( 2):="terms, separated by `+' and terminated by the semicolon `;'. The";
! 748: s( 3):="brackets '(' and ')' must be used to isolate a sequence of terms";
! 749: s( 4):="as a factor in a complex multivariate polynomial. ";
! 750: s( 5):=" A term can be either a coefficient or a coefficient, followed";
! 751: s( 6):="by '*' and a monomial. If in the latter case the coefficient";
! 752: s( 7):="equals one, then it may be omitted. ";
! 753: s( 8):=" A coefficient may be denoted as an integer, a rational, a";
! 754: s( 9):="floating-point or a complex number. ";
! 755: s(10):=" A monomial is a sequence of powers of unknowns, separated by";
! 756: s(11):="'*'. The power operator is represented by '**' or '^'. It must";
! 757: s(12):="be followed by a positive natural number. If the power equals";
! 758: s(13):="one, then it may be omitted. ";
! 759: s(14):=" An unknown can be denoted by at most 3 characters. The first";
! 760: s(15):="character must be a letter and the other two characters must be";
! 761: s(16):="different from '+', '-', '*', '^', '/', ';', '(' and ')'. The";
! 762: s(17):="letter i means sqrt(-1), whence it does not represent an unknown.";
! 763: s(18):="The number of unknowns may not exceed the declared dimension.";
! 764: s(19):=" Some examples of valid notations of complex multivariate";
! 765: s(20):="polynomials: ";
! 766: s(21):=" x**2*y + 1/2*z*y**2 - 2*z + y**3 + x - 1E9/-8.E-6* y + 3; ";
! 767: s(22):=" x^2*y + z*y^2 - 2*z + y^3 + x - y + 3; ";
! 768: s(23):=" (1.01 + 2.8*i)*x1**2*x2 + x3**2*x1 - 3*x1 + 2*x2*x3 - 3; ";
! 769: s(24):=" (x1^2*x2 + x3^2*x1 - 3*x1 + 2*x2*x3 - 3)*x2**2*(x2-1+i); ";
! 770: for i in s'range loop
! 771: put_line(s(i));
! 772: end loop;
! 773: end Display_Format;
! 774:
! 775: end Standard_Complex_Polynomials_io;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[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