rezolvariemai_culegere

7/29/2019 rezolvariemai_culegere

1/43

II. Instruciunea de decizie ; algoritmi cu ramificaii

Comparri ntre valorile a dou variabileProblema 1 Problema 2var a,b,mic: integer; var x,y: integer;begin beginwrite(introdu doua numere ); read(a,b); write(varsta primul copil =);read(x);if ay then

end. writeln (primul copil este mai mare cu ,x-y, ani)elsewriteln (al doilea copil este mai mare cu ,y-x, ani);

end.Problema 3 Problema 4var a,b: integer; var n1,n2,n3,s:integer;begin beginwrite(introdu cele doua punctaje ); write(introdu trei numere );read(n1,n2,n3);read(a,b); write(introdu suma a doua nr );read(s);if ab then writeln (a*2, ,b*3) if a=b-1 then writeln(a, e predecesorul lui ,,b)

else writeln (b*2, ,a*3); else writeln(a, nu e predecesorul lui ,,b)end. end.Compararea valorii unei variabile cu o constantProblema 1 Problema 2var a,b: real; s: char; var a,b,c,x,y,z: byte;begin beginwrite(doua numere nenule); readln(a,b); write(numar pacient, glicemie ); readln(a,x);write( o operatie ); readln(s); write(numar pacient, glicemie ); readln(b,y);case s of write(numar pacient, glicemie ); readln(c,z);

+: writeln(a,+,b,=,a+b); writeln(Pacienti cu glicemie mare);-: writeln(a,-,b,=,a-b); if x>100 then writeln(a);*: writeln(a,*,b,=,a*b); if y>100 then writeln(b);/: writeln(a,/,b,=,a/b:6:2); if z>100 then writeln(c);else write(semn incorect); end.

end ;end.Problema 3 Problema 4var a,b,c: byte; var a,b: integer;begin beginwrite( ce note a luat Ionel?); read(a,b,c); write(doua numere ); read(a,b);write(Ionel spune parintilor notele ); if b0 then writeln(catul=,a/b:5:2)

if a>=7 then write(a, ); else writeln(impartire imposibila);if b>=7 then write(b, ); end.if c>=7 then write(c, );end.Problema 5 Problema 6var x,y: byte; var a,b,c,d,e,f,g : byte ;begin beginwrite( greutatile copiilor );read(x.y); write(numar ore zilnic );read(a,b,c,d,e,f,g);if x+y>100 then writeln( INTRA PE RAND) if a+b+c+d+e+f+g>20 then writeln(va fi pedepsit)

else writeln(INTRA AMBII COPII); else writeln(nu va fi pedepsit);end. end.

1


2/43

Problema 7 Problema 8var i,v: byte; s: char;g: real; var a,b,o: integer;begin beginwrite(inaltime, varsta, sex:); writeln(1. suma); writeln(2. produs);readln(i,v); readln(s); write(introdu doua numere );readln(a,b);write(greutatea ideala:); write(alege operatia (1 sau 2) ); read(o);g:=50+0.75*(i-150)+(v-20)/4 if o=1 then writeln(a,+,b,=,a+b);if s=m then writeln(g, kg); if o=2 then writeln(a,*,b,=,a*b);if s=f then writeln(g-10, kg); end.end.

Problema 1 Problema 2var a,b,c: integer; var x,y: integer;begin begin

write(trei numere:); read(a,b,c); write(introdu doua numere ); read(x,y);if a mod 2=0 then writeln(a, par) if x mod y=0 then

else writeln(a, impar); writeln(x, se imparte exact la ,y)if b mod 2=0 then writeln(b, par) else

else writeln(b, impar); writeln(x, nu se imparte exact la ,y)if c mod 2=0 then writeln(c, par) end.

else writeln(c, impar);end.

Problema 3 Problema 4 var a,b:integer; var x: integer;begin beginwrite(introdu doua numere ); read(a,b); write(cate petale are margareta?); read(x);

write(numere care se impart la 7:); write(ma iubeste );if a mod 7 =0 then write(a, ); case x mod 5 of if b mod 7 =0 then write(b, ); 1: writeln(un pic);writeln; 2: writeln(mult);end. 3: writeln(cu pasiune);

4: writeln(la nebunie);0: writeln(deloc);

Problema 5 end;var x: integer; end.

begin Problema 6write(pe ce loc este Ionel?); read(x); var n, casuta: integer;

write(Ionel primeste un tricou de culoare ); begincase x mod 4 of write(al catelea a sosit Ionel?); read(n);

1: writeln(alba); write(Ionel este cazat in casuta nr. );2: writeln(rosie); if n mod 4=0 then casuta:=n div 43: writeln(albastra); else casuta:=n div 4 +1;0: writeln(neagra); writeln(casuta);

end; end.end.Problema 7 Problema 8 var x, clasa: integer; var m,o: integer;

begin beginwrite(al catelea este Radu?); read(x); write(m=); read(m);

write(Radu este inscris in clasa a V-a ); o:=m mod 4 +1;if x mod 25=0 then clasa:=x div 25 writeln(Gygely va muri la ora ,o);

else clasa:=n div 25 +1; end.case clasa of

1: writeln(A);2: writeln(B);

3: writeln(C);4: writeln(D);5: writeln(E);

2


3/43

end;end.

