program cn1;

uses crt;

var n:longint;

begin

clrscr; 48589zux77ioc8r

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

write('Cifrele numarului in ordine inversa sunt ');

while n<>0 do begin

write(n mod 10,' '); uo589z8477iooc

n:=n div 10

end;

readln;

end.

program cn2;

uses crt;

var n:longint;

s,k:integer;

begin

clrscr; 48589zux77ioc8r

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

s:=0;

k:=0;

while n<>0 do begin

k:=k+1;

s:=s+n mod 10;

n:=n div 10

end;

writeln('Numarul are ',k,' cifre');

writeln('Suma cifrelor numarului este ',s);

readln;

end.

program np1;

uses crt;

var n,i:integer;

begin

clrscr; 48589zux77ioc8r

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

write('Divizorii sunt ');

for i:=1 to n do if n mod i=0 then write(i,' ');

readln;

end.

program np2;

uses crt;

var n,i:integer;

prim:boolean;

begin

clrscr; 48589zux77ioc8r

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

prim:=true;

for i:=2 to round(sqrt(n)) do if n mod i=0 then prim:=false;

if prim then write('Nr este prim')

else write('Nr nu este prim');

readln;

end.

program np3;

uses crt;

var n,k,i:integer;

prim:boolean;

begin

clrscr; 48589zux77ioc8r

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

write('Numerele prime mai mici decat ',n,' sunt ');

for k:=2 to n-1 do

begin

prim:=true;

for i:=2 to round(sqrt(k)) do if k mod i=0 then prim:=false;

if prim then write(k,' ')

end;

readln;

end.

program np4;

uses crt;

var n,i:integer;

begin

clrscr; 48589zux77ioc8r

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

write('Factorii primi sunt ');

i:=1;

while n<>1 do begin

i:=i+1;

while n mod i=0 do begin

write(i,' ');

n:=n div i

end

end;

readln;

end.

program as1;

uses crt;

var n,p,i:integer;

begin

clrscr; 48589zux77ioc8r

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

p:=1;

for i:=2 to n do p:=p*i;

write(n,'! este ',p);

readln;

end.

program as2;

uses crt;

var n,s,i:integer;

begin

clrscr; 48589zux77ioc8r

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

s:=0;

for i:=1 to n do s:=s+i;

write('Suma este ',s);

readln;

end.

program as3;

uses crt;

var n,s,i:integer;

begin

clrscr; 48589zux77ioc8r

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

s:=0;

for i:=1 to n do s:=s+i*i;

write('Suma este ',s);

readln;

end.

program as4;

uses crt;

var n,s,p,i,j:integer;

begin

clrscr; 48589zux77ioc8r

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

s:=0;

for i:=1 to n do begin

p:=1;

for j:=2 to i do p:=p*j;

s:=s+p

end;

write('Suma este ',s);

readln;

end.

program as5;

uses crt;

var x,n,p,i:integer;

begin

clrscr; 48589zux77ioc8r

write('x=');readln(x);

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

p:=1;

for i:=1 to n do p:=p*x;

write('Rezultatul este ',p);

readln;

end.

program as6;

uses crt;

var a,b,aux:integer;

begin

clrscr; 48589zux77ioc8r

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

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

aux:=a;

a:=b;

b:=aux;

writeln('a=',a);

writeln('b=',b);

readln;

end.

program as7;

uses crt;

var a,b,c,max,min:integer;

begin

clrscr; 48589zux77ioc8r

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

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

write('c=');readln(c);

if a>b then max:=a

else max:=b;

if max<c then max:=c;

if a<b then min:=a

else min:=b;

if min>c then min:=c;

write('Rezultatul expresiei este ',max-min);

readln;

end.

program as8;

uses crt;

var a,b,c,d:integer;

x1,x2:real;

begin

clrscr; 48589zux77ioc8r

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

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

write('c=');readln(c);

if a=0 then write('Ecuatia nu este de grad 2')

else

begin

d:=b*b-4*a*c;

if d<0 then write('Ecuatia are radacini complexe')

else begin

x1:=-1*b/(2*a)+sqrt(d)/(2*a);

x2:=-1*b/(2*a)-sqrt(d)/(2*a);

writeln('x1=',x1:3:1);

writeln('x2=',x2:3:1)

end

end;

readln;

end.

program as9;

uses crt;

var a,b,r:integer;

begin

clrscr; 48589zux77ioc8r

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

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

while a mod b<>0 do begin

r:=a mod b;

a:=b;

b:=r

end;

write('Cmmdc este ',b);

readln;

end.

program as10;

uses crt;

var n,a,b,c:integer;

begin

clrscr; 48589zux77ioc8r

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

a:=0;

b:=1;

write('Primele ',n,' numere din sirul lui fibonacci sunt ');

write(a,' ',b,' ');

n:=n-2;

while n>0 do begin

c:=a+b;

write(c,' ');

n:=n-1;

a:=b;

b:=c

end;

readln;

end.

program t1;

uses crt;

var a:array[1..20] of integer;

n,min,max,i:integer;

begin

clrscr; 48589zux77ioc8r

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

write('Introduceti sirul ');

for i:=1 to n do read(a[i]);

min:=a[1];

for i:=2 to n do if a[i]<min then min:=a[i];

max:=a[1];

for i:=2 to n do if a[i]>max then max:=a[i];

writeln('Minimul sirului este ',min);

writeln('Maximul sirului este ',max);

readln;readln;

end.

program t2;

uses crt;

var a:array[1..20] of integer;

n,v,poz,i:integer;

begin

clrscr; 48589zux77ioc8r

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

write('Sirul...');

for i:=1 to n do read(a[i]);

write('Valoarea cautata=');readln(v);

poz:=0;

for i:=1 to n do if a[i]=v then poz:=i;

if poz=0 then write('Valoarea nu este in sir')

else write('Valoarea se gaseste pe pozitia ',poz);

