TO EURO ED TIMISOARA

REZOLVARI PROGRAMARE PASCAL ATESTAT 2015

Programare

Subiectul nr. 1

 

     Se citesc n (maxim 30) elemente reale, sa se retina elementele o singura data folosind un  sir ajutator.

 

    PROGRAM BILET1;

    TYPE VECTOR=ARRAY[1..30] OF REAL;

    VAR V,U:VECTOR;

     K, I,J,N:INTEGER;

     OK:BOOLEAN;

     BEGIN

     WRITE('N='); READLN(N);

     FOR I:=1 TO N DO

       BEGIN

         WRITE('V[',I,']=');READLN(V[I]);

       END;

    U[1]:=V[1];  K:=0;

    FOR I:=1 TO N DO

     BEGIN

       OK:=TRUE;

       FOR J:=1 TO I-1 DO

         IF V[J]=V[I] THEN

           OK:=FALSE;

         IF OK THEN

           BEGIN

             K:=K+1;

             U[K]:=V[I];

           END;

      END;

      FOR I:=1 TO K DO

        WRITE(U[I],' ');

        READLN;

     END.

Subiectul nr. 2

 

     Se citeste un sir de numere reale. Sa se inverseze elementele de valoare minima si de valoare maxima,

presupunand ca sunt unice.

Ex: n=4; si elementele (2,-5,7,4) => (2,7,-5,4)

 

    PROGRAM BILET2;

    VAR I,N ,PMIN,PMAX:INTEGER;

    V:ARRAY[1..50] OF REAL;

    AUX, MIN,MAX:REAL;

    BEGIN

     WRITE('N='); READLN(N);

     FOR I:=1 TO N DO

       BEGIN

         WRITE('NUMARUL',I,'='); READLN(V[I]);

       END;

       MIN:=V[1]; MAX:=V[1];

       PMIN:=1; PMAX:=1;

       FOR I:=2 TO N DO

         BEGIN

           IF V[I]<MIN THEN

             BEGIN

              MIN:=V[I];

              PMIN:=I;

            END;

            IF V[I] >MAX THEN

              BEGIN

               MAX:=V[I];

               PMAX:=I;

              END;

          END;

          AUX:=V[PMIN];

          V[PMIN]:=V[PMAX];

          V[PMAX]:=AUX;

          FOR I:=1 TO N DO

            WRITE(V[I]:6:2,' ');

Subiectul nr. 3
 

  Sa se scrie un program care elimina dintr-o matrice data o linie data.

 

PROGRAM _26;

TYPE MAT=ARRAY[1..20,1..20] OF INTEGER;

VAR A:MAT;

    I,J,N,M,P:INTEGER;

PROCEDURE CITIRE;

BEGIN

 WRITE('N='); READLN(N);

 FOR I:=1 TO N DO

   FOR J:=1 TO N DO

     BEGIN

       WRITE('A[',I,',',J,']='); READLN(A[I,J]);

     END;

 END;

 PROCEDURE AFISARE;

 BEGIN

  FOR I:=1 TO N DO

    BEGIN

      FOR J:=1 TO N DO

        WRITE(A[I,J]:4);

        WRITELN;

     END;

 END;

 BEGIN

   CITIRE;

   AFISARE;

   WRITE('LINIA ELIMINATA='); READLN(P);

   FOR I:=P TO N-1 DO

    FOR J:=1 TO N DO

      A[I,J]:=A[I+1,J];

        N:=N-1;

  FOR I:=1 TO N DO

     BEGIN

       FOR J:=1 TO N+1 DO

         WRITE(A[I,J]:4);

         WRITELN;

      END;

   READLN;

END.

 

Subiectul nr. 4

3. Se dă un număr natural nenul care are maxim 9 cifre. Scrieti un program care să afiseze media aritmetică a cifrelor sale.

program _1;

var n,d:longint;

i,s,k:integer;

m:real;

begin

 write('n='); readln(n);

 d:=n;  s:=0; k:=0;

 repeat

 s:=s+d mod 10; k:=k+1;

 d:=d div 10

 until d=0;

 writeln(s/k:7:2);

 readln;

 end.

 

Subiectul nr. 5

   Se citeste un numar intreg n. Sa se transforme numarul din baza 10 in baza 2 retinand cifrele intr-un vector.

