[BACK]Return to standard_complex_polynomials_io.adb CVS log [TXT][DIR] Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Polynomials

Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Polynomials/standard_complex_polynomials_io.adb, Revision 1.1.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>