readln;

end.

program t3;

uses crt;

var a:array[1..20] of integer;

n,i,aux:integer;

begin

clrscr; 48589zux77ioc8r

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

write('Sirul...');

for i:=1 to n do read(a[i]);

for i:=1 to n div 2 do begin

aux:=a[i];

a[i]:=a[n-i+1];

a[n-i+1]:=aux

end;

write('Sirul inversat este ');

for i:=1 to n do write(a[i],' ');

readln;

readln;

end.

program t4;

uses crt;

var a:array[1..20] of integer;

n,s,k,i:integer;

begin

clrscr; 48589zux77ioc8r

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

write('Sirul...');

for i:=1 to n do read(a[i]);

s:=0;

k:=0;

for i:=1 to n do if a[i] mod 2=0 then begin

s:=s+a[i];

k:=k+1

end;

writeln('Media aritmetica a numerelor pare este ',s/k:4:2);

s:=0;

k:=0;

for i:=1 to n do if a[i] mod 2<>0 then begin

s:=s+a[i];

k:=k+1

end;

writeln('Media aritmetica a numerelor impare este ',s/k:4:2);

readln;readln;

end.

program t5;

uses crt;

var a:array[1..20] of integer;

n,i,aux:integer;

ordonat:boolean;

begin

clrscr; 48589zux77ioc8r

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

write('Sirul...');

for i:=1 to n do read(a[i]);

ordonat:=false;

while ordonat=false do begin

ordonat:=true;

for i:=1 to n-1 do if a[i]>a[i+1] then

begin

aux:=a[i];

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

a[i+1]:=aux;

ordonat:=false

end;

end;

write('Sirul ordonat este ');

for i:=1 to n do write(a[i],' ');

readln;

end.

program t6;

uses crt;

var a,b,c:array[1..20] of integer;

n,m,i,j,k:integer;

begin

clrscr; 48589zux77ioc8r

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

write('Primul sir=');

for i:=1 to n do read(a[i]);

write('m=');readln(m);

write('Al doilea sir=');

for j:=1 to m do read(b[j]);

i:=1;

j:=1;

k:=0;

while (i<=n) and (j<=m) do

begin

k:=k+1;

if a[i]<b[j] then begin

c[k]:=a[i];

i:=i+1

end

else begin

c[k]:=b[j];

j:=j+1

end

end;

if i>n then for i:=j to m do begin

k:=k+1;

c[k]:=b[i]

end

else for j:=i to n do begin

k:=k+1;

c[k]:=a[j]

end;

write('Sirul rezultat este ');

for i:=1 to k{m+n} do write(c[i],' ');

readln;readln;

end.

program t7;

uses crt;

var a:array[1..20] of integer;

n,v,m,i,j,poz:integer;

gasit:boolean;

begin

clrscr; 48589zux77ioc8r

write('Dimensiunea sirului ordonat crescator...');readln(n);

write('Sirul...');

for i:=1 to n do read(a[i]);

write('Valoarea cautata...');readln(v);

i:=1;

j:=n;

gasit:=false;

poz:=0;

while (i<=j) and (gasit=false) do

begin

m:=(i+j) div 2;

if a[m]=v then begin

gasit:=true;

poz:=m

end

else if a[m]>v then j:=m-1

else i:=m+1

end;

if gasit=false then writeln('Valoarea ',v,' nu se gaseste in sir')

else writeln('Se gaseste pe pozitia ',poz);

readln;

end.

{cautare binara recursiv}

program t7;

uses crt;

var a:array[1..20] of integer;

n,i,v:integer;

function cautare(i,j:integer):integer;

var m:integer;

begin

if i<=j then begin

m:=(i+j) div 2;

if a[m]=v then cautare:=m

else if a[m]>v then cautare:=cautare(i,m-1)

else cautare:=cautare(m+1,j)

end

else cautare:=0

end;

begin

clrscr; 48589zux77ioc8r

write('Dimensiunea sirului ordonat crescator...');readln(n);

write('Sirul...');

for i:=1 to n do read(a[i]);

write('Valoarea cautata...');readln(v);

if cautare(1,n)=0 then writeln('Valoarea ',v,' nu exista in sir')

else writeln('Valoarea ',v,' se gaseste pe poz ',cautare(1,n));

readln;

end.

program t8;

uses crt;

var n,ni,aux:integer;

begin

clrscr; 48589zux77ioc8r

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

ni:=0;

aux:=n;

while n<>0 do begin

ni:=ni*10+n mod 10;

n:=n div 10

end;

n:=aux;

if n=ni then write('Numarul este palindrom')

else write('Numarul nu este palindrom');

readln;

end.

program t9;

uses crt;

var a:array[1..10,1..10] of integer;

n,m,min,max,i,j:integer;

begin

clrscr; 48589zux77ioc8r

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

write('m=');readln(m);

writeln('Introduceti matricea');

for i:=1 to n do

for j:=1 to m do read(a[i,j]);

min:=a[1,1];

for i:=1 to n do

for j:=1 to m do if a[i,j]<min then min:=a[i,j];

max:=a[1,1];

for i:=1 to n do

for j:=1 to m do if a[i,j]>max then max:=a[i,j];

writeln('Minimul matricei este ',min);

writeln('Maximul matricei este ',max);

readln;readln;

end.

program t10;

uses crt;

var a:array[1..10,1..10] of integer;

n,s,p,i,j:integer;

begin

clrscr; 48589zux77ioc8r

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

writeln('Matricea...');

for i:=1 to n do

for j:=1 to n do read(a[i,j]);

s:=0;

for i:=1 to n do s:=s+a[i,i];

writeln('Suma elementelor de pe diagonala principala este ',s);

p:=1;

for i:=1 to n do p:=p*a[i,n-i+1];

writeln('Produsul elementelor de pe diagonala secundara este ',p);

s:=0;