{15. SE CITESTE UN NUMAR INTREG N. SA SE TRANSFORME NUMARUL DI BAZA 10

IN BAZA 2 RETINAND CIFRELE INTR-UN VECTOR}

PROGRAM _15;

TYPE VECTOR=ARRAY[1..20] OF INTEGER;

VAR V:VECTOR;

N,K,I,X,D:INTEGER;

BEGIN

 WRITE('DATI NUMARUL:'); READLN(X);

  D:=X; K:=0;

  REPEAT

   K:=K+1;

   V[K]:=D MOD 2;

   D:=D DIV 2;

  UNTIL D=0;

 N:=K;

 FOR I:=N DOWNTO 1 DO

 WRITE(V[I]:4);

 READLN;

END.

 

Subiectul nr. 6

      Se citesc 2 multimi de numere intregi cu cel mult 20 elemente. Să se afiseze reuniunea lor.

{18,19,20. Se citesc doua multimi de numere intregi, cu cel mult 20

 elemente. Sa se afiseze reuniunea, intersectia si diferenta lor}

program _18;

type mul=set of byte;

var a,b:mul;

    i,n:integer;

procedure citire(var m:mul);

var x:byte;

begin

  m:=[];

  writeln('cate elem?'); readln(n);

  writeln('dati elementele');

     for i:=1 to n do

      begin

       read(x);  m:=m+[x];

      end;

end;

procedure afisare(m:mul);

var x:byte;

begin

  for x:=1 to 255 do

    if x in m then

      write(x:4);

    writeln;

end;

begin

 writeln('citim multimea a');

 citire(a);

 writeln('citim multimea b');

 citire(b);

 writeln('multimile a si b sunt:');

 afisare(a); afisare(b);

 writeln('reuniunea:'); afisare(a+b);

 writeln('intersectia'); afisare(a*b);

 writeln('diferenta:'); afisare(a-b);

 readln;

 end.

 

Subiectul nr.7.

Sa se scrie un program care interschimba intr-o matrice data doua coloane date.

 

PROGRAM _31;

TYPE MAT=ARRAY[1..20,1..20] OF INTEGER;

VAR A:MAT;

    I,J,N,M,C1,C2,AUX:INTEGER;

PROCEDURE CITIRE;

BEGIN

 WRITE('N='); READLN(N);

 FOR I:=1 TO N DO

   FOR J:=1 TO N DO

     BEGIN

       WRITE('A[',I,',',J,']='); READLN(A[I,J]);

     END;

 END;

 PROCEDURE AFISARE;

 BEGIN

  FOR I:=1 TO N DO

    BEGIN

      FOR J:=1 TO N DO

        WRITE(A[I,J]:4);

        WRITELN;

     END;

 END;

 BEGIN

   CITIRE;

   AFISARE;

   WRITE('DATI COLOANELELE= '); READLN(C1,C2);

     FOR I:=1 TO N DO

      BEGIN

        AUX:=A[I,C1];

        A[I,C1]:=A[I,C2];

        A[I,C2]:=AUX;

      END;

   AFISARE;

   READLN;

 END.

 

Subiectul nr. 8

 

       Sa se citeasca o matrice patratice de n*n numere intregi . Sa se calculeze elementul maxim de pe diagonala principala.

{ _25 Se genereaza o matrice patratica de n*n numere intregi. Sa se calculeze

elementele maxime de pe diagonala principala si secundara}

PROGRAM _25;

TYPE MAT=ARRAY[1..20,1..20] OF INTEGER;

VAR A:MAT;

    I,J,N,MAXP,MAXS:INTEGER;

PROCEDURE CITIRE;

BEGIN

 WRITE('N='); READLN(N);

 FOR I:=1 TO N DO

   FOR J:=1 TO N DO

     BEGIN

       WRITE('A[',I,',',J,']='); READLN(A[I,J]);

     END;

 END;

 BEGIN

   CITIRE;    MAXP:=A[1,1];  MAXS:=A[1,N];

   FOR I:=1 TO N DO

     FOR J:=1 TO N DO

       IF (I=J) AND ( A[I,J]>MAXP)  THEN

         MAXP:=A[I,J];

        WRITELN('MAXPRINC=',MAXP:5);

 

  FOR I:=1 TO N DO

    FOR J:=1 TO N DO

       IF (J=N-I+1) AND (A[I,J]>MAXS) THEN

       MAXS:=A[I,J];

       WRITELN('MAXSEC=',MAXS:5);

    READLN;

 END.

 

