DUzun's Web
Programare, proiecte personale, divertisment

Program P67_30; {Parag. 5}

{--------------------------------------------------------------

    Sa se defineasca un subprogram care va efectua:

     a) adunarea a doua fractii;

     b) inmultirea a doua fractii;

     c) simplificarea unei fractii pana la o fractie ireductibila;

     d) compararea a doua fractii;

 --------------------------------------------------------------}

uses crt;

​

type

     Fractie=record

       nr: integer; {Numaratorul}

       nm: word;    {Numitorul}

     end;

​

var a, b, c: Fractie;

    s: char;

    i: integer;

​

{a)}

Procedure SumF(a,b:Fractie;var c:Fractie);

begin

 if (a.nm=0)or(b.nm=0)then exit;

 with C do begin

   Nm := a.nm*b.nm;

   Nr := a.nr*b.nm + b.nr*a.nm;

 end;

end;

​

{b)}

Procedure ProdF(a,b:Fractie;var c:Fractie);

begin

 if (a.nm=0)or(b.nm=0)then exit;

 with C do begin

   Nr := a.nr*b.nr;

   Nm := a.nm*b.nm;

 end;

end;

​

{c)}

Procedure SimplF(var F:Fractie);

var d: word;

   function DivCom(a,b: Integer): Word;

   var i, m: integer;

   begin

     d := 1;

     if a < b then m := a else m := b;

     for i := m downto 2 do

        if (a mod i=0)and(b mod i=0)and(d mod i<>0)then d:=d*i;

     divcom := d;

   end;

begin

  if (F.nm=0)then exit;

  With F do begin

    d := DivCom(nr,nm);

    nr := nr div d;

    nm := nm div d;

  end;

end;

​

{d)}

Function CompF(a, b: Fractie): integer;

var r1,r2:Real;

begin

 {Transformam in fractii zecimale}

 with a do r1 := Nr/Nm;

 with b do r2 := Nr/Nm;

 {Comparam}

 if r1 < r2 then CompF :=-1 else

 if r1 > r2 then CompF := 1 else

                 CompF := 0;

end;

​

begin

  clrscr;

  Writeln('Scrieti numaratorul si numitorul fractiei A: ');

  with a do readln(Nr, Nm);

  Writeln('Scrieti numaratorul si numitorul fractiei B: ');

  with b do readln(Nr, Nm);

  clrscr;

​

  writeln;

  SumF(a, b, c);

  SimplF(c);

  with c do writeln('a) A + B = ', Nr, ' / ', Nm);

​

  writeln;

  ProdF(a, b, c);

  SimplF(c);

  with c do writeln('b) A * B = ', Nr, ' / ', Nm);

​

  writeln;

  SimplF(a);

  SimplF(b);

  with a do writeln('c) A = ', Nr, ' / ', Nm);

  with b do writeln('   B = ', Nr, ' / ', Nm);

​

  writeln;

  i := CompF(a, b);

  if i < 0 then s := '<' else

  if i > 0 then s := '>' else

                s := '=' ;

  writeln('d) A '+s+' B');

​

  readkey;

end.

​