for i:=1 to n do s:=s+a[1,i]+a[n,i];

for i:=2 to n-1 do s:=s+a[i,1]+a[i,n];

writeln('Suma elementelor de pe margine este ',s);

readln;readln;

end.

program t11;

uses crt;

var a:array[1..10,1..10] of integer;

n,i,j:integer;

simetric:boolean;

begin

clrscr; 48589zux77ioc8r

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

writeln('Matricea...');

for i:=1 to n do

for j:=1 to n do read(a[i,j]);

simetric:=true;

for i:=1 to n do

for j:=1 to n do if a[i,j]<>a[j,i] then simetric:=false;

if simetric=true then write('Matricea e simetrica')

else write('Matricea nu e simetrica');

readln;readln;

end.

program t12;

uses crt;

var a:array[1..10,1..10] of integer;

n,m,i,j,k,nr:integer;

begin

clrscr; 48589zux77ioc8r

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

write('m=');readln(m);

writeln('Matricea...');

for i:=1 to n do

for j:=1 to m do read(a[i,j]);

write('k=');readln(k);

writeln('Liniile care contin ',k,' elemente de 0 sunt:');

for i:=1 to n do begin

nr:=0;

for j:=1 to m do if a[i,j]=0 then nr:=nr+1;

if nr=k then begin

for j:=1 to m do write(a[i,j],' ');

writeln

end

end;

readln;

end.

program t13;

uses crt;

var a:array[1..10,1..10] of integer;

n,m,s,max,poz,i,j:integer;

begin

clrscr; 48589zux77ioc8r

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

write('m=');readln(m);

writeln('Matricea...');

for i:=1 to n do

for j:=1 to m do read(a[i,j]);

for j:=1 to m do begin

s:=a[1,j];

max:=a[1,j];

poz:=1;

for i:=2 to n do begin

s:=s+a[i,j];

if a[i,j]>max then begin

max:=a[i,j];

poz:=i

end

end;

a[poz,j]:=s

end;

writeln('Matricea rezultata');

for i:=1 to n do begin

for j:=1 to m do write(a[i,j],' ');

writeln

end;

readln;readln;

end.

program t14;

uses crt;

var a:array[1..10,1..10] of integer;

n,m,i,j:integer;

palindrom:boolean;

begin

clrscr; 48589zux77ioc8r

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

write('m=');readln(m);

writeln('Matricea...');

for i:=1 to n do

for j:=1 to m do read(a[i,j]);

writeln('Liniile matricei cu caracter de palindrom sunt ');

for i:=1 to n do begin

palindrom:=true;

for j:=1 to m div 2 do

if a[i,j]<>a[i,m-j+1] then palindrom:=false;

if palindrom=true then

begin

for j:=1 to m do write(a[i,j],' ');

writeln

end

end;

readln;readln;

end.

program t15;

uses crt;

var a,b,c:array[1..10,1..10] of integer;

n,m,p,s,i,j,k:integer;

begin

clrscr; 48589zux77ioc8r

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

write('m=');readln(m);

write('p=');readln(p);

writeln('Prima matrice...');

for i:=1 to n do

for j:=1 to m do read(a[i,j]);

writeln('A doua matrice');

for i:=1 to m do

for j:=1 to p do read(b[i,j]);

for i:=1 to n do

for j:=1 to p do begin

s:=0;

for k:=1 to m do s:=s+a[i,k]*b[k,j];

c[i,j]:=s

end;

writeln('Produsul celor doua matrici este ');

for i:=1 to n do begin

for j:=1 to p do write(c[i,j]:2,' ');

writeln

end;

readln;readln;

end.

program sc1;

uses crt;

var s:string;

begin

clrscr; 48589zux77ioc8r

write('Introduceti un cuvant ');

readln(s);

write('Cuvantul ',s,' contine ',length(s),' caractere');

readln;

end.

program sc2;

uses crt;

var s:string;

i,k:integer;

begin

clrscr; 48589zux77ioc8r

writeln('Introduceti o linie de text');

readln(s);

k:=0;

for i:=1 to length(s) do if s[i]=' ' then k:=k+1;

writeln('Linia de text contine ',k+1,' cuvinte');

readln;

end.

program sc3;

uses crt;

var s:string;

v,c,i:integer;

begin

clrscr; 48589zux77ioc8r

writeln('Introduceti o linie de text ');

readln(s);

for i:=1 to length(s) do

if s[i]<>' ' then case s[i] of

'a','e','i','o','u','a':v:=v+1;

else c:=c+1

end;

writeln('Linia de text contine ',v,' vocale');

writeln('Linia de text contine ',c,' consoane');

readln;

end.

program sc4;

uses crt;

var l,s:string;

i:integer;

begin

clrscr; 48589zux77ioc8r

writeln('Introduceti o linie de text');

readln(l);

s:='';

for i:=1 to length(l) do if l[i]<>' ' then s:=s+upcase(l[i]);

writeln('Sirul rezultat este ',s);

readln;

end.

program sc5;

uses crt;

var a:array[1..20] of string;

aux:string;

n,i,j:integer;

begin

clrscr; 48589zux77ioc8r

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

for i:=1 to n do begin

write('cuvant',i,'=');

readln(a[i])

end;

for i:=1 to n do

for j:=i+1 to n do if a[i]>a[j] then begin

aux:=a[i];

a[i]:=a[j];

a[j]:=aux

end;

writeln('Cuvintele ordonate crescator:');

for i:=1 to n do write(a[i],' ');

readln;

end.

program inr1;

uses crt;

type art=record nume:string;

nr_loc:longint;

end;

var a:array[1..20] of art;

n,i:integer;

begin

clrscr; 48589zux77ioc8r

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

for i:=1 to n do begin write('nume',i,'=');readln(a[i].nume);

write('nr_loc=');readln(a[i].nr_loc)

end;

writeln('Toate orasele care au peste 100000 locuitori sunt:');