Subiectul nr. 9

 Sa se scrie un program care interschimba intr-o matrice data doua linii date.

 

PROGRAM _30;

TYPE MAT=ARRAY[1..20,1..20] OF INTEGER;

VAR A:MAT;

    I,J,N,M,L1,L2,AUX:INTEGER;

CEDURE CITIRE;

BEGIN

 WRITE('N='); READLN(N);

 FOR I:=1 TO N DO

   FOR J:=1 TO N DO

     BEGIN

       WRITE('A[',I,',',J,']='); READLN(A[I,J]);

     END;

 END;

 PROCEDURE AFISARE;

 BEGIN

  FOR I:=1 TO N DO

    BEGIN

      FOR J:=1 TO N DO

        WRITE(A[I,J]:4);

        WRITELN;

     END;

 END;

 BEGIN

   CITIRE;

   AFISARE;

   WRITE('DATI LINIILE= '); READLN(L1,L2);

     FOR J:=1 TO N DO

      BEGIN

        AUX:=A[L1,J];

        A[L1,J]:=A[L2,J];

        A[L2,J]:=AUX;

      END;

   AFISARE;

   READLN;

 

Subiectul nr. 10

 

      Sa se afiseze toate numerele prime cuprinse in intervalul [a,b], unde a,b sunt numere naturale, a<b.

 Ex:  Pentru a=2, b=11  se afiseaza 2, 3, 5, 7, 11.

program _10;

var k,x,a,b,i:integer;

function test_prim(x:integer):boolean;

var k:integer;

begin

 test_prim:=true;

 for k:=2 to x div 2 do

  if x mod k=0 then test_prim:=false;

end;

 

begin

 write('a='); readln(a);

 write('b='); readln(b);

 for i:=a to b do

  if test_prim(i) then write(i,'  ');

readln;

end.

 

Subiectul nr. 11

3. Se citesc, pe rand, cifrele unui număr natural (cu cel mult 9 cifre). Sa se reconstituie numarul intr-o variabila de tip long.

 

program _2;

var cifra, n, i, nrcifre:integer;

begin

 writeln('dati nr de cifre=');

 readln(nrcifre);

 for i:=1 to nrcifre do

  begin

   writeln('dati cifra='); readln(cifra);

   n:=(n*10)+cifra;

  end;

 writeln('numarul reconstituit=',n:10);

 readln;

 end.

 

 

Subiectul nr. 12

Se citeste un sir de n numere reale. Sa se sorteze crescator, afisandu-se sirul initial, sirul sortat si din nou sirul initial.

 

program _24;

type vector=array[1..20] of real;

var u,v:vector;

min,aux:real;

n,i,j:integer;

begin

 write('n='); readln(n);

 for i:=1 to n do

  begin

   write('v[',i,']='); readln(v[i]);

   u[i]:=v[i];

   end;

   for i:=1 to n do

     write(v[i]:5:2);   writeln;

 for i:=1 to n-1 do

   for j:=i+1 to n do

     if v[j]<v[i] then

      begin

        aux:=v[i];

        v[i]:=v[j];

        v[j]:=aux;

      end;

 for i:=1 to n do

    write(v[i]:5:2);  writeln;

for i:=1 to n do

  write(u[i]:5:2);

readln;

end.

 

Subiectul nr. 13

   Se citesc doua multimi de numere intregi, cu cel mult 20 de elemente, sa se afiseze  intersectia lor.

{18,19,20. Se citesc doua multimi de numere intregi, cu cel mult 20

 elemente. Sa se afiseze reuniunea, intersectia si diferenta lor}

program _18;

type mul=set of byte;

var a,b:mul;

    i,n:integer;

procedure citire(var m:mul);

var x:byte;

begin

  m:=[];

  writeln('cate elem?'); readln(n);

  writeln('dati elementele');

     for i:=1 to n do

      begin

       read(x);  m:=m+[x];

      end;

end;

procedure afisare(m:mul);

var x:byte;

begin

  for x:=1 to 255 do

    if x in m then

      write(x:4);

    writeln;

end;