Problema 1 Problema 2 var a,b,c: integer; var a,b,c: integer;begin beginwrite(introdu trei numere ); read(a,b,c); write(introdu trei numere ); read(a,b,c);if (a


4/43

Problema 11var ac,an,zc,zn,lc,ln,v: integer ;beginwrite(data curenta (an,luna,zi) );readln(ac,lc,zc);write(data nasterii (an,luna,zi) );

readln(an,ln,zn);v:=ac-an;if (lcy then writeln (spune nota ,x) if (a>=0) and (b>=0) and (c>=0)

else writeln (spune nota ,y); then if b>c then writeln (b) else writeln(c)end. else writeln (a+b);

end.Problema 3 Problema 4

var a,b: integer; var amc,amr,rmc,rmr,vmc,vmr,smc,smr,a,r,v: integer;begin beginwrite(doua numere ); read(a,b); write(numar bile albe-mici,mari ); read(amc,amr);if a>=b then write(numar bile rosii-mici,mari ); read(rmc,rmr);

begin write(numar bile verzi-mici,mari ); read(vmc,vmr);if a mod 2=0 then writeln(a) writeln(total bile ,amc+amr+rmc+rmr+vmc+vmr);

else if b mod 2=0 then writeln(b) smc:=amc+rmc+vmc;end smr:=amr+rmr+vmr;

else if smc>smr then writeln(mici ,smc );if b mod 2=0 then writeln(b) if smc=smr then writeln(mici si mari ,smc);else if a mod 2=0 then writeln(a); if smr>smc then writeln(mari ,smr);

end. a:=amc+amr; r:=rmc+rmr; v:=vmc+vmr;

Problema 5 if (a>=r) and (a>=v) then writeln(albe ,a);Var g,b,bg,bc: integer; if (r>=a) and (r>=v) then writeln(rosii ,r);begin if (v>=a) and (v>=r) then writeln(verzi ,v);write( nr. gaini ); readln(g); end.write(nr. boabe ); readln(b);bg:=b div g;{boabe primite de fiecare gaina}bc:=b mod g;{boabe primite de curcan}

if bg>bc then writeln(gainile ,bg-bc);if bc>bg then writeln(curcanul ,bc-bg);

if bc=bg then writeln(egalitate);end.

4


5/43

Problema 1 Problema 2

var a,n :integer ; var a,b,e :integer ;begin beginwriteln(numere care se divid cu 6:); write(etaj de plecare:);read(a);for a:=1 to 9 do write(etaj de sosire:);read(b);

begin writeln(liftul parcurge etajele);n:=a*100+200+30+a; for i:=a downto b do writeln (i);

if n mod 6=0 then writeln(n); end.end;

end.

Problema 3 Problema 4 var f,n :integer ; var a,b,n :integer ;

begin beginwrite(n=); read(n); for a :=17 to 983 dofor f:=1 to 10 do writeln(f,x,n,=,f*n); beginend. b :=1000-a ;

if (a mod 17=0) and (b mod 19=0) then

writeln(a, ,b) ;end ;

end.Problema 5var t,v,i,n : integer ; {t=nr. termeni afisati, v= valoarea termenilor, i=numar de valori egale }begin { se observa ca i=v+1)

write(n=) ; read(n) ;t :=1 ; v :=1 ; i :=1 ;while tv+1 then begin v :=v+1 ; i :=1 end ;end ;

end.Problema 6var a,b,t,v,n : integer ; {a,b=termeni consecutivi in sir, t numara termenii}begin

write(n=) ; read(n) ;a :=0 ; b :=1 ; write (a, ,b, ) ; t :=3repeatv :=a+b ;write(v, ) ;t :=t+1 ;

a :=b ;b :=v ;

until t>n ;

end.Problema 7var n,t1,t2 : integer ;

beginwrite(numar=) ; read(n) ;if n mod 2=1 then begin writeln(problema nu are solutie) ; halt end ; {problema are solutie numai}t1 :=1 ; {pt. numere pare}repeatt2 := n - t1 ;

if t2 mod 2=1 then writeln(n,=,t1,+,t2) ;t1 :=t1+2 ;

5


6/43

until t1>n div 2 ;end.Problema 8

var n,t,w : integer ;beginwrite(numar=) ; read(n) ;if n mod 2=0 then begin writeln(problema nu are solutie) ; halt end ;

{problema are solutie numai pt. numere impare}{problema se poate rezolva printr-un singur calcul matematic pornind de la expresia n=t+(t+1), altfel se cauta

primul termen cu o bucla for}for t :=1 to n div 2 do

beginw :=n-t ;if w=t+1 then writeln(n,=,t,+,w) ;end ;

end.Problema 9var n,t,w,s,i : integer ;beginwrite(numar=) ; read(n) ;

for t :=1 to n div 2 dobegin

s :=t ; {primul termen al sumei}w :=t+1 ; {al doilea termen al sumei}repeat { w va lua valorile celorlalti termeni ai sumei}s :=s+w ;

w :=w+1 ;until s>=n ;if s=n then

beginfor i :=t to w-2 do write(i,+) ;writeln(w-1,=,n)

end ;end ;

end.Problema 10var n,d : integer ;begin

write(numar=) ; read(n) ;writeln(divizorii lui ,n, sunt :) ;for d :=1 to n do if n mod d=0 then write(d, ) ;end.Problema 11var n,i: integer ; prim: boolean ;

beginwrite(numar=) ; read(n) ;prim :=true ;

if (n=1) or (n=0) then prim :=falseelsefor i :=2 to n div 2 do

if n mod i=0 then prim :=false ;if prim then writeln(numar prim) else writeln(numarul nu este prim) ;end.

sau, fara variabile booleene, folosind proprietatea numerelor prime de a avea doar doi divizorivar n,i,c : integer ;begin

write(numar=) ; read(n) ;c :=0 ;

6


7/43

for i :=1 to n do if n mod i=0 then c :=c+1 ;if c=2 then writeln(numar prim) else writeln(numarul nu este prim)end.

Problema 12var n,i,j,nr : integer ; prim :boolean ;beginwrite(cate numere prime ?) ; read(nr) ;n :=2 ;j :=0 ; {jmemoreaza cate numere prime s-au gasit}

repeatprim :=true ;for i :=2 to n div 2 do if n mod i=0 then prim :=false ;if prim then begin witeln(n, ) ; j :=j+1 end ;n :=n+1 ;

until j=nr ;

end.

Problema 1 Problema 2 var a,b,e: integer; var a,b,c,n,x: integer;begin begin

write(introdu valoarea etajelor );read(a,b); write(introdu a, b si c );read(a,b,c);write(liftul parcurge etajele ); write(nr. care se impart la ,a, sau ,b mai mici decat ,c);

if ab then begin x:=a; a:=b; b:=x; end;else for e:=a downto b do write(e); for n:=b to c do if (n mod a=0) or (n mod b=0) thenwriteln(n);

end. end.Problema 3

var n,s,a,b,x: integer;beginwrite(introdu doua numere ); read(a,b);if a>b then begin x:=a; a:=b; b:=x; end;s:=0;for n:=a to b do s:=s+n;

writeln(suma=,s);end.

Problema 1 Problema 2 var a,b,c: integer; var a,b,n,nr: integer;begin begin

for a:=2 to 97 do for a:=1 to 9 dofor b:=a+1 to 98 do for b:=1 to 9 do

for c:=b+1 to 99 do beginif a+b+c mod 10=0 then n=a*10+b

writeln(a, ,b, ,c); nr=b*10+aend. f n+nr=55 then writeln(n);

end;end.

Problema 3 Problema 4

var s,z,u: integer; var a,b,c,d,e: integer;begin beginwriteln(Rezultate:); a:=1;

for s:=1 to 5 do for b:=0 to 9 dofor z:=s+1 to 8 do for c:= 0 to 9 do

for u:=z+1 to 9 do for d:=0 to 9 doif s+z+u=18 then writeln(s,z,u); for e:=0 to 9 do

end. if a*10000+b*1000+c*100+b*10+e-(e*1000+d*100+a*10+b)=e*1000+b*100+c*10+e

+d*100+a*10+b)=e*1000+b*100+c*10+e thenbegin writeln(a,b,c,b,e); writeln( ,e,d,a,b);

7


8/43

writeln(------); writeln( ,e,b,c,e); end;end.

Problema 1 Problema 2 var t: byte; s,p: longint; var t,n: integer;s2,s7: longint;begin begins:=0; s2:=0; s7:=0; write(n=); read(n);for t:=1 to 14 do s:=s+t*7; for t:=1 to n-1 do s2:=s2+t*(t+1);

p:=1; writeln (s2=,s2);for t:=1 to 11 do p:=p*(t*3); p:=1;writeln(suma=,s); for t:= 0 to n do begin s7:=s7+p; p:=p*2; end;writeln(produs=,p); writeln (s7=,s7);end. end.

Problema 3var n: integer; s:longint;begins:=0;

repeatwrite(numar=); read(n);

if n0 then s:=s+n;until n=0;writeln(suma numerelor introduse =,s)end.

Problema 1 Problema 2 var a,n,k: integer; var n,k,c: integer;begin beginwrite(introdu numerele a si n:); read(a,n); write(introdu numerele n si k:); read(n,k);write(a); c:=0;

for k:=1 to n do write(0); if n mod k=0 then begin while (n mod k=0) and (n0) doend. begin n:=n div k; c:=c+1 end;

Problema3 end;var n,factor,exp: integer; writeln(k, apare la puterea ,c);begin end.

write(n=); read(n); Problema 4

factor:=2; var zi: integer; inalt: real;repeat beginexp:=0; inalt:=1; zi:=0;while n mod factor=0 do repeat

begin inalt:=inalt+0.75;exp:=exp+1; zi:=zi+1;

n:=n div factor; until inalt>=12;end; writeln(Dupa ,zi, zile copacul ajunge la inalt. de ,inalt:5:2, m);

if exp0 then writeln(factor, ,exp) ; inalt :=1;

factor:=factor+1; for zi:=1 to 30 do inalt:=inalt+0.75;until n=1; writeln(Dupa o luna copacul ajunge la inaltimea de ,inalt, m);end. end.

Problema 5 Problema 6var a,b,x,dist,zi: integer; var n, zi, nrcap: integer;begin beginwrite(valorile pt. x, a, b ); read(x,a,b); write(numar zile=); read(n);dist:=0; zi:=0; nrcap:=6;write(Fat Frumos ajunge la Ileana ); for zi:=1 to n do

repeat begins:=s+a; nrcap:=nrcap-1;

8


9/43

zi:=zi+1; if zi=0 then begin sp:=sp+a; cp:=cp+1 end

end; else begin sn:=sn+a; cn:=cn+1 end;writeln(c, nr. care dau rest 7 la imp. cu 13); end;writeln(produsul celorlalte=,p); writeln(media anuala a temp. pozitive=,sp/cp:6:2);

end. if cn0 then writeln(media an. a temp. neg.=,sn/cn:6:2)

Problema 3 else writeln(nu s-au inreg.temp.medii lunare neg.);var c,a: integer; end.begin Problema 4c:=0; var a,l,z,n,c1,c,i: integer;repeat beginwrite(numar=); read(a); c1:=0; c:=0;

if (a mod 2=0) and (a0) then c:=c+1; write(cati copii?); read(n);until a=0; for i:=1 to n do begin

writeln(ai introdus ,c, numere pare); write(an,luna,zi:); read(a,l,z);end. if (z=1) and (l=6) then c1:=c1+1;Problema 5 if (a=1994)or(a=1995)or(a=1996) then c:=c+1;var s,n,i,r:integer; m:real; end;

begin writeln(c1, copii nascuti la 1 iunie);writeln(introdu numere :); writeln(c, copii nascuti in 1994,1995,1996);s:=0; i:=0; end.

while sm then min:=m; if max


10/43

Problema 1 Problema 2var a,b,c,ua,za,ub,zb,uc,zc,x,y:byte; var n,s,c,max,cifra : longint ;

begin beginwrite(a,b,c=); read(a,b,c); write(introdu un numar ) ; read(n) ;ua:=a mod 10; ub:=b mod 10; uc:=c mod 10; c :=0 ; max :=0 ; s :=0 ;za:=a div 10; zb:=b div 10; zc:=c div 10; repeatx:=ua*100+ub*10+uc; y:=za*100+zb*10+zc; cifra :=n mod 10 ; s:=s+cifra ; c :=c+1 ;writeln(x=,x, y=,y); if max


11/43

var n,c,nc,m,cifra : longint ; s :=s div 10 ;begin until s=0 ;write(introdu un numar ) ; read(n) ; repeat {afisez rasturnatul lui srast, fara a forma acest numar}

for c :=0 to 9 do cifra :=srast mod 10 ;begin write(cifra, ) ;nc :=0 ; srast :=srast div 10 ;m :=n ; until srast=0 ;repeat end.cifra :=m mod 10 ;

if cifra=c then nc :=nc+1 ;m :=m div 10 ;

until m=0 ;writeln(cifra ,c, apare de ,nc, ori) ;end ;

end.

Problema 10 Problema 11var n,c,nc,m,cifra,nrcifre: longint ; var a,b,m,cifra,nr :longint ; nr1,nr2 :boolean ;begin beginwrite(introdu un numar ) ; read(n) ; write(a,b=) ; read(a,b) ;

nrcifre :=0 ; write(a) ) ;for c :=0 to 9 do for c := 0 to 9 do