for i:=1 to n do if a[i].nr_loc>=100000 then writeln(a[i].nume);

readln;

end.

program inr2;

uses crt;

var a:array[1..20] of record titlu:string;

autor:string;

an_aparitie:1..2001;

end;

n,i:integer;

begin

clrscr; 48589zux77ioc8r

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

for i:=1 to n do begin write('Titlul',i,'=');readln(a[i].titlu);

write('Autor=');readln(a[i].autor);

write('An aparitie');readln(a[i].an_aparitie)

end;

writeln('Cartile tiparite dupa 1980 sunt:');

for i:=1 to n do if a[i].an_aparitie>=1980 then writeln(a[i].titlu);

readln;

end.

program inr3;

uses crt;

type art=record nume:string;

punctaj:integer

end;

var a:array[1..20] of art;

num:string;

n,max,i:integer;

begin

clrscr; 48589zux77ioc8r

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

for i:=1 to n do begin

write('nume',i,'=');readln(a[i].nume);

write('punctaj',i,'=');readln(a[i].punctaj)

end;

max:=a[1].punctaj;

num:=a[1].nume;

for i:=2 to n do if a[i].punctaj>max then begin

max:=a[i].punctaj;

num:=a[i].nume

end;

writeln('Concurentul ',num,' a obtinut punctaj maxim ',max);

readln;

end.

program inr4;

uses crt;

var a:array[1..20] of record nume:string;

nota1:1..10;

nota2:1..10;

end;

n,i:integer;

begin

clrscr; 48589zux77ioc8r

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

for i:=1 to n do begin

write('Nume=');readln(a[i].nume);

write('Nota1=');readln(a[i].nota1);

write('Nota2=');readln(a[i].nota2)

end;

writeln('Elevii admisi sunt');

for i:=1 to n do

if (a[i].nota1>=5) and (a[i].nota2>=5) then writeln(a[i].nume);

Writeln('Elevi respinsi sunt');

for i:=1 to n do

if (a[i].nota1<5) or (a[i].nota2<5) then writeln(a[i].nume);

readln;

end.

program inr5;

uses crt;

var a,b:record preala:integer;

pimag:integer;

end;

pr,pi:integer;

begin

clrscr; 48589zux77ioc8r

write('Partea reala din primul numar ');readln(a.preala);

write('Partea imaginara din primul numar ');readln(a.pimag);

write('Partea reala din cel de-al doilea numar ');readln(b.preala);

write('Partea imaginara din cel de-al doilea numar');readln(b.pimag);

pr:=a.preala+b.preala;

pi:=a.pimag+b.pimag;

writeln('Suma celor doua numere este ',pr,'+',pi,'i');

pr:=a.preala-b.preala;

pi:=a.pimag-b.pimag;

writeln('Diferenta celor doua numere este ',pr,'+',pi,'i');

readln;

end.

program m1;

uses crt;

var a,b,c:set of 1..10;

e:1..10;

n,i:integer;

begin

clrscr; 48589zux77ioc8r

write('Nr de elem din 1 multime');readln(n);

write('Elementele:');

a:=[];

for i:=1 to n do begin read(e);

a:=a+[e]

end;

write('Nr de elem din 2 multime');readln(n);

write('Elementele:');

b:=[];

for i:=1 to n do begin read(e);

b:=b+[e]

end;

c:=a+b;

write('Reuniunea= ');

for i:=1 to 10 do if i in c then write(i,' ');

writeln;

c:=a*b;

write('Intersectia= ');

for i:=1 to 10 do if i in c then write(i,' ');

writeln;

c:=a-b;

write('Diferenta a-b= ');

for i:=1 to 10 do if i in c then write(i,' ');

writeln;

if a<=b then writeln('a inclusa in b')

else writeln('a nu este inclusa in b');

readln;

end.

program m2;

uses crt;

var a:set of 1..100;

e,max:1..100;

n,i:integer;

begin

clrscr; 48589zux77ioc8r

write('Nr de elemente din multime=');readln(n);

a:=[];

write('Elementele=');

for i:=1 to n do begin

read(e);

a:=a+[e]

end;

for i:=1 to 100 do if i in a then max:=i;

write('Elementul maxim din multime este ',max);

readln;readln;

end.

program m3;

uses crt;

var a:array[1..30] of 0..255;

m:set of 0..255;

n,i,k:integer;

begin

clrscr; 48589zux77ioc8r

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

write('Sirul=');

for i:=1 to n do read(a[i]);

m:=[];

for i:=1 to n do m:=m+[a[i]];

k:=0;

for i:=0 to 255 do if i in m then k:=k+1;

if n=k then writeln('Toate elementele din sir sunt distincte')

else writeln('Nu sunt distincte');

readln;readln;

end.

program m4;

uses crt;

var a:set of char;

s:string;

n,i:integer;

c:char;

begin

clrscr; 48589zux77ioc8r

write('Introduceti cuvantul ');readln(s);

n:=length(s);

a:=[];

for i:=1 to n do a:=a+[s[i]];

write('Literele distincte din cuvant sunt ');

for c:='a' to 'z' do if c in a then write(c,' ');

readln;

end.

program s1;

uses crt;

var n,k:word;

function fact(n:word):word;

var p,i:word;

begin

p:=1;

for i:=2 to n do p:=p*i;

fact:=p

end;

begin

clrscr; 48589zux77ioc8r

repeat

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

write('k=');readln(k);

until k<=n;

write('Comb din ',n,' luate cate ',k,' =',fact(n)/(fact(n-k)*fact(k)):2:0);

readln;

end.

program s2;

uses crt;

var n,i:byte;

s:longint;

function fact(k:word):word;

var p,i:word;

begin

p:=1;

for i:=1 to k do p:=p*i;

fact:=p

end;

begin

clrscr; 48589zux77ioc8r

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

s:=0;