begin

 writeln('citim multimea a');

 citire(a);

 writeln('citim multimea b');

 citire(b);

 writeln('multimile a si b sunt:');

 afisare(a); afisare(b);

 writeln('reuniunea:'); afisare(a+b);

 writeln('intersectia'); afisare(a*b);

 writeln('diferenta:'); afisare(a-b);

 readln;

 end.

 

Subiectul nr. 14

3. Sa se scrie un program care elimina dintr-o matrice data o coloana data.

 

PROGRAM _26;

TYPE MAT=ARRAY[1..20,1..20] OF INTEGER;

VAR A:MAT;

    I,J,N,M,P:INTEGER;

PROCEDURE CITIRE;

BEGIN

 WRITE('N='); READLN(N);

 FOR I:=1 TO N DO

   FOR J:=1 TO N DO

     BEGIN

       WRITE('A[',I,',',J,']='); READLN(A[I,J]);

     END;

 END;

 PROCEDURE AFISARE;

 BEGIN

  FOR I:=1 TO N DO

    BEGIN

      FOR J:=1 TO N DO

        WRITE(A[I,J]:4);

        WRITELN;

     END;

 END;

 BEGIN

   CITIRE;

   AFISARE;

   WRITE('coloana ELIMINATA='); READLN(P);

   FOR I:=1 TO N DO

    FOR J:=p TO N-1 DO

      A[I,J-1]:=A[I,J];

 

  FOR I:=1 TO N DO

     BEGIN

       FOR J:=1 TO N-1 DO

         WRITE(A[I,J]:4);

         WRITELN;

      END;

   READLN;

END.

 

 

Subiectul nr. 15

   Se citeste o matrice patratica cu n*n elemente. Sa se calculeze elementul maxim de pe diagonala secundara.

PROGRAM _25;

TYPE MAT=ARRAY[1..20,1..20] OF INTEGER;

VAR A:MAT;

    I,J,N,MAXP,MAXS:INTEGER;

PROCEDURE CITIRE;

BEGIN

 WRITE('N='); READLN(N);

 FOR I:=1 TO N DO

   FOR J:=1 TO N DO

     BEGIN

       WRITE('A[',I,',',J,']='); READLN(A[I,J]);

     END;

 END;

 BEGIN

   CITIRE;    MAXP:=A[1,1];  MAXS:=A[1,N];

   FOR I:=1 TO N DO

     FOR J:=1 TO N DO

       IF (I=J) AND ( A[I,J]>MAXP)  THEN

         MAXP:=A[I,J];

        WRITELN('MAXPRINC=',MAXP:5);

 

  FOR I:=1 TO N DO

    FOR J:=1 TO N DO

       IF (J=N-I+1) AND (A[I,J]>MAXS) THEN

       MAXS:=A[I,J];

       WRITELN('MAXSEC=',MAXS:5);

    READLN;

 END.

 

Subiectul nr. 16

 Sa se scrie un program care insereaza intr-o matrice data o linie data cu elemente 0.

 

PROGRAM _28;

TYPE MAT=ARRAY[1..20,1..20] OF INTEGER;

VAR A:MAT;

   K, I,J,N,M,L,AUX:INTEGER;

PROCEDURE CITIRE;

BEGIN

 WRITE('N,M='); READLN(N,M);

 FOR I:=1 TO N DO

   FOR J:=1 TO M DO

     BEGIN

       WRITE('A[',I,',',J,']='); READLN(A[I,J]);

     END;

 END;

 PROCEDURE AFISARE(A:MAT;N,M:INTEGER);

 BEGIN

  FOR I:=1 TO N DO

    BEGIN

      FOR J:=1 TO M DO

        WRITE(A[I,J]:4);

        WRITELN;

     END;

 END;

 BEGIN

   CITIRE;

   AFISARE(A,N,M);

   WRITE('DATI LINIA INSERATA= '); READLN(L);

     FOR I:=N+1 DOWNTO L+1 DO

       BEGIN

         FOR J:=1 TO M DO

           A[I,J]:=A[I-1,J]

       END;

     FOR J:=1 TO M DO

        A[L,J]:=0;

  AFISARE(A,N+1,M);

  READLN;

 END.

 

Subiectul nr. 17

 Se citeste un sir de numere intregi sortate strict crescator si un numar intreg nr. Sa se afle daca numarul citit se afla in sir fara a parcurge tot sirul.

 

