DUzun's Web
Programare, proiecte personale, divertisment

DUzun it's ME
 
\ 09 aprilie 2025, 06:32:59 \  
Conținut

Ecuatii.pas

x
 
program ecuatie;
(* 
  Rezolva ecuatia  ax + b = c
  a, b, c sunt nr intregi, de cel mult 80 de cifre zecimale
  functia catul este neoptimizata din punct de vedere al timpului
  
  Skema logica:
  [-][<Numar>]<Necunoscuta><Semn><Numar>=[-]<Numar>
  
  <Numar>::={0|1|2|3|4|5|6|7|8|9}
  <Semn>::=+|-
  <Necunoscuta>::=x   
*)
{---------------------------------------------------------------------------}
uses crt;
{---------------------------------------------------------------------------}
type Str = string[80];
{---------------------------------------------------------------------------}
var f: text;
    a,b,c,x: Str;
    s: string;
    i: byte;
{---------------------------------------------------------------------------}
procedure citeste(fn: string);
begin
     assign(f, fn); reset(f); readln(f, s); close(f);
     i:=1;
     {[-]}
     if s[i] = '-' then begin
        a:='-';
        inc(i);
     end else a:='';
     {[<Numar>]}
     if s[i] in ['0'..'9'] then begin
        repeat
           a:=a + s[i];
           inc(i);
        until not (s[i] in ['0'..'9']);
     end else a:=a+'1';
     {<Necunoscuta>}
     inc(i);
     {<Semn>}
     if s[i] = '-' then b:='-'
                   else b:='';
     inc(i);
     {<Numar>}
     while(s[i] in ['0'..'9'])do begin
           b:=b + s[i];
           inc(i);
     end;
     {=}
     inc(i);
     {[-]}
     if s[i] = '-' then begin
        c:='-';
        inc(i);
     end else c:='';
     {<Numar>}
     while(s[i] in ['0'..'9'])do begin
           c:=c + s[i];
           inc(i);
     end;
end;
{---------------------------------------------------------------------------}
procedure invert(var s: Str);
var i, j: byte;
    c: char;
begin
     i:= length(s) div 2;
     while i<>0 do begin
       j:=length(s)-i+1;
       c:=s[i];       s[i]:=s[j];       s[j]:=c;
       dec(i);
     end;
end;
{---------------------------------------------------------------------------}
procedure neg(var s: Str);
begin
    if s[length(s)] = '-' then Delete(s,length(s),1)
    else s:=s+'-';
end;
{---------------------------------------------------------------------------}
{if a>b then true}
function compStr(a,b:Str):boolean;
var i, j:byte;
begin
     i:=length(a);
     j:=length(b);
     if a[i]='-' then dec(i);
     if b[i]='-' then dec(j);
     if i<>j then begin
        compStr:=i>j;
     end else begin
        while(a[i]=b[i])and(i>0)do dec(i);
        compStr := (i<>0) and (a[i]>b[i]);
     end;
end;
{---------------------------------------------------------------------------}
function sum(a,b: Str): Str;
var
    sa, sb: boolean;
    i: byte;
    j: shortint;
    r: Str;