for i:=1 to n do s:=s+fact(i);

write('Suma este ',s);

readln;

end.

program s3;

uses crt;

var x,n:word;

function putere(x,n:word):longint;

var p,i:integer;

begin

p:=1;

for i:=1 to n do p:=p*x;

putere:=p;

end;

begin

clrscr; 48589zux77ioc8r

write('x=');readln(x);

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

write('Rezultatul este ',putere(x,n));

readln;

end.

program s4;

uses crt;

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

var a:sir;

n,i:integer;

function minim(a:sir;n:integer):integer;

var min,i:integer;

begin

min:=a[1];

for i:=2 to n do if a[i]<min then min:=a[i];

minim:=min;

end;

begin

clrscr; 48589zux77ioc8r

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

write('Sirul...');

for i:=1 to n do read(a[i]);

write('Minimul sirului este ',minim(a,n));

readln;readln;

end.

program s5;

uses crt;

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

var a:sir;

n,i:integer;

function suma(a:sir;n:integer):integer;

var s,i:integer;

begin

s:=0;

for i:=1 to n do s:=s+a[i];

suma:=s;

end;

begin

clrscr; 48589zux77ioc8r

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

write('Sirul...');

for i:=1 to n do read(a[i]);

write('Suma elem sirului este ',suma(a,n));

readln;readln;

end.

program s6;

uses crt;

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

var a:sir;

n,i,v:integer;

function gasit(a:sir;n,v:integer):boolean;

var b:boolean;

i:integer;

begin

b:=false;

for i:=1 to n do if a[i]=v then b:=true;

gasit:=b;

end;

begin

clrscr; 48589zux77ioc8r

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

write('Sirul...');

for i:=1 to n do read(a[i]);

write('Valoarea cautata...');readln(v);

if gasit(a,n,v) then write('Exista in sir')

else write('Nu exista in sir');

readln;

end.

program s7;

uses crt;

var n:integer;

function suma(n:integer):integer;

var s:integer;

begin

s:=0;

while n<>0 do begin

s:=s+n mod 10;

n:=n div 10

end;

suma:=s

end;

begin

clrscr; 48589zux77ioc8r

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

write('Suma cifrelor este ',suma(n));

readln;

end.

program s8;

uses crt;

var n,k:integer;

function cifra(n,k:integer):integer;

var i:integer;

begin

for i:=1 to k-1 do n:=n div 10;

cifra:=n mod 10

end;

begin

clrscr; 48589zux77ioc8r

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

write('Rang=');readln(k);

write('Cifra este ',cifra(n,k));

readln;

end.

program s9;

uses crt;

var a,b:integer;

function cmmdc(x,y:integer):integer;

begin

while x<>y do if x>y then x:=x-y

else y:=y-x;

cmmdc:=x

end;

function cmmmc(x,y:integer):integer;

var p:integer;

begin

p:=x*y;

while x<>y do if x>y then x:=x-y

else y:=y-x;

cmmmc:=p div x

end;

begin

clrscr; 48589zux77ioc8r

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

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

writeln('cmmdc=',cmmdc(a,b));

writeln('cmmmc=',cmmmc(a,b));

readln;

end.

program s10;

uses crt;

type multime=set of 1..10;

var a:multime;

e:1..10;

i,n:byte;

procedure tipareste(a:multime);

var i:byte;

begin

for i:=1 to 10 do if i in a then write(i,' ');

end;

begin

clrscr; 48589zux77ioc8r

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

write('elementele...');

a:=[];

for i:=1 to n do begin

read(e);

a:=a+[e]

end;

tipareste(a);

readln;readln;

end.

program s11;

uses crt;

var a,b,s:array[1..20,1..20] of integer;

n,m,i,j:integer;

procedure suma;

var i,j:integer;

begin

for i:=1 to n do

for j:=1 to m do s[i,j]:=a[i,j]+b[i,j];

end;

begin

clrscr; 48589zux77ioc8r

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

write('m=');readln(m);

writeln('Prima matrice');

for i:=1 to n do

for j:=1 to m do read(a[i,j]);

writeln('A doua matrice');

for i:=1 to n do

for j:=1 to m do read(b[i,j]);

suma;

writeln('Suma celor 2 matrici este');

for i:=1 to n do begin

for j:=1 to m do write(s[i,j]:3);

writeln

end;

readln;readln;

end.

program f1;

var f,g:text;

c:char;

begin

assign(f,'sursa.txt');

assign(g,'dest.txt');

reset(f);

rewrite(g);

while not(eof(f)) do begin

read(f,c);

write(g,c)

end;

close(f);

close(g);

end.

program f2;

var f,g:text;

a:array[1..20] of integer;

n,i,aux:integer;

ordonat:boolean;

begin

assign(f,'in.txt');

assign(g,'out.txt');

reset(f);

rewrite(g);

i:=0;

while not(eof(f)) do begin

i:=i+1;

read(f,a[i])

end;

n:=i;

ordonat:=false;

while ordonat=false do

begin

ordonat:=true;

for i:=1 to n-1 do if a[i]>a[i+1] then begin

aux:=a[i];

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

a[i+1]:=aux;

ordonat:=false

end

end;

for i:=1 to n do write(g,a[i],' ');

close(f);

close(g);

end.

program f3;

var f,g:text;

a:array[1..10,1..10] of integer;

n,s,i,j:integer;

begin

assign(f,'in.txt');

assign(g,'out.txt');

reset(f);

rewrite(g);

readln(f,n);

for i:=1 to n do

for j:=1 to n do read(f,a[i,j]);

s:=0;

for i:=1 to n do s:=s+a[i,i];

write(g,s);

close(f);

close(g);

end.

program f4;

var f:text;

a,b,c:array[1..20] of integer;

n,m,i,j,k:integer;

begin

assign(f,'f1.txt');

reset(f);

i:=0;

while not(eof(f)) do begin