PROGRAM _16;

TYPE VECTOR=ARRAY[1..20] OF INTEGER;

VAR X:VECTOR;

N,A,I:INTEGER;

FUNCTION DIV_IMP(P,Q:INTEGER):BOOLEAN;

VAR MIJ:INTEGER;

BEGIN

 IF Q<P THEN

  DIV_IMP:=FALSE

   ELSE

    BEGIN

    MIJ:=(P+Q) DIV 2;

    IF X[MIJ]=A THEN

    DIV_IMP:=TRUE

    ELSE

    IF A<X[MIJ] THEN DIV_IMP:=DIV_IMP(P,MIJ-1)

                ELSE DIV_IMP:=DIV_IMP(MIJ+1,Q);

  END;

  END;

  BEGIN

   WRITE('N='); READLN(N);

   WRITE('X[1]='); READLN(X[1]);

   FOR I:=2 TO N DO

    REPEAT

     WRITE('X[',I,']='); READLN(X[I]);

     UNTIL X[I]>X[I-1];

     WRITE('A='); READLN(A);

     WRITELN(DIV_IMP(1,N));

     READLN;

 END.

 

Subiectul nr. 18

Sa se scrie un program care insereaza intr-o matrice data o coloana data cu elemente 0.

 

PROGRAM _29;

TYPE MAT=ARRAY[1..20,1..20] OF INTEGER;

VAR A:MAT;

    I,J,N,M,C,AUX:INTEGER;

PROCEDURE CITIRE;

BEGIN

 WRITE('N,M='); READLN(N,M);

 FOR I:=1 TO N DO

   FOR J:=1 TO M DO

     BEGIN

       WRITE('A[',I,',',J,']='); READLN(A[I,J]);

     END;

 END;

 PROCEDURE AFISARE(A:MAT;N,M:INTEGER);

 BEGIN

  FOR I:=1 TO N DO

    BEGIN

      FOR J:=1 TO M DO

        WRITE(A[I,J]:4);

        WRITELN;

     END;

 END;

 BEGIN

   CITIRE;

   AFISARE(A,N,M);

   WRITE('DATI COLOANA INSERATA= '); READLN(C);

     FOR I:=1 TO N DO

       BEGIN

         FOR J:=M+1 DOWNTO C+1 DO

           A[I,J]:=A[I,J-1]

       END;

     FOR I:=1 TO N DO

        A[I,C]:=0;

  AFISARE(A,N,M+1);

  READLN;

 END.

 

Subiectul nr. 19

3. Se citeste un numar natural n diferit de zero. Sa se scrie toate tripletele  de numere naturale (a, b, c) pitagoreice (a²+b²=c²) mai mici decat n, nenule.

 

program _6;

var n,i,j,nr:integer;  k:real;

begin

 write('n='); readln(n);

 for i:= 1 to n-1 do

   for j:=i+1 to n do

     begin

       k:=sqrt(i*i+j*j); nr:=trunc(k);

       if (nr*nr=i*i+j*j) and (i<n) and (j<n) and (nr<n) then

       writeln(i:4,' ',j:4,' ',nr:4);

    end;

  readln;

end.

 

Subiectul nr. 20

3. Se citeste un numar natural n. Sa se verifice daca este palindrom.

program _4;

var n:longint;

function oglindit(x:longint):longint;

var d:longint;

 c,inv:longint;

 begin

  d:=x; inv:=0;

  repeat

   c:=d mod 10;

   inv:=inv*10+c;

   d:=d div 10;

  until d=0;

  oglindit:=inv;

end;

begin

write('numarul='); readln(n);

if oglindit(n)=n then writeln('este palindrom')

       else writeln('nu este palindrom');

readln;

end.

 

 

Subiectul nr. 21

      Se citeste un vector cu n componente numere naturale. Sa se afiseze cmmdc al celor n numere.

Ex : pentru n=5 si numerele 36, 42, 120, 54, 66 , se afiseaza cmmdc=6.

{Sa se determine cmmdc si cmmmc al mai multor numere naturale citite

de la tastatura, pana la citirea numarului 0}

program _8;

type vector=array[1..20] of integer;

  var v:vector;

 i,n:integer;