begin
     r  := '';
     sa := (a[length(a)] = '-');
     sb := (b[length(b)] = '-');
     if sa then Delete(a,length(a),1);
     if sb then Delete(b,length(b),1);
     if not(sa xor sb) then begin {Adunarea}
        i:=1; j:=0;
        {Portiunea de lungime comuna}
        while(i<=length(a))and(i<=length(b))do begin
              inc(j, ord(a[i])+ord(b[i])-48-48);
              r := r + chr(j mod 10 + 48 );
              j := j div 10;
              inc(i);
        end;
        {Diferenta de lungime}
        if length(a)>length(b) then begin
           repeat
              inc(j, ord(a[i])-48);
              r := r + chr(j mod 10 + 48 );
              j := j div 10;
              inc(i);
           until i>length(a);
        end else
        {Diferenta de lungime}
        if length(a)<length(b) then begin
           repeat
              inc(j, ord(b[i])-48);
              r := r + chr(j mod 10 + 48 );
              j := j div 10;
              inc(i);
           until i>length(b);
        end;
        if sa then r:=r+'-';
     end else begin  {Scaderea}
         i:=1; j:=0;
         {a - b}
         if length(a)>length(b) then begin
           repeat
              inc(j, ord(a[i]) - ord(b[i]) + 10 );
              r := r + chr(j mod 10 + 48 );
              j := j div 10 - 1;
              inc(i);
           until i>length(b);
           repeat
              inc(j, ord(a[i]) + 10 - 48);
              r := r + chr(j mod 10 + 48 );
              j := j div 10 - 1;
              inc(i);
           until i>length(a);
           if sa then r:=r+'-';
         end else
         {b - a}
         if length(a)<length(b) then begin
           repeat
              inc(j, ord(b[i]) - ord(a[i]) + 10 );
              r := r + chr(j mod 10 + 48 );
              j := j div 10 - 1;
              inc(i);
           until i>length(a);
           repeat
              inc(j, ord(b[i]) + 10 - 48);
              r := r + chr(j mod 10 + 48 );
              j := j div 10 - 1;
              inc(i);
           until i>length(b);
           if sb then r:=r+'-';
        end else
        if a=b then begin
           r:='0';
        end else
        {a - b}
        if compStr(a,b) then begin
           repeat
              inc(j, ord(a[i]) - ord(b[i]) + 10 );
              r := r + chr(j mod 10 + 48 );
              j := j div 10 - 1;
              inc(i);
           until i>length(b);
           if sa then r:=r+'-';
        end else begin {b - a}
           repeat
              inc(j, ord(b[i]) - ord(a[i]) + 10 );
              r := r + chr(j mod 10 + 48 );
              j := j div 10 - 1;
              inc(i);
           until i>length(b);
           if sb then r:=r+'-';
        end;
     end;
     i:=length(r);
     if r[i]='-' then dec(i);
     while r[i]='0' do begin delete(r,i,1); dec(i); end;
     sum:=r;
end;
{---------------------------------------------------------------------------}
procedure incStr(var s:Str);
var b: byte;
begin
 b:=1;
 i:=1;
 s := s + '0';
 repeat
    inc(b, ord(s[i]) - 48);
    s[i] := chr((b mod 10)+48);
    b := b div 10;
    inc(i);
 until b=0;
 if s[length(s)] = '0' then Delete(s,length(s),1);
end;
{---------------------------------------------------------------------------}
function catul(a, b: Str):Str;
var r: Str;
    sa, sb: boolean;
begin
     sa := (a[length(a)] = '-');
     sb := (b[length(b)] = '-');
     if sa then Delete(a,length(a),1);
     if not sb then b:=b+'-';
     r  := '0';
     while (length(a)>=length(b))or(not compStr(b, a)) do begin
           a:=sum(a,b);
           incStr(r);
//      writeln('a: ', a:6);   writeln('b: ', b:6);  writeln('r: ', r:6);   writeln('---------------');
     end;
     if sa xor sb then r := r+'-';
     catul := r;
end;
{---------------------------------------------------------------------------}
function calcX(a,b,c: Str): Str;
var x: Str;
begin
     invert(a);
     invert(b);
     invert(c);
     neg(b);
     x:=catul(sum(c, b), a);
     invert(x);
     calcX := x;
end;
{---------------------------------------------------------------------------}
begin
     clrscr;
     citeste('ecuatii.in');
     assign(f, 'ecuatii.out'); rewrite(f);
     writeln('a: ', a:6);
     writeln('b: ', b:6);
     writeln('c: ', c:6);
     writeln('--------------');
     x := calcX(a,b,c);
     writeln('x: ', x:6);
     writeln(f, x);
     close(f);
//     readkey;
end.
{---------------------------------------------------------------------------}

Aici acumulez programe şi algoritmi interesanti alcătuiţi de mine (cu mici excepţii) pe parcursul studierii unor limbaje de programare.

Cea mai mare parte din ele sunt realizate în Pascal. 

Nu am scopul creării unui curs specializat sau a descrierii detaliate a anumitor limbaje, ci doar prezint informaţii utile, plus ceva exemple interesante...

 

Răsfoitorul de fișiere (File Browser):

Codul sursă al programelor este organizat în mape şi fişiere.

Paginile care conțin cod sursă de programe de regulă au un răsfoitor de fișiere în partea stangă a paginii reprezentat de un bloc cu titlul „File Browser”.

Pentru a vizualiza un program sau conţinutul unei mape, faceţi click pe numele fişierului / mapei. Dacă fişierul nu este textual, el se va descărca automat, iar dacă este textual, conținutul lui se va afișa într-un bloc pe centrul paginii.

Pentru a descărca un fişier, faceţi click pe dimensiunea (size) lui.

arr_d Limba / Language


 


arr_r Login
 
 
Loading...