i:=i+1;

read(f,a[i])

end;

n:=i;

close(f);

assign(f,'f2.txt');

reset(f);

j:=0;

while not(eof(f)) do begin

j:=j+1;

read(f,b[j])

end;

m:=j;

close(f);

i:=1;j:=1;k:=0;

while (i<=n) and (j<=m) do

begin

k:=k+1;

if a[i]<b[j] then begin

c[k]:=a[i];

i:=i+1

end

else begin

c[k]:=b[j];

j:=j+1

end

end;

if i>n then for i:=j to m do begin

k:=k+1;

c[k]:=b[i]

end

else for j:=i to n do begin

k:=k+1;

c[k]:=a[j]

end;

assign(f,'f3.txt');

rewrite(f);

for i:=1 to k{n+m} do write(f,c[i],' ');

close(f);

end.

program f5;

var f,g:text;

a,b,c:set of 0..9;

e,i:0..9;

begin

assign(f,'in.txt');

assign(g,'out.txt');

reset(f);

rewrite(g);

a:=[];

while not(eoln(f)) do begin

read(f,e);

a:=a+[e]

end;

b:=[];

while not(eof(f)) do begin

read(f,e);

b:=b+[e]

end;

c:=a+b;

for i:=0 to 9 do if i in c then write(g,i,' ');

close(f);

close(g);end.

program f6;

var f,g:text;

a,b:set of char;

c:char;

begin

assign(f,'prim.txt');

assign(g,'doi.txt');

reset(f);

rewrite(g);

a:=[];

while not(eoln(f)) do begin

read(f,c);

a:=a+[c]

end;

b:=[];

while not(eof(f)) do begin

read(f,c);

b:=b+[c]

end;

if a<=b then write(g,'DA')

else write(g,'NU');

close(f);

close(g);

end.

program r1;

uses crt;

var n:integer;

function fact(n:integer):longint;

begin

if n=1 then fact:=1

else fact:=n*fact(n-1)

end;

begin

clrscr; 48589zux77ioc8r

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

write(n,'!=',fact(n));

readln;

end.

program r2;

uses crt;

var n:integer;

function fib(n:integer):integer;

begin

if n=1 then fib:=0

else if n=2 then fib:=1

else fib:=fib(n-1)+fib(n-2)

end;

begin

clrscr; 48589zux77ioc8r

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

write('Termenul de ordin ',n,' din sir este ',fib(n));

readln;

end.

{prin scaderi repetate}

program r3;

uses crt;

var a,b: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;

begin

clrscr; 48589zux77ioc8r

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

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

write('Cmmdc=',cmmdc(a,b));

readln;

end.

{prin algoritmul lui euclid}

program r3;

uses crt;

var a,b:integer;

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

begin

if a mod b=0 then cmmdc:=b

else cmmdc:=cmmdc(b,a mod b)

end;

begin

clrscr; 48589zux77ioc8r

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

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

write('Cmmdc=',cmmdc(a,b));

readln;

end.

program r4;

uses crt;

var x,n:integer;

function putere(x,n:integer):integer;

begin

if n=1 then putere:=x

else putere:=x*putere(x,n-1)

end;

begin

clrscr; 48589zux77ioc8r

write('x=');readln(x);

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

write('Rezultatul este ',putere(x,n));

readln;

end.

{folosim formula:

combinari(n,k):=combinari(n-1,k)+combinari(n-1,k-1)}

program r5;

uses crt;

var n,k:integer;

function combinari(n,k:integer):integer;

begin

if (k=0) or (k=n) then combinari:=1

else combinari:=combinari(n-1,k)+combinari(n-1,k-1)

end;

begin

clrscr; 48589zux77ioc8r

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

write('k=');readln(k);

write('Rezultatul este ',combinari(n,k));

readln;

end.

program r6;

uses crt;

var n:longint;

function suma(n:longint):integer;

begin

if n=0 then suma:=0

else suma:=n mod 10 +suma(n div 10)

end;

begin

clrscr; 48589zux77ioc8r

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

write('Suma cifrelor este ',suma(n));

readln;

end.

program r7;

uses crt;

var a:array[1..20] of integer;

n,i:integer;

function maxim(i:integer):integer;

var aux:integer;

begin

if i=n then maxim:=a[n]

else begin

aux:=maxim(i+1);

if a[i]>aux then maxim:=a[i]

else maxim:=aux

end

end;

begin

clrscr; 48589zux77ioc8r

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

write('Sirul...');

for i:=1 to n do read(a[i]);

write('Maximul sirului este ',maxim(1));

readln;readln;

end.

program r8;

uses crt;

var a:array[1..20] of integer;

n,i:integer;

procedure invers(i:integer);

begin

if i=1 then write(a[1],' ')

else begin

write(a[i],' ');

invers(i-1)

end

end;

begin

clrscr; 48589zux77ioc8r

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

write('Sirul...');

for i:=1 to n do read(a[i]);

invers(n);

readln;readln;

end.

program r9;

uses crt;

var n:longint;

procedure invers(n:longint);

begin

if n<>0 then begin

write(n mod 10,' ');

invers(n div 10)

end

end;

begin

clrscr; 48589zux77ioc8r

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

write('Cifrele numarului in ordine inversa sunt:');

invers(n);

readln;

end.

program r10;

uses crt;

var s:string;

procedure invers(i:integer);

begin

if i=1 then write(s[1])

else begin

write(s[i]);

invers(i-1)

end

end;

begin

clrscr; 48589zux77ioc8r

write('sirul de caractere...');readln(s);

invers(length(s));

readln;

end.

program r11;

uses crt;

var a:array[1..20] of string;

n,i:integer;

procedure invers(i:integer);

begin

if i=1 then write(a[1],' ')

else begin

write(a[i],' ');

invers(i-1)

end

end;

begin

clrscr; 48589zux77ioc8r

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