function cmmdc(a,b:integer):integer;

begin

 if a=b then cmmdc:=a

   else

   if a>b then cmmdc:=cmmdc(a-b,b)

          else cmmdc:=cmmdc(a,b-a);

end;

function div_cmmdc(p,q:integer):integer;

var m,d1,d2:integer;

begin

 if abs(p-q)<=1 then div_cmmdc:=cmmdc(v[p],v[q])

   else

    begin

     m:=(p+q) div 2;

     d1:=div_cmmdc(p,m);  d2:=div_cmmdc(m+1,q);

     div_cmmdc:=cmmdc(d1,d2);

    end;

  end;

begin

 write('n='); readln(n);

  for i:=1 to n do

   begin

    write('v[',i,']='); readln(v[i]);

  end;

  writeln('cmmdc=',div_cmmdc(1,n));

  readln;

end.

Subiectul nr. 22
 Se citesc doua multimi de numere intregi, cu cel mult 20 de elemente, sa se afiseze produsul cartezian al lor.

 

PROGRAM _21;

TYPE VECTOR=ARRAY[1..20] OF INTEGER;

VAR ST,NR:VECTOR; N,P:INTEGER;

PROCEDURE INITIALIZARI;

VAR I:INTEGER;

BEGIN

 FOR I:=1 TO 20 DO ST[I]:=0;

 WRITE('N='); READLN(N);

 WRITELN('NUMARUL DE ELEMENTE ALE MULTIMILOR');

   FOR I:=1 TO N DO

     BEGIN

       WRITE('NR[',I,']='); READLN(NR[I]);

     END;

END;

PROCEDURE TIPAR(P:INTEGER);

VAR I:INTEGER;

BEGIN

 FOR I:=1 TO P DO WRITE(ST[I]:4);

 WRITELN;

END;

FUNCTION VALID(P:INTEGER):BOOLEAN;

 BEGIN

  VALID:=TRUE;

 END;

PROCEDURE BKTR(P:INTEGER);

VAR VAL:INTEGER;

 BEGIN

   IF P=N+1 THEN

    TIPAR(P-1)

    ELSE

      FOR VAL:=1 TO NR[P] DO

       BEGIN

        ST[P]:=VAL;

     IF VALID(P) THEN

      BKTR(P+1);

    END;

  END;

BEGIN

  INITIALIZARI;

  BKTR(1);

  READLN;

END.

 

Subiectul nr. 23

   Se citesc doua multimi de numere intregi, cu cel mult 20 de elemente, sa se afiseze diferenta lor.

{18,19,20. Se citesc doua multimi de numere intregi, cu cel mult 20

 elemente. Sa se afiseze reuniunea, intersectia si diferenta lor}

program _18;

type mul=set of byte;

var a,b:mul;

    i,n:integer;

procedure citire(var m:mul);

var x:byte;

begin

  m:=[];

  writeln('cate elem?'); readln(n);

  writeln('dati elementele');

     for i:=1 to n do

      begin

       read(x);  m:=m+[x];

      end;

end;

procedure afisare(m:mul);

var x:byte;

begin

  for x:=1 to 255 do

    if x in m then

      write(x:4);

    writeln;

end;

begin

 writeln('citim multimea a');

 citire(a);

 writeln('citim multimea b');

 citire(b);

 writeln('multimile a si b sunt:');

 afisare(a); afisare(b);

 writeln('reuniunea:'); afisare(a+b);

 writeln('intersectia'); afisare(a*b);

 writeln('diferenta:'); afisare(a-b);

 readln;

 end.

 

Subiectul nr. 24

  Se citeste un numar natural n. Sa se verifice daca este un numar perfect, adica daca este egal cu suma divizorilor sai  afara lui insusi (ex : 6=1+2+3).

program _5;

var n,i,s:integer;

begin

 writeln('n='); readln(n);

 s:=0;

 for i:=1 to n-1 do

  begin

   if n mod i=0 then

   s:=s+i;

  end;

 if s=n then writeln('este perfect')

      else writeln('nu este perfect');

   readln;

end.
 

 

Subiectul nr. 25

Se citesc n numere. Sa se afiseze acele numere a caror suma a cifrelor este egala cu numarul de ordine la citire.

program _3;

var nr, n, s, k, i:integer;