begin beginnc :=0 ; nr1:=false ; m:=a ;m :=n ; repeatrepeat cifra :=m mod 10 ; if cifra=c then nr1:=true;

cifra :=m mod 10 ; m :=m div 10 ;if cifra=c then nc :=nc+1 ; until m=0 ;m :=m div 10 ; nr2:=false; m:=b ;

until m=0 ; repeatif nc0 then nrcifre:=nrcifre+1 ; cifra :=m mod 10 ; if cifra=c then nr1:=true;end ; m :=m div 10 ;

writeln(numarul contine ,nrcifre, distincte) ; until m=0 ;end. if nr1 and nr2 then write(c, );

Problema 12 end ; writeln ;var a,b,s,n: longint ; write( b) ) ; {iau toate cifrele de la 0 la 9 si vad de cate ori aparebegin fiecare atat in a cat si in b}write (a,b (a


12/43

r:=a mod b ; repeata :=b ; r:=a mod b ;b :=r ; a :=b ;

until r=0 ; b :=rwrite(cmmdc=,a) ; until r=0 ;end. numarator:=numarator div a ; numitor :=numitor div a ;

writeln(fractia=,numarator,/,numitor) ;end.

Problema 3 Problema 4 var a,b,c,r: integer ; var n,m,r: integer ;begin begin

write(introdu trei numere ) ; read(a,b,c) ; write(introdu un numar ) ; read(n) ;repeat {aflu cmmmdc dintre a si b} writeln(numere prime cu ,n) ;

r :=a mod b ; a :=b ; b :=r ; for m :=2 to n-1 do beginuntil r=0 ; x :=n ;y :=m ;repeat repeat r :=x mod y ; x :=y ; y :=r until r=0 ;{aflu cmmmdc dintre c si cmmmdc dintre a si b} if x=1 then write(m, ) ;

r :=a mod c ; a :=c ; c :=r ; until r=0 ; end ;writeln(cmmmdc=,a) ; end.end.

Problema 1 Problema 2var n,d,c:integer; var max,n,nr,d,c: integer;

begin beginwriteln(Numere care au patru divizori); max:=0;

for n:=6 to 100 do begin for n:=2 to 1000 do beginc:=0; c:=0;for d:=1 to n do if n mod d=0 then c:=c+1; for d:=1 to n do if n mod d=0 then c:=c+1;if c=4 then write(n, ); if max


13/43

writeln(prod. se termina in ,e2, zerouri) var e,i,j,c: byte {c=numar cifre, e=numar maxim de cifreelse eliminate pe o latura }

writeln(prod. se termina in ,e5, zerouri); n,nr,f,r: longint; {r=nr ramas dupa elimin. cifrelor de pe extreme}

end. beginProblema 5 write(n=); read(n);var min,max,t,i: integer; c:=0; nr:=n;begin repeat {se deermina c, numarul de cifre al numarului n}max:= -50; min:= 50; c:=c+1; nr:=nr div 10; until nr=0;for i:=1 to 12 do begin e:=(c-1) div 2;

write(temperatura in luna ,i); read(t); for i:=e downto 0 do beginif (max0) then min:=t; for j:=1 to i do f:=f*10;

end; r:=n div f; {se elimina f cifre de la sfarsit}writeln(max negative=,max); f:=1;writeln(min pozitive=,min); for j:=1 to c-2*i do f:=f*10;

end. r:=r mod f; {se elimina cifrele de la inceput}

writeln(r:c-i); end; end.Problema 7var x: longint;

beginwriteln(numar=); read(x);

writeln(scrierea romana a numarului dat:);while x>=1000 do begin write(M); x:=x-1000 end;if x>=900 then begin write(CM); x:=x-900 end

else if x>=500 then begin write(D); x:=x-500 end

else if x>=400 then begin write(CD); x:=x-400 end;while x>=100 do begin write(C); x:=x-100 end;if x>=90 then begin write(XC); x:=x-90 end

else if x>=50 then begin write(L); x:=x-50 endelse if x>=40 then begin write(XL); x:=x-40 end;

while x>=10 do begin write(X); x:=x-10 end;

if x>=9 then begin write(IX); x:=x-9 endelse if x>=5 then begin write(V); x:=x-5 end

else if x=5 then begin write(IV); x:=x-4 end;while x>=1 do begin write(I); x:=x-1 end;end.Problema 8

var op,c:char; nr:longint; i: integer; e: real;beginwriteln(introdu expresia aritmetica, caracter cu caracter:);{expresia introdusa se presupune ca va fi corecta}nr:=0;repeat {se formeaza primul termen}

readln(c); case c of0..9: nr:=nr*10+ord(c)-48;

end;

until (ord(c)57);e:=nr; nr:=0; op:=c;repeat readln(c); case c of

0..9: nr:=nr*10+ord(c)-48;+,-,*,/: begin case op of

+: e:=e+nr;-: e:=e-nr;*: e:=e*nr;/: e:=e/nr;

end;op:=c; nr:=0

13


14/43

end;end;

until c==;

case op of {se face ultima operatie cu ultimul numar introdus}+: e:=e+nr;-: e:=e-nr;*: e:=e*nr;/: e:=e/nr;end;

writeln(valoarea expresiei=,e:10:3);end.Problema 9var d,p:real; s,n,t:word;beginwrite(p, n, t =); read(p,n,t);

d:=0; s:=0;repeatd:=d+p; s:=s+1; if s mod n=0 then p:=p/2;until s=t;writeln(d=,d:10:2, cm);

end.Problema 10

var cod,cd,ah,ch,x,bh,n,,premiant,nrpremoras,nrpremsc,i: integer;beginwrite(codul prietenului:); read(cod);ah:=cod div 100; ch:=cod mod 10; x:=cod mod 100; bh:=x div 10;

write(cate lucrari?); read(n);writeln(introdu codurile celor ,n, lucrari:);premiant:=false; nrpremoras:=0; nrpremsc:=0;for i:=1 to n do begin

write(cod=); read(cd);a:=cd div 100;

c:=cd mod 10;x:=cd mod 100;

b:=x div 10;if cd=cod then premiant:=true;if a=ah then nrpremoras:=nrpremoras+1;if (b=bh) and (a=ah) then nrpremsc:=nrpremsc+1;

end;if premiant then writeln(H este premiant!) else writeln(H nu este premiant);writeln(nrpremoras, premii din orasul lui H);writeln(nrpremsc, premii din scoala lui H);end.Problema 11

var n,k,h,i,s: longint; posibil: boolean;beginwrite(cate pagini sunt?); read(n);

write(k,h=); read(k,h);s:=0;for i:=1 to n do if (i mod k=0) and (i mod h0) then begin s:=s+i mod 10; posibil:=true end;

if posibil then writeln(ultima cifra=,s mod 10) else writeln(Imposibil);Problema 12var a: longint; i,n,c,s: byte;beginfor i:=1 to n do begin

write(numar inmatriculare:); read(a);

s:=0;repeat

14


15/43

c:= a mod 10; s:=s+c;a:=a div 10;until a=0;if s mod 2=1 then writeln(pozitia ,i);

end;end.Problema 13 vezi problema 10 cap.III Instruciuni de ciclare, algoritmi ciclici. Utilizarea instruciunilor de ciclarepentru generare de numereProblema 14var x, d, sc,c,sci : integer ;

beginwrite(numar citit pe usa ) ; read(x) ;s:=0; {suma divizorilor lui x}for d:=1 to x do if x mod d=0 then s:=s+d;{verific daca s este prim}prim:=true; for i :=2 to s div 2 do if s mod i=0 then prim :=false ;if prim then begin sc :=0 ; repeat c :=s mod 10 ; sc :=sc+c ; s :=s div 10 until s=0 ;writeln(cod=,sc) ; end

else begin sci :=0 ; repeat c :=s mod 10 ; if c mod 2=1 then sci :=sci+c ; s :=s div 10 until s=0 ;

writeln(cod=,sci) ; end ;end.Problema 15varbegin

write(doua nr. Cu acelasi numar de cifre ); readln(a,b);c:=0; {numara cate cifre de pe aceeasi pozitie in cele doua numere, sunt diferite}

repeatca:=a mod 10; cb:=b mod 10;if cacb then inc(c);a:=a div 10; b:=b div 10

until a=0;writeln(trebuie modificate ,c, cifre);end.

Problema 2

var a,b,c,d: boolean; q: byte;begin

q:=0; {q numara conditiile}for a :=false to true dofor b := false to true dofor c := false to true do

for d := false to true dofor e := false to true do

beginif a


16/43

beginfor a :=false to true do

begin

b :=not a ;c :=not b ;if (a or b) xor c then begin

if a then writeln(a spune adevarul) else writeln(a minte) ;if b then writeln(b spune adevarul) else writeln(b minte) ;if c then writeln(c spune adevarul) else writeln(c minte) ;

end ;end ;

end.

Problema 1

var f,n,c,i: word;beginwrite(cate aruncari?); read(n);writeln(valori obtinute la aruncari:); randomize;for i:=1 to n do begin f:=random(6)+1; writeln(aruncarea ,i,: ,f ); if f=6 then c:=c+1; end ;

writeln(fata 6 s-a obtinut de ,c, ori) ;end.

Problema 2var s,z1,z2 : word ;beginwriteln (valori obtinute la aruncari :) ; randomize ;

s :=0 ;repeatz1 :=1+random(6) ;z2 :=1+random(6) ;s :=s+z1+z2 ;writeln(z1, ,z2) ;

until z1=z2 ;writeln(suma=,s) ;

end.Problema 3var n,max,b,i : word ;begin

write(numarul bilelor extrase :) ; read(n) ;max :=0 ; randomize ; writeln(s-au extras bile cu numerele :) ;for i :=1 to n do begin b :=1+random(20) ; write(b, ) ;if max


17/43

repeat writeln(cat face ,n1,x,n2, ?); readln(raspuns) ; i :=i+1 ;until (raspuns =n1*n2) or i=5 ;end ;

end.

Problema 1var x: array[1..10] of longint; i: byte;

beginwriteln(introdu 10 numere); for i:=1 to 10 do read(x[i]);writeln(Ai introdus numerele:); for i:=1 to 10 do writeln(pozitia ,i:3,x[i]:12);

end.Problema 2var x: array[1..15] of real; i: byte;beginwriteln(introdu 15 numere); for i:=1 to 15 do read(x[i]);writeln(numerele intregi:); for i:=1 to 15 do if x[i]=int(x[i]) then write(trunc(x[i]):10);

writeln(numerele fractionare:); for i:=1 to 15 do if x[i]int(x[i]) then write(x[i]:10:3);end.Problema 3var c: array[1..10] of char; i: byte;beginwriteln(introdu pe rand 10 litere); for i:=1 to 10 do readln(c[i]);

writeln(literele in ordine inversa:); for i:=10 downto 1 do write(c[i]);end.Problema 4var v: array[1..100] of string; n,i: byte;beginwrite(cate versuri are acrostihul?); readln(n);

writeln(introdu pe rand versurile); for i:=1 to n do readln(v[i]);writeln(Mesajul:); for i:=1 to n do write(v[i][1]);end.Problema 5

var x: array[1..100] of integer; d,n,i: integer;begin

write(cate numere?); read(n);writeln(numerele:); for i:=1 to n do read(x[i];write(d=); read(d);writeln(numere divizibile cu ,d); for i:=1 to n do if x[i] mod d=0 then write(x[i]:7);end.Proble ma 6

var p: array[1..50] of byte; x,n,i,j,k: byte; sol:booleanbeginwrite(cate cercuri?); read(n);write(x=);read(x);writeln(valoarea cercurilor:); for i:=1 to n do read(p[i];sol:=false;

for i:=1 to n-2 dofor j:=i to n-1 do

for k:=j to n doif p[i]+p[j]+p[k]=x then begin sol:=true; writeln(p[i]:3,p[j]:3,p[k]:3) end;

if not sol then writeln(imposibil);end.

Problema 1var x: array[1..100] of integer; n,i: integer;begin

17


18/43

write(cate numere? ); read(n);writeln(introdu numerele ); for i:=1 to n do read(x[i]);i:=1; while (x[i]0) and (in then write(nici un element nul);end.

Problema 2var x: array[1..100] of integer; n,i,k,b,c: integer;

beginwrite(n=); read(n); writeln(introdu punctajele); for i:=1 to n do read(x[i]);write(k=); read(k); write(b=); read(b);i:=1; c:=0;repeat

if x[i]>b then begin write(x[i]:7); inc(c) end;

inc(i);until (c>=k) or (i>n);if cn;end.

Problema 4var x: array[1..100] of char; n,i: integer;beginwrite(cate caractere?); readln(n); writeln(introdu pe rand caracterele ); for i:=1 to n do readln(x[i]);i:=1; while (x[i] ) and (in then writeln(nu s-a gasit spatiu) else writeln(primul spatiu apare pe pozitia ,i);

end.Problema 5var t,p: array[1..100] of byte; n,i,h,cam,k: byte; sol:boolean;begin

write(cate camere?); read(n); write(in ce camera vrea sa ajunga?); read(h);writeln(introdu teleportarile ); for i:= 1 to n do read(t[i]);sol:=true; cam:=1; i:=1; p[i]:=cam:repeat

cam:=t[cam];for k:=1 to i do if cam=p[k] then sol:=false;inc(i); p[i]:=cam;

until (not sol) or (h=cam);if sol then begin write(da ); for k:=1 to i do write(p[k]:3); writeln end

else writeln(nu);end.

Problema 1

var x: array[1..100] of integer; n,i,sp,sn: longint;beginwrite(n=); read(n); writeln(introdu numerele); for i:=1 to n do read(x[i]);sn:=0; sp:=0; for i:=1 to n do if x[i]>0 then sp:=sp+x[i] else sn:=sn+x[i];writeln(suma numerelor pozitive:,sp); writeln(suma numerelor negative:,sn);end.

Problema 2var t: array[1..365] of integer; n,i,sp,sn,cp,cn: integer;beginwrite(n=); read(n); writeln(introdu temperaturile); for i:=1 to n do read(t[i]);

18


19/43

sp:=0; sn:=0; cp:=0; cn:=0;for i:=1 to n do if t[i]>=0 then begin inc(cp); sp:=sp+t[i] end

else begin inc(cn); sn:=sn+t[i] end;

if cp0 then writeln(media temperaturilor pozitive=,sp/cp:4:2)else writeln(nu s-au inregistrat temperaturi pozitive);

if cn0 then writeln(media temperaturilor negative=,sn/cn:4:2)else writeln(nu s-au inregistrat temperaturi negative);

end.Problema 3

var x: array[1..100] of integer; n,i,j,sf,sd: longint;beginwrite(n=); read(n); writeln(introdu numerele); for i:=1 to n do read(x[i]);sf:=0; sd:=0; {sf=suma numerelor din fata lui 0, sd=suma numerelor de dupa 0}i:=1; while x[i]0 do begin sf:=sf+x[i]; inc(i) end;for j:=i+1 to n do sd:=sd+x[i];

writeln(suma numerelor pana la 0=,sf); writeln(suma numerelor de dupa 0=,sd);end.Problema 4var x: array[1..100] of integer; n,i,sp,si: longint;begin

write(n=); read(n); writeln(introdu numerele); for i:=1 to n do read(x[i]);sp:=0; si:=0; for i:=1 to n do if i mod 2=0 then sp:=sp+x[i] else si:=si+x[i];

writeln(suma numerelor de pe pozitii pare=,sp); writeln(suma numerelor de pe pozitii impare=,si);end.Problema 5var x: array[1..100] of integer; n,i,c: integer;

beginwrite(n=); read(n); writeln(introdu varstele); for i:=1 to n do read(x[i]);c:=0; for i:=1 to n do if (x[i]>50) and (x[i]=a) and (g[i]=a) and (g[i]


20/43

var x: array[1..100] of integer; n,i,c0,c1,c2: integer;beginwrite(n=); read(n); writeln(introdu numerele); for i:=1 to n do read(x[i]);

i:=1; while x[i]0 do inc(i); writeln(primul 0 apare pe pozitia ,i);c0:=0; c1:=0;c2:=0;for i:=1 to n do

case x[i] of0: inc(c0);1: inc(c1);

2: inc(c2);end;

writeln(cifra 0 apare de ,c0, ori); writeln(cifra 1 apare de ,c1, ori); writeln(cifra 2 apare de ,c2, ori);if (c0


21/43

var x: array[1..100] of integer; n,i,c: integer; s,p: longint;beginwrite(n=); read(n); writeln(introdu numerele); for i:=1 to n do read(x[i]);

s:=0; c:=0; p:=1;for i:=1 to n do if x[i]>0 then s:=s+x[i]

else if x[i]1 then inc(c); if maxa[i+1] then begin x:=a[i]; a[i]:=a[i+1]; a[i+1]:=x; sortat:=false end;

21


22/43

until sortat;writeln(sirul ordonat crescator:); for i:=1 to n do write(a[i]:7);end.

var a: array[1..100] of integer;i,j,n,min,x,pmin: integer;

beginwrite(n=); read(n); writeln(introdu numerele);for i:=1 to n do read(a[i]);for i:=1 to n-1 do begin

min:=a[i]; pmin:=i;for j:=i+1 to n do if min>a[j] then begin min:=a[j]; pmin:=j end;x:=a[pmin]; a[pmin]:=a[i]; a[i]:=x;end;

writeln(sirul ordonat crescator:); for i:=1 to n do write(a[i]:7);end.

Problema 2var a: array[1..100] of integer; n,i,k,z: integer; s: boolean;beginwrite(n=); read(n); writeln(introdu numerele ); for i:=1 to n do read(a[i]); write(k=); read(k);repeat

s:=true;for i:=1 to k-1 do if a[i]>a[i+1] then begin z:=a[i];a[i]:=a[i+1];a[i+1]:=z;s:=false end;

until s;repeat

s:=true;for i:=k+1 to n-1 do if a[i]a[j]) and (a[j] mod 2=0) then

begin

min:=a[j];pmin:=jend;

z:=a[i]; a[i]:=a[pmin]; a[pmin]:=z;end

else begin

max:=a[i]; pmax:=i;for j:=i+1 to n do if (max


23/43

write(n=); readln(n); writeln(introdu caracterele ); for i:=1 to n do readln(a[i]);repeat {ordonez crescator sirul de caractere}

s:=true;

for i:=1 to n-1 do if a[i]>a[i+1] then begin x:=a[i]; a[i]:=a[i+1]; a[i+1]:=x; s:=false end;until s;i:=1;repeat {parcurg sirul prin doua cicluri}

c:=1;j:=i+1;

while (a[j]=a[i]) and (jn;end.Problema 5

var h: array[1..100] of integer; e: array[1..100] of string;z,n,i: integer; s: boolean;x: string;

beginwrite(n= ); read(n); writeln(nume elev, inaltime:); for i:=1 to n do begin readln(e[i]); readln(h[i]); end;repeat

s:=true;for i:=1 to n-1 do if h[i]


24/43

if v[i]=0 then begin {deplasare spre stanga a elementelor de dupa zero}for j:=i+1 to n-c do v[j-1]:=v[j];inc(c);end;

if v[i]0 then inc(i); {se poate intampla sa avem mai multe 0 consecutive, seuntil i>n-c; mareste i numai daca pe pozitia respectiva este un element nenul}writeln(elementele nenule:); for i:=1 to n-c do write(v[i]:7);end.Problema 5var a: array[1..100] of integer; v,n,i,j: integer;

beginwrite(numar elemente ); read(n); writeln(introdu elementele ); for i:=1 to n do read(a[i]);write(v=); read(v);for i:=1 to n do if a[i]=v then begin {deplasare spre stanga}

for j:=i+1 to n do a[j-1]:=a[j];a[n]:=v;end;

write(noul sir:); for i:=1 to n do write(a[i]:7);end.

Problema 1var a,b: array[1..100] of integer; n,i: integer; v: real; prop: boolean;beginprop:=true;

write(numar elemente= ); read(n); writeln(introdu elementele primului sir );for i:=1 to n do begin read(a[i]); if a[i]=0 then prop:=false; end;writeln(introdu elementele celui de al doilea sir );for i:=1 to n do begin read(b[i]); if b[i]=0 then prop:=false; end;if not prop then begin writeln(nu sunt proportionale); halt end;v:=a[1]/b[1];

for i:=2 to n do if a[i]/b[i]v then prop:=false;if prop then writeln(Sunt proportionale) else writeln(Nu sunt proportionale);end.Problema 2var a: array[1..100] of integer; n,i: integer; cresc: boolean;begin

cresc:=true;write(numar elemente= ); read(n); writeln (introdu elementele sirului); for i:=1 to n do read(a[i]);for i:=1 to n-1 do if a[i]>a[i+1] then cresc:=false;if cresc then writeln(sir crescator) else writeln(sirul nu e crescator);end.Problema 3

var a: array[1..100] of integer; n,i,x: integer; gasit: boolean;beginwrite(numar elemente= ); read(n);randomize; for i:=1 to n do a[i]:=random(101);write(valoarea cautata:); read(x);gasit:=false;

for i:=1 to n do if a[i]=x then gasit:=true;

if gasit then beginwriteln(element existent);i:=n; while a[i]x do dec(i);writeln(ultima pozitie ,i);end

else writeln(numar inexistent);end.Problema 4var v: array[1..30] of byte; n,i,k,nv: integer; gasit: boolean;beginwrite(numar elemente= ); read(n); writeln(introdu succesiunea vagoanelor ); for i:=1 to n do read(v[i]);

24


25/43

write(k=); read(k);gasit:=false; i:=1;repeat

nv:=1;if v[i]=v[i+1] then while (v[i]=v[i+1]) and (ik then begin gasit:=true; writeln(incepand cu pozitia ,i+1-nv) end

until i>n;if not gasit then writeln(nu exista mai mult de ,k, vagoane cosecutive de aceeasi clasa)

else writeln(exista mai mult de ,k, vagoane de aceeasi clasa);end.Problema 5var a,b: array[1..100] of integer; n,m,,i,j: integer; subsir, este: boolean;beginwrite(n= ); read(n); writeln(elementele lui a); for i:=1 to n do read(a[i]);

write(m= ); read(m); writeln(elementele lui b); for i:=1 to m do read(b[i]);subsir:=true;for j:=1 to m do begin {se verifica daca fiecare element din b este in a}

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

if not este then subsir:=false;end;

if subsir then writeln(b este subsir al lui a) else writeln(b nu este subsir al lui a);end.Problema 6var a: array[1..100] of integer; n,r,i: integer; prog: boolean;

beginwrite(numar elemente= ); read(n); writeln(elementele sirului:); for i:=1 to n do read(a[i]);prog:=true; r:=a[2]-a[1];for i:=1 to n-1 do if a[i+1]-a[i]r then prog:=false;if prog then writeln(progresie aritmetica) else writeln(nu e progresie aritmetica);end.Problema 7var a: array[1..100] of integer; n,i,x: integer; s: boolean;begin

write(n=); read(n); writeln(introdu numerele ); for i:=1 to n do read(a[i]);repeat

s:=true;for i:=1 to n-1 do if a[i]>a[i+1] then begin x:=a[i]; a[i]:=a[i+1]; a[i+1]:=x; s:=false end;

until s;s:=true;for i:=1 to n-1 do if a[i]=a[i+1] then s:=false;if s then writeln(multime) else writeln(nu este multime);end.Problema 8var a,b: array[1..100] of integer; n,i: integer; e: boolean;beginwrite(numar elemente ); read(n);writeln(introdu elementele primului sir); for i:=1 to n do read(a[i]);

writeln(introdu elementele celui de al doilea sir); for i:=1 to n do read(b[i]);repeat {ordonez crescator primul sir}

s:=true;for i:=1 to n-1 do if a[i]>a[i+1] then begin x:=a[i]; a[i]:=a[i+1]; a[i+1]:=x; s:=false end;

until s;repeat {ordonez crescator al doilea sir}

s:=true;for i:=1 to n-1 do if a[i]>a[i+1] then begin x:=b[i]; a[i]:=b[i+1]; b[i+1]:=x; s:=false end;

until s;e:=true;for i:=1 to n do {compar element cu element cele doua siruri}

if a[i]b[i] then e:=false;

25


26/43

if e then writeln(siruri egale) else writeln(siruri diferite);end.

Problema 1var c:array[2..1000] of byte; n,i,j: byte;

beginwrite(n=); read(n); for i:=2 to n do c[i]:=i; {c contine toate numerele de la 2 la n}i:=2; {i=pasul cu care se parcurge sirul pentru eliminare}repeat

if c[i]0 then beginj:=i; {j=pozitia de plecare}

repeat j:=j+i; c[j]:=0 until j>=n;end;

inc(i);until i> n div 2;writeln(numerele prime pana la ,n); for i:=2 to n do if c[i]0 then write(c[i], );end.

Problema 2var u:= array[1..100] of byte; n,k,pas,i: integer;beginwrite(n=); read(n);for i:=1 to n do u[i]:=1; {u memoreaza starea usii: 0=deschisa, 1=inchisa}for k:=1 to n do begin

pas:=k;repeat

case u[pas] of0: u[pas]:=1;1: u[pas]:=0;end;pas:=pas+k;

until pas>n;end;

writeln(vor iesi detinutii de la celulele cu numarul:); for i:=1 to n do if u[i]=0 then write(i:3);end.Problema 3var f: array[1..100] of integer; n,i: integer;

beginwrite(numar termeni=); read(n);f[1]:=0; f[2]:=1; for i:=3 to n do f[i]:=f[i-1]+f[i-2];for i:=1 to n do write(f[i]:4);end.Problema 4

var v,d: array[1..100] of integer; n,j,k,i: integer; apare: boolean;beginwrite(numar termeni=); read(n);write(elementele sirului:); for i:=1 to n do read(v[i]);k:=1; {k=indicele in vectorul nou, d}for i:=1 to n-1 do

begin {testez daca valoarea v[i] mai apare spre dreapta in v}

apare:=false;for j:=i+1 to n do if v[i]=v[j] then apare:=true;if not apare then begin d[k]:=v[i]; inc(k) end; {trec in d valorile care nu vor mai apare}end;

d[k]:=v[n];writeln(elementele diferite: ); for i:=1 to k do write(d[i]:4);

end.Problema 5var v,w: array[1..100] of integer; n,k,i: integer;beginwrite(numar termeni=); read(n);

26


27/43

write(elementele sirului:); for i:=1 to n do read(v[i]);k:=1; {k=indicele in vectorul format}for i:=1 to n do if v[i]0 then begin w[k]:=v[i]; inc(k) end;

writeln(elementele nenule: ); for i:=1 to k-1 do write(w[i]:4);end.Problema 6 Ca la Problema 5, se testeaza daca v[i] mod 10=k.Problema 7var v,w: array[1..100] of integer; n,ni,k,i: integer;begin

write(numar termeni=); read(n); write(elementele sirului:); for i:=1 to n do read(v[i]);k:=1;ni:=0; {k=indicele in noul vector, ni=cate numere impare sunt in v}for i:=1 to n do if v[i] mod 2=0 then begin w[k]:=v[i]; inc(k) end

else begin inc(ni);w[n+1-ni]:=v[i] end;writeln(elemente pare urmate de elemente impare: ); for i:=1 to n do write(w[i]:5);end.

Problema 8var v,w: array[1..100] of integer; n,na,nd,np,d,s,k,i: integer;beginwrite(numar termeni=); read(n); write(elementele sirului:); for i:=1 to n do read(v[i]);nd:=0; {aflu cate numere deficiente sunt}

for i:=1 to n do begins:=0; for d:=1 to v[i]-1 do if v[i] mod d=0 then s:=s+d;

if v[i]>s then inc(nd);end;

k:=nd; {numerele perfecte se pun incepand cu pozitia k+1}nd:=0; na:=0; np:=0; {contorii pentru numere deficiente, abundente, perfecte}

for i:=1 to n do begins:=0; for d:=1 to v[i]-1 do if v[i] mod d=0 then s:=s+d;if v[i]>s then begin inc(nd); w[nd]:=v[i]; end;if v[i]=s then begin inc(np); w[k+np]:=v[i]; end;if v[i]


28/43

sortat:=true;for i:=1 to j-2 do if c[i]>c[i+1] then begin sortat:=false; x:=c[i];c[i]:=c[i+1];c[i+1]:=x end;

until sortat;

writeln(cel mai mic numar: ); for i:=1 to j-1 do write(c[i]);writeln(cel mai mare numar: ); for i:=j-1 downto 1 do write(c[i]);end.Problema 11var v,w: array[1..100] of real; i,j,n: integer;begin

write(cate numere?); read(n); writeln(introdu numerele); for i:=1 to n do read(v[i]);j:=1; {indicele in noul sir}for i:=1 to n-1 do begin w[j]:=v[i]; w[j+1]:=(v[i]+v[i+1])/2; j:=j+2 end;w[j]:=v[n];writeln(sirul nou: ); for i:=1 to j do write(w[i]:5);end.

Problema 12var x: array [1..200] of byte; j,k,p,t: integer;beginwrite(k=); read(k);p:=1; t:=1; {p=pozitia in sir, t=valoare termen}

while pk) or (j>t);

inc(t);end;writeln(pe pozitia ,k, se afla numarul ,x[k]);end.

Problema 1

var a: array[1..50,1..50] of integer; i,j,n,m: byte; k: integer;begin

write(m,n=); read(m,n); writeln(introdu numerele );for i:=1 to m do for j:=1 to n do read(a[i,j]);write(k=); read(k);for i:=1 to m do

beginfor j:=1 to n do write(a[i,j]+k:5)

writeln;end;

end.Problema 2var a,b: array[1..50,1..50] of integer; i,j,n,m: byte;

beginwrite(m,n=); read(m,n); writeln(introdu numerele din prima matrice);for i:=1 to m do

for j:=1 to n do read(a[i,j]);writeln(introdu numerele din a doua matrice);for i:=1 to m do

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

for i:=1 to m dobeginfor j:=1 to n do write(a[i,j]+b[i,j]:5);writeln;

28


29/43

end;end.Problema 3

var a: array[1..50,1..50] of integer; i,j,n,m: byte;beginwrite(m,n=); read(m,n); writeln(introdu numerele ); for i:=1 to m do for j:=1 to n do read(a[i,j]);for j:=1 to n do begin for i:=1 to m do write(a[i,j]:5); writeln; end;end.Problema 4

var a: array[1..50,1..50] of real; i,j,n,m,c: byte; s,p: real;beginwrite(m,n=); read(m,n); writeln(introdu numerele ); for i:=1 to m do for j:=1 to n do read(a[i,j]);s:=0; p:=1; c:=0;for i:=1 to m do

for j:=1 to n do begin s:=s+a[i,j]; p:=p*a[i,j]; if a[i,j]=int(a[i,j]) then inc(c); end;

writeln(suma=,s:10:3); writeln(produs=,p:10:3); writeln(c, numere intregi);end.Problema 5var a: array[1..50,1..50] of integer; i,j,n: byte; max: integer;begin

write(n=); read(n); writeln(introdu numerele );for i:=1 to n do for j:=1 to n do read(a[i,j]);max:=-maxint;

for i:=1 to n do for j:=1 to n do if max


30/43

for j:=1 to n do beginif (i>j) and (i+j


31/43

if s[j]>9 then begin c:=s[j] div 10; s[j]:=s[j] mod 10; end else c:=0;end;

if c0 then write(c:2); for j:=1 to n do write(s[j]:2);

end.Problema 9var a: array[1..50,1..50] of longint; c: array[1..50] of integer;i,j,m,p,mag: byte; min,s: longint;beginwrite(p,m=); read(p,m); writeln(introdu preturile din fiecare magazin);

for i:=1 to p do begin write(produs ,i,: );for j:=1 to m do read(a[i,j]); end;writeln(introdu cantitatile pentru fiecare produs );for i:=1 to p do begin write(produs ,i,: ); read(c[i]); end;s:=0; {s=suma necesara}for i:=1 to p do

begin

min:=maxlongint; {calculez minimul pe fiecare linie}for j:=1 to m do if min>a[i,j] then begin min:=a[i,j]; mag:=j end;writeln(produs ,i, are pret minim in magazin ,mag);s:=s+c[i]*min;end;

writeln(suma necesara:,s);end.

Problema 1

var a: array[1..50,1..50] of integer; i,j,n,m: byte; x: integer ; cresc: boolean;beginwrite(m,n=); read(m,n); writeln(introdu numerele ); for i:=1 to m do for j:=1 to n do read(a[i,j]);repeat

cresc:=true;for i:=1 to m-1 do if a[i,1]>a[i+1,1] then begin {inversez liniile i si i+1}

for j:=1 to n do begin x:=a[i,j]; a[i,j]:=a[i+1,j]; a[i+1,j]:=x end;cresc:=false;end;

until cresc;for i:=1 to m dobegin for j:=1 to n do write(a[i,j]:5); writeln; end;end.

Problema 2var a: array[1..50,1..50] of integer; i,j,n,m,k: byte;beginwrite(m,n=); read(m,n); writeln(introdu numerele ); for i:=1 to m do for j:=1 to n do read(a[i,j]);write(k=); read(k);for i:=k to m-1 do {se aduce linia i+1 peste linia i, incepand cu linia k+1}

for j:=1 to n do a[i,j]:=a[i+1,j];dec(m); {scad dimensiunea matricii}for i:=1 to m dobegin for j:=1 to n do write(a[i,j]:5); writeln; end;end.

Problema 3var a: array[1..50,1..50] of integer; v: array[1..50] of integer; i,j,n,m,k: byte;

beginwrite(m,n=); read(m,n); writeln(introdu numerele ); for i:=1 to m do for j:=1 to n do read(a[i,j]);write(k=); read(k); write(elementele care se introduc:); for j:=1 to n do read(v[j]);for i:=m downto k do{se aduce linia i peste linia i+1, incepand cu ultima linie pana la linia k}

for j:=1 to n do a[i+1,j]:=a[i,j];for j:=1 to n do a[k,j]:=v[j]; {se introduc noile valori pe linia k}

inc(m); {cresc dimensiunea matricii}for i:=1 to m dobegin for j:=1 to n do write(a[i,j]:5); writeln; end;end.

31


32/43

Problema 5var a: array[0..50,0..50] of integer; i,j,n,m: byte; s: longint;begin

write(m,n=); read(m,n); writeln(introdu numerele ); for i:=1 to m do for j:=1 to n do read(a[i,j]);for i:=1 to m do begin a[i,0]:=0; a[i,n+1]:=0 end; {bordez matricea cu elemente nule}for j:=0 to n+1 do begin a[0,j]:=0; a[m+1,j]:=0 end;for i:=1 to m do

for j:=1 to n dobegin

s:=a[i-1,j-1]+a[i-1,j]+a[i-1,j+1]+a[i,j-1]+a[i,j+1]+a[i+1,j-1]+a[i+1,j]+a[i+1,j+1];write(s:5);end;

end.

Problema 1var a: array[1..50,1..50] of integer; i,j,n: byte; sim: boolean;

beginwrite(n=); read(n); writeln(introdu elementele ); for i:=1 to n do for j:=1 to n do read(a[i,j]);sim:=true;for i:=1 to n do for j:=1 to n do if a[i,j]a[j,i] then sim:=false;if sim then writeln(matrice simetrica) else writeln(matrice nesimetrica);end.

Problema 2var a: array[1..50,1..50] of integer; i,j,n,m,c: byte; egale: boolean;beginwrite(m,n=); read(m,n); writeln(introdu numerele ); for i:=1 to m do for j:=1 to n do read(a[i,j]);c:=0; {c=numarul liniilor cu elemente egale}for i:=1 to m do begin

egale:=true;for j:=1 to n-1 do if a[i,j]a[i,j+1] then egale:=false;if egale then inc(c);

end;writeln(matricea are ,c, linii cu elemente egale);

end.Problema 3var a,b: array[1..50,1..50] of integer; i,j,n,m: byte; egale: boolean;beginwrite(m,n=); read(m,n);writeln(introdu numerele din prima matrice);for i:=1 to m do for j:=1 to n do read(a[i,j]);writeln(introdu numerele din a doua matrice); for i:=1 to m do for j:=1 to n do read(b[i,j]);

egale:=true;for i:=1 to m do

for j:=1 to n do if a[i,j]b[i,j] then egale:=false;if egale then writeln(Matrici egale) else writeln(Matrici neegale);end.Problema 4

var a: array[1..50,1..50] of real; i,j,n,m,c,cor: byte;beginwrite(m,n=); read(m,n);writeln(introdu mediile ); for i:=1 to m do for j:=1 to n do read(a[i,j]);c:=0;for i:=1 to m do begin

cor:=0;

for j:=1 to n do if a[i,j]=3 then inc(c);end;

if c0 then writeln(sunt ,c, repetenti) else writeln(nu sunt repetenti);end.

32


33/43

Problema 5var a: array[1..50,1..50] of integer; v: array[1..250] of integer; i,j,k,n,m: byte; dif: boolean;begin

write(m,n=); read(m,n); writeln(introdu numerele ); for i:=1 to m do for j:=1 to n do read(a[i,j]);dif:=true;k:=0; {liniarizez matricea, creez vectorul v din elementele matricii}for i:=1 to m do for j:=1 to n do begin inc(k); v[k]:=a[i,j] end;for k:=1 to m*n-1 do for j:=k+1 to m*n do if v[k]=v[j] then dif:=false;if dif then writeln(elemente diferite) else writeln(nu sunt diferite);

end.

Problema 1var a: array[1..50,1..50] of integer; i,j,n,nr: byte;begin

write(n=); read(n);nr:=2;for i:=1 to n do

beginfor j:=1 to n do begin

a[i,j]:=nr; nr:=nr+2; write(a[i,j]:4);end;

writeln;end;

end.Problema 2

var a: array[1..50,1..50] of integer; i,j,n: byte;beginwrite(n=); read(n);{construiesc matricea cu 1 pe diagonala principala si 1 in rest}for i:=1 to n do for j:=1 to n do if ij then a[i,j]:=1 else a[i,j]:=-1;for i:=1 to n do

begin

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

end;end.

Problema 1var text: string; i: byte;beginwrite(text:); readln(text);for i:= 1 to length(text) do write( upcase(text[i]));

end.Problema 2var text: string; c,i: byte;

beginwrite(text:); readln(text);c:=0; for i:= 1 to length(text) do if (text[i]=a) or (text[i]=e) or (text[i]=i) or (text[i]=o) or (text[i]=u) then

inc(c);writeln(textul contine ,c, vocale);end.Problema 3var cuv: string; i: byte;begin

write(cuvant:); readln(cuv);for i:= 1 to length(cuv) do writeln(copy(cuv,1,i));

33


34/43

end.Problema 4La fel ca la Problema 3, se schimba doar parametrul pozitie din functia copy: avem writeln(copy(cuv, length(cuv)

+1-i ,i));Problema 5var cuv: string; lc,i: byte; pal: boolean;beginwrite(cuvant:); readln(cuv);lc:=length(cuv); pal:=true;

for i:= 1 to (lc div 2) do if cuv[i] cuv[lc+1-i] then pal:=false;if pal then writeln(palindrom) else writeln(nu este palindrom);end.Problema 6var text: string; i,c: byte; l: char;begin

write(text:); readln(text);for l:=a to z do begin {se numara aparitiile fiecarei litere}

c:=0; for i:=1 to length(text) do if text[i]=l then inc(c);if c0 then writeln(litera ,l, apare de ,c, ori);end;

end.Problema 7

var text,cuv: string; c,l,i: byte;beginwriteln(text:); readln(text); writeln(grup de litere:); readln(cuv);l:=length(cuv); c:=0;

for i:=1 to length(text)-l do if copy(text,i,l)=cuv then inc(c);writeln(secventa ,cuv, apare de ,c, ori);end.Problema 8var text: string; i: byte;begin

writeln(text:); readln(text);for i:=1 to length(text) do if text[i] then write(ord(text[i]), ) else write( );

end.Problema 9var text,textnou: string; l1,l2: char; i: byte;begin

writeln(text:); readln(text);writeln(litera care se inlocuieste:); readln(l1); writeln(litera cu care se inlocuieste:); readln(l1);texnou:=; {initial sirul vid, dupa bucla for va avea ca valoare noul text}for i:=1 to length(text) do if text[i]=l1 then textnou:=textnou+l2 else textnou:=textnou+text[i];writeln(noul text:,textnou);end.

Problema 10var cuv1,cuv2: string; l: char; i: byte; ord: boolean;begin

writeln(primul cuvant:); readln(cuv1); writeln(al doilea cuvant:); readln(cuv2);repeat {ordonez alfabetic literele din cele doua cuvinte}

ord:=true;

for i:=1 to length(cuv1)-1 do if cuv1[i]>cuv1[i+1] then beginl:=cuv1[i]; cuv1[i]:=cuv1[i+1]; cuv1[i+1]:=l ;ord:=false;end;

until ord;repeat {ordonez alfabetic literele din cele doua cuvinte}

ord:=true;

for i:=1 to length(cuv2)-1 do if cuv2[i]>cuv2[i+1] then beginl:=cuv2[i]; cuv2[i]:=cuv2[i+1]; cuv2[i+1]:=l ;ord:=false;

34


35/43

end;until ord;if cuv1=cuv2 then writeln(cuvinte cu aceleasi litere) else writeln(nu au aceleasi litere);

end.Problema 11var n: string; r,i: byte;beginwriteln(numar:); readln(n);r:=length(n) mod 3; {r=numarul de cifre din prima grupa}

if r>0 then begin for i:=1 to r do write(n[i]); write(.); end;i:=r+1;while i0) then begin

if clmax then lmax:=c;c:=0;end;

if ch then inc(c);until eoln;if c>0 then begin

if clmax then lmax:=c;end;

writeln(lungime maxima:,lmax); writeln(lungime minima:,lmin);end.Problema 3

var t, cuv: string; i: byte;beginwriteln(text:); readln(t);i:=1;

repeatcase t[i] of

,.,,,?,!: inc(i);else begin

cuv:=;while (ilength(t);

35


36/43

end.Problema 4Se scot cuvintele din text ca la Problema 4, iar in loc de writeln(cuv) se testeaza daca cuv are lungimea 2; daca da,

se memoreaza intr-un vector de string-uri, care apoi se ordoneaza crescator si se afiseaza.Problema 5var text: string; cuv: array[1..255] of string; {va contine cuvintele din text}

n,i,k,max: byte;beginwrite(text:); readln(text);

n:=length(text); i:=1; k:=0; {i=indicele in string, k=numar cuvinte, indice in vectorul cuv}while i


37/43

for i:=1 to 255 do if i in c then write(i, );writeln;end.Problema 3var a: array[1..30] of set of byte; x,i,n: byte; c:set of byte;beginwrite(numar multimi ); readln(n);for i:= 1 to n do

begina[i]:=[];

writeln(introduceti elementele multimii ,i, separate de spatiu, terminati cu Enter );read(x);while not eoln do begin a[i]:=a[i]+[x]; read(x); end; {se construieste a i-a multime}end;c:=[0..255]; {c=initial, multimea tuturor valorilor posibile, in final va fi intersectia}for i:= 1 to n do c:=c*a[i];for i:=0 to 255 do if i in c then write(i, );end.Problema 4var cuv, total:set of a..z;

lit:a..z; n:byte; i:integer;beginwrite(numar cuvinte );read(n);

total:=[]; {total va contine literele distincte din toate cuvintele, reuniunea lor}for i:=1 to n do

begincuv:=[]; writeln(cuvantul ,i, :); {se construieste cuvantul }while not eoln do begin read(lit); cuv:=cuv+[lit]; end;total:=total+cuv;writeln(cuvantul introdus are urmatoarele litere distincte:);for lit:=a to z do if lit in cuv then write(lit:3);writeln;end;writeln(litere distincte din toate cuvintele:);for lit:=a to z do if lit in total then write(lit:3);end.

Problema 5{pentru fiecare boala, va trebui sa reunim medicamentele indicate si sa scadem cele contraindicate ; pentruaceasta, la fiecare boala vom forma multimea medicamentelor indicate si cea a celor contraindicate;medicamentele trebuie codificate deoarece tipul de baza al unei multimi nu poate fi string}

Problema 1type melodie=record

titlu: string[20];interpret: string[15];pac: byte;pobt: byte;end;

var top: array[1..100] of melodie; x:melodie; sort:boolean; I,n:byte;beginwrite(n=); readln(n);for i:=1 to n do begin readln(top[I].titlu);readln(top[I].interpret); readln(top[I].pac, top[I].pobt);end;{actualizez punctajul acumulat} for i:=1 to n do top[I].pac:=top[I].pac+top[I].obt;repeat

sort:=true;for i:=1 to n-1 do if top[i].pac


38/43

for i:=1 to 10 do writeln(top[i].titlu:20, top[i].interpret:15);end.

Problema 3type vagon:1..100; {depoul funct. ca o stiva, vom introduce toate vag. in depou si le vom extrage pe toate}var s:array[1..50] of vagon ; n,i,vf: vagon;beginwrite(numarul de vagoane );readln(n);if n>50 then writeln(prea multe vagoane)

elsebeginvf:=0; {initializez stiva}for i:=1 to n do begin inc(vf) ; s[vf]:=i; end;{formez trenul extragand vagoanele din depou}while vf0 do {cat timp depoul nu este gol}

begin write(s[vf], ); dec(vf); end;writeln;end;

end.Problema 5var c:array[1..100] of char;

inceput, sfarsit, lgmax:0..100;p: char; corect:boolean;

beginwriteln(introdu sirul de paranteze );sfarsit:=0; inceput:=1; {initializez coada]corect:=true; lgmax:=0;{lgmax retine lungimea maxima a cozii}repeat

read(p);if p=( then begin {inserez o paranteza deschisa in coada}

inc(sfarsit); c[sfarsit]:=(;if sfarsit/inceput+1>lgmax then lgmax:=sfarsit-inceput+1;end

else if p=) then {verific daca pot extrage un element din stiva}if inceput


39/43

for i:=1 to n do begin a[I,0]:=-1; a[I,m+1]:=-1 end; {bordez matricea a cu obstacole pentru a nu verificafor i:=1 to m do begin a[0,i:=-1; a[n+1,i]:=-1 end; marginile}x.l:=x0; x.c:=y0; x.d:=0; a[x0,y0]:=0;incc:=1; sfc:=1; c[incc]:=x;while inccn);while (i


40/43

Problema 1var a: array [1..40] of byte; i,k,p,j: integer;begin

{se initializeaza a[i] cu 0, de la 1 la 39 si a[40] cu 1}for i:=1 to 39 do a[i]:=0; a[40]:=1;for i:=1 to 50 do begin {i =exponentul puterii lui 2}p:=0; {p=cifra zecilor care va fi adunata lacomponenta urmatoare}for j:=40 downto 1 do begin

a[j]:=a[j]*2+p; if a[j]>10 then begin a[j]:=a[j]-10; p:=1 end;

else p:=0;end;

if i>30 then begin k:=1;repeat {nu afisez zerourile din fata numarului}

if a[k]=0 then inc(k);until a[k]0;

write(2,^,i,=);for j:=k to 40 do write(a[j]);writeln;end;

end;

end.

Problema 1var r: array[1..50,1..50] of byte; {r[i,j]= 0 sau 1 dupa cum i nu cunoaste sau cunoaste pe j}i,j,n,cl,cc: byte; celebr: boolean;

beginwrite(numar persoane=); read(n); celebr:=false; writeln(introduceti relatiile dintre persoane);for i:=1 to n dofor j:=1 to n doif i=j then a[i,i]=1else begin writeln(persoana ,i, cunoaste sau nu persoana ,j,?(1 sau 0)); read(p[i,j]); end;

for i:=1 to n dobegin

cl:=0; cc:=0; {cl=numarul de 0 pe linia i, cc=numarul de 1 de pe coloana i}for j:=1 to n do beginif p[i,j]=0 then inc(cl);if p[j,i]=1 then inc(cc);

end;if (cl=1) and (cc=n) then begin writeln(persoana ,i, este o celebritate); celebr:=true end;end;

if not celebr then writeln(nu exista celebritate);end.

Problema 1var text: string; lc,lmax,poz,i: byte;

beginwrite(text:); readln(text);lc:=1; lmax:=1; poz:=1; {lc=lungimea curenta a secventei de caractere egale, lmax=lungime

maxima, poz=pozitia pimului caracter din secventa solutie}for i:= 1 to length(text)-1 do if text[i]=text[i+1] then inc(lc)

else beginif lc>lmax then begin lmax:=lc; poz:=i+1-lmax; end;lc:=1;end;

if lc>lmax then begin lmax:=lc; poz:=i+1-lmax; end; {test pt. ultima secventa}writeln(cea mai lunga secventa:); for i:= 1 to lmax do write(text[poz]);

40


41/43

end.

Problema 1type elev=record

nume:string[15];n1,n2,n3:byte;end;

var e:array[1..100] of elev; s:array[1..100] of real; n:byte;

procedure tabel;var i:byte;beginfor i:=1 to 30 do write(*); writeln;writeln(*,Nume elev:15, *,Medie:7, *);for i:=1 to 30 do write(*); writeln;

end;procedure citire;

var i:byte;beginwrite(n=); readln(n);

for i:=1 to n do with e[i] do begin readln(nume); readln(n1,n2,n3); s[i]:=(n1+n2+n3)/3 end;end;

procedure scriere;var i:byte;beginfor i:=1 to n do writeln(*,e[i].nume:15, *,s[i]:4:2, *);

end;begincitire; tabel; scriere;end.Problema 2type data=record

nume:string;puncte:byte

end;var x:array[1..100] of data; I,n,a:byte;procedure meniu;

begin

writeln(1.Afisare in ordine alfabetica);writeln(2.Afisare in ordinea descrescatoare a punctajelor);end;

procedure sortare;var sort:boolean; v:data;begin

repeatsort:=true;for i:=1 to n-1 do

if ((x[i].punctex[i+1].nume) and (a=1)) thenbeginv:=x[i]; x[i]:=x[i+1];x[i+1]:=v;

sort:=false;end;

until sort;end;

procedure afisare;begin

writeln(Nume elev:20, punctaj:15);for i:=1 to n do writeln(x[i].nume:20, x[i].puncte:15);

41


42/43

end;beginwrite(n=); readln(n);

for i:=1 to n do begin readln(x[i].nume);readln(x[i].puncte) end;meniu; writeln(Alege 1 sau 2 );sortare; afisare;end.

Problema 1Var x:char; c:integer; f:text;BeginAssign(f,date.int); reset(f);C:=0;

RepeatWhile not eoln(f) do begin read(f,x); write(x) end;

Inc(c); readln(f); writeln;Until eof(f);Writeln(c, linii);Close(f);

end.

Problema 1Var e:string; a,b,c,expr,i:integer; f,g:text;BeginAssign(f,expresie.in); reset(f); Assign(g,expresie.out); rewrite(g);Readln(f,a,b,c); readln(f,e);

expr:=0;for i:=1 to length(e) do

case e[i] ofa: if e[i-1]=- then expr:=expr-a else expr:=expr+a;b: if e[i-1]=- then expr:=expr-b else expr:=expr+b;c: if e[i-1]=- then expr:=expr-c else expr:=expr+c;

End;Writeln(g,expr);Close(f); close(g);End.Problema21Var s:string; max,i, er, c, n:integer; f,g:text;

BeginAssign(f,nrmax.in); reset(f); Assign(g,nrmax.out); rewrite(g);Readln(f,s);Max:=0; n:=0;For i:=1 to length(s) do

if (ord(s[i]>=ord(0)) and (ord(s[i]


43/43

Else begin if max

rezolvariemai_culegere

Documents

Transcript of rezolvariemai_culegere