for i:=1 to n do begin

write('cuvantul',i,'=');

readln(a[i])

end;

write('Cuvintele inversate sunt ');

invers(n);

readln;

end.

program b1;

uses crt;

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

var st:stiva;

n,k:integer;

function solutie:boolean;

begin

if k=n+1 then solutie:=true

else solutie:=false

end;

procedure tipar;

var i:integer;

begin

for i:=1 to n do write(st[i],' ');

writeln

end;

function valid:boolean;

var ev:boolean;

i:integer;

begin

ev:=true;

for i:=1 to k-1 do if st[i]=st[k] then ev:=false;

valid:=ev

end;

begin

clrscr; 48589zux77ioc8r

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

for k:=1 to n do st[k]:=0;

k:=1;

while k>0 do begin

if solutie then begin

tipar;

k:=k-1

end;

if st[k]<n then begin

st[k]:=st[k]+1;

if valid then k:=k+1

end

else begin

st[k]:=0;

k:=k-1

end

end;

readln;

end.

program b2;

uses crt;

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

var st:stiva;

n,k,p:integer;

function solutie:boolean;

begin

if k=p+1 then solutie:=true

else solutie:=false

end;

procedure tipar;

var i:integer;

begin

for i:=1 to p do write(st[i],' ');

writeln

end;

function valid:boolean;

var ev:boolean;

i:integer;

begin

ev:=true;

for i:=1 to k-1 do if st[i]=st[k] then ev:=false;

valid:=ev

end;

begin

clrscr; 48589zux77ioc8r

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

write('p=');readln(p);

for k:=1 to p do st[k]:=0;

k:=1;

while k>0 do begin

if solutie then begin

tipar;

k:=k-1

end;

if st[k]<n then begin

st[k]:=st[k]+1;

if valid then k:=k+1

end

else begin

st[k]:=0;

k:=k-1

end

end;

readln;

end.

program b3;

uses crt;

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

var st:stiva;

a:array[1..10] of integer;

n,k,i:integer;

function solutie:boolean;

begin

if k=n+1 then solutie:=true

else solutie:=false

end;

procedure tipar;

var i:integer;

begin

for i:=1 to n do write(st[i],' ');

writeln

end;

function valid:boolean;

begin

valid:=true

end;

begin

clrscr; 48589zux77ioc8r

write('Nr de multimi...');readln(n);

write('Multimile...');

for i:=1 to n do read(a[i]);

for k:=1 to n do st[k]:=0;

k:=1;

while k>0 do begin

if solutie then begin

tipar;

k:=k-1

end;

if st[k]<a[k] then begin

st[k]:=st[k]+1;

if valid then k:=k+1

end

else begin

st[k]:=0;

k:=k-1

end

end;

readln;

end.

program b4;

uses crt;

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

var st:stiva;

n,k:integer;

function solutie:boolean;

begin

if k=n+1 then solutie:=true

else solutie:=false

end;

procedure tipar;

var i:integer;

begin

write('{');

for i:=1 to n do if st[i]=1 then write(i);

write('}');

writeln

end;

function valid:boolean;

begin

valid:=true

end;

begin

clrscr; 48589zux77ioc8r

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

writeln('Submultimile sunt:');

for k:=1 to n do st[k]:=-1;

k:=1;

while k>0 do begin

if solutie then begin

tipar;

k:=k-1

end;

if st[k]<1 then begin

st[k]:=st[k]+1;

if valid then k:=k+1

end

else begin

st[k]:=-1;

k:=k-1

end

end;

readln;

end.

program b5;

uses crt;

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

var st:stiva;

n,k:integer;

function solutie:boolean;

begin

if k=n+1 then solutie:=true

else solutie:=false

end;

procedure tipar;

var i,j:integer;

begin

for i:=1 to n do begin

for j:=1 to n do if st[i]=j then write(1,' ')

else write(0,' ');

writeln

end;

writeln;

end;

function valid:boolean;

var ev:boolean;

i:integer;

begin

ev:=true;

for i:=1 to k-1 do

if (st[i]=st[k]) or (abs(st[i]-st[k])=abs(i-k)) then ev:=false;

valid:=ev

end;

begin

clrscr; 48589zux77ioc8r

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

for k:=1 to n do st[k]:=0;

k:=1;

while k>0 do begin

if solutie then begin

tipar;

k:=k-1

end;

if st[k]<n then begin

st[k]:=st[k]+1;

if valid then k:=k+1

end

else begin

st[k]:=0;

k:=k-1

end

end;

readln;

end.

program b7;

uses crt;

const m=8;n=10;

type matrice=array[1..m,1..n] of byte;

sir=array[1..4] of integer;

const lab:matrice=((0,0,0,0,0,1,0,0,0,0),

(0,0,0,1,0,1,0,0,0,0),

(0,0,0,1,1,1,0,0,0,0),

(1,1,1,1,0,1,0,0,0,0),

(0,0,0,1,0,1,0,0,0,0),

(0,1,1,1,1,1,1,1,0,0),

(1,1,0,0,1,0,0,0,0,0),

(0,0,0,0,1,0,0,0,0,0));

x:sir=(-1,0,1,0);

y:sir=(0,1,0,-1);

var t:matrice;

nr_sol,i,j:byte;

procedure scrie;

var i,j:byte;

begin

readln;

nr_sol:=nr_sol+1;

writeln('Solutia ',nr_sol,':');

for i:=1 to m do begin

for j:=1 to n do write(t[i,j]:3);

writeln

end

end;

procedure traseu(i,j,pas:byte);

var ii,jj:integer;

k:byte;

begin

for k:=1 to 4 do

begin

ii:=i+x[k];

jj:=j+y[k];

if (ii in [1..m]) and (jj in [1..n]) then

if (lab[ii,jj]=1) and (t[ii,jj]=0) then

begin

t[ii,jj]:=pas;