begin

 writeln('dati n='); readln(n);

   for i:=1 to n do

    begin

     writeln('dati numarul'); readln(nr);

     s:=0; k:=nr;

       repeat

        s:=s+(nr mod 10);

        nr:=nr div 10;

      until nr=0;

    if s=i then

      writeln('este numar cautat',k:4);

   end;

 readln;

end.

======================

SORTARI

======================

program bubble_sort;

type vect=array[1..10] of integer;

  var v:vect;

      i,j,n,aux:integer;

begin

writeln('n='); readln(n);

for i:=1 to n do

 begin

  writeln('v[',i,']=');

  readln(v[i]);

 end;

writeln('vectorul initital nesortat este:');

for i:=1 to n do

  write(v[i],' ');

  writeln;

writeln('vectorul sortat prin bubble sort:');

 for j:= n downto 2 do

   for i:=1 to j-1 do

     if v[i]>v[i+1] then

        begin

          aux:=v[i];

          v[i]:=v[i+1];

          v[i+1]:=aux;

        end;

for i:=1 to n do

  write(v[i],' ');

  writeln;

readln;

end.

program greedy_sort;

type vect=array[1..10] of integer;

var v:vect;

  i,j,n,aux:integer;

begin

writeln('n='); readln(n);

for i:=1 to n do

 begin

  writeln('v[',i,']=');

  readln(v[i]);

 end;

writeln('vectorul initital nesortat este:');

for i:=1 to n do

  write(v[i],' ');

  writeln;

writeln('vectorul sortat prin greedy:');

 for i:=1 to n do

   for j:=1 to n-i do

     if v[j]>v[j+1] then

        begin

          aux:=v[j];

          v[j]:=v[j+1];

          v[j+1]:=aux;

        end;

for i:=1 to n do

  write(v[i],' ');

  writeln;

readln;

end.

program sort_insertie;

type vect=array[1..10] of integer;

  var v:vect;

      i,j,n,aux:integer;

begin

writeln('n='); readln(n);

for i:=1 to n do

 begin

  writeln('v[',i,']=');

  readln(v[i]);

 end;

writeln('vectorul initital nesortat este:');

for i:=1 to n do

  write(v[i],' ');

  writeln;

writeln('vectorul sortat prin insertie directa:');

for i:=2 to n do

  begin

   aux:=v[i];

   j:=i-1;

   while ((j>=1) and (v[j]>aux)) do

     begin

       v[j+1]:=v[j];

       j:=j-1;

     end;

   v[j+1]:=aux;

   end;

for i:=1 to n do

  write(v[i],' ');

  writeln;

readln;

end.

 program sort_schimbaredir;

type vect=array[1..10] of integer;

  var v:vect;

      i,j,n,aux,ok:integer;

begin

writeln('n='); readln(n);

for i:=1 to n do

 begin

  writeln('v[',i,']=');

  readln(v[i]);

 end;

writeln('vectorul initital nesortat este:');

for i:=1 to n do

  write(v[i],' ');

  writeln;

writeln('vectorul sortat prin schimbare directa:');

repeat

 ok:=0;

 for i:=1 to n-1 do

   if (v[i]>v[i+1]) then

   begin

    ok:=1;

    aux:=v[i];

    v[i]:=v[i+1];

    v[i+1]:=aux;

   end;

 until (ok=0);

   for i:=1 to n do

  write(v[i],' ');

  writeln;

readln;

end.

program sort_selecte_maxim;

type vect=array[1..10] of integer;

var v:vect;

i,j,n,aux,max,pozm:integer;

begin

writeln('n='); readln(n);

for i:=1 to n do

 begin

  writeln('v[',i,']=');

  readln(v[i]);

 end;

writeln('vectorul initital nesortat este:');

for i:=1 to n do

  write(v[i],' ');

  writeln;

writeln('vectorul sortat prin selectarea elementului maxim:');

 for i:= n downto 2 do

   begin

     max:=v[1];

     pozm:=1;

   for j:=2 to i do

     if (max<v[j]) then

        begin

          max:=v[j];

          pozm:=j;

        end;

    if pozm<>i then

      begin

        aux:=v[i];

        v[i]:=v[pozm];

        v[pozm]:=aux;

      end;

    end;

for i:=1 to n do

  write(v[i],' ');

  writeln;

readln;

end.