if (ii in [1,m]) or (jj in [1,n]) then scrie

else traseu(ii,jj,pas+1);

t[ii,jj]:=0

end

end

end;

begin

clrscr; 48589zux77ioc8r

for i:=1 to m do

for j:=1 to n do t[i,j]:=0;

write('Pozitia i,j din interiorul labirintului:');

readln(i,j);

nr_sol:=0;

t[i,j]:=1;

traseu(i,j,2)

end.

program b8;

uses crt;

type sir=array[1..8] of integer;

const x:sir=(-2,-1,1,2,2,1,-1,-2);

y:sir=(1,2,2,1,-1,-2,-2,-1);

var t:array[1..10,1..10] of integer;

nn,n,i,j:byte;

nr_sol:word;

{numarul solutiilor problemei}

procedure scrie;

var i,j:byte;

begin

nr_sol:=nr_sol+1;

writeln('Solutia ',nr_sol,':');

for i:=1 to n do begin

for j:=1 to n do write(t[i,j]:4);

writeln

end;

readln;

end;

procedure mutare(i,j,pas:byte);{calul este in patratul i,j}

var ii,jj:integer;

k:byte;{la pasul pas sare in patratul (ii,jj)}

begin

for k:=1 to 8 do

begin

ii:=i+x[k];

jj:=j+y[k];

if (ii in [1..n]) and (jj in [1..n]) and (t[ii,jj]=0) then

begin

t[ii,jj]:=pas;

if pas=nn then scrie

else mutare(ii,jj,pas+1);

t[ii,jj]:=0

end

end

end;

begin

clrscr; 48589zux77ioc8r

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

for i:=1 to n do

for j:=1 to n do t[1,j]:=0;

t[1,1]:=1;{calul este in patratul din stanga sus al tablei}

nn:=n*n;

nr_sol:=0;

mutare(1,1,2);

if nr_sol=0 then writeln('Problema nu are solutie');

readln;

end.

program l1;

uses crt;

type ref=^inr;

inr=record inf:integer;

urm:ref

end;

var prim:ref;

procedure creare;

var c,d:ref;

n,i,inf:integer;

begin

write('Nr de elem el listei=');readln(n);

write('inf1=');readln(inf);

new(prim);

prim^.inf:=inf;

prim^.urm:=nil;

d:=prim;

for i:=2 to n do begin

write('inf',i,'=');

readln(inf);

new(c);

c^.inf:=inf;

c^.urm:=nil;

d^.urm:=c;

d:=c

end

end;

procedure adaugare;

var c,d:ref;

inf:integer;

begin

c:=prim;

while c^.urm<>nil do c:=c^.urm;

write('inf care trebuie adaugata...');readln(inf);

new(d);

d^.inf:=inf;

d^.urm:=nil;

c^.urm:=d

end;

procedure listare;

var c:ref;

begin

c:=prim;

while c<>nil do begin

write(c^.inf,' ');

c:=c^.urm

end;

writeln;

end;

procedure cautare;

var c:ref;

inf,poz:integer;

begin

write('Informatia cautata...');

readln(inf);

c:=prim;

poz:=1;

while c^.inf<>inf do begin

poz:=poz+1;

c:=c^.urm

end;

if c<>nil then writeln('Informatia se gaseste pe pozitia ',poz,' a listei')

else writeln('Informatia nu se gaseste in sir')

end;

procedure eliminare;

var c,d:ref;

inf:integer;

begin

write('Informatia care trebuie eliminata...');readln(inf);

c:=prim;

if prim^.inf=inf then begin

prim:=prim^.urm;

dispose(c)

end

else begin

while c^.inf<>inf do begin

d:=c;

c:=c^.urm

end;

d^.urm:=c^.urm;

dispose(c)

end

end;

begin

clrscr; 48589zux77ioc8r

creare;

listare;

adaugare;

listare;

eliminare;

listare;

readln;

end.

program l2;

uses crt;

type ref=^inr;

inr=record inf:integer;

ant,urm:ref

end;

var prim,ultim:ref;

procedure creare;

var c,d:ref;

n,i,inf:integer;

begin

write('Cate elemente contine lista...');readln(n);

write('inf1=');readln(inf);

new(prim);

prim^.inf:=inf;

prim^.ant:=nil;

prim^.urm:=nil;

ultim:=prim;

d:=prim;

for i:=2 to n do begin

write('inf',i,'=');readln(inf);

new(c);

c^.inf:=inf;

c^.ant:=d;

c^.urm:=nil;

d^.urm:=c;

d:=c;

ultim:=c

end

end;

procedure a_dreapta;

var c:ref;

inf:integer;

begin

write('informatia care se adauga la dreapta...');readln(inf);

new(c);

c^.inf:=inf;

c^.ant:=ultim;

c^.urm:=nil;

ultim^.urm:=c;

ultim:=c

end;

procedure a_stanga;

var c:ref;

inf:integer;

begin

write('informatia care se adauga la stanga...');readln(inf);

new(c);

c^.inf:=inf;

c^.ant:=nil;

c^.urm:=prim;

prim^.ant:=c;

prim:=c

end;

procedure a_interior;

var c,d:ref;

inf:integer;

begin

write('informatia dupa care se adauga...');readln(inf);

c:=prim;

while c^.inf<>inf do c:=c^.urm;

write('informatia care se adauga...');readln(inf);

new(d);

d^.inf:=inf;

c^.urm^.ant:=d;

d^.urm:=c^.urm;

d^.ant:=c;

c^.urm:=d

end;

procedure s_ultim;

var c:ref;

begin

c:=ultim;

ultim:=ultim^.ant;

ultim^.urm:=nil;

dispose(c)

end;

procedure s_prim;

var c:ref;

begin

c:=prim;

prim:=prim^.urm;

prim^.ant:=nil;

dispose(c)

end;

procedure s_interior;

var c:ref;

inf:integer;

be