|
|
|
|
program cn1;
uses crt;
var n:longint;
begin
clrscr;
write('n=');readln(n);
write('Cifrele numarului in ordine inversa sunt ');
while n<>0 do begin
write(n mod 10,' ');
n:=n div 10
end;
readln;
end.
program cn2;
uses crt;
var n:longint;
s,k:integer;
begin
clrscr;
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;
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;
write('n=');readln(n);
prim:=true;
for i:=2 to round(sq 24424k1015y rt(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;
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(sq 24424k1015y rt(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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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 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;
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.
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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 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;
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;
write('n=');readln(n);
write('Termenul de ordin ',n,' din sir este ',fib(n));
readln;
end.
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;
write('a=');readln(a);
write('b=');readln(b);
write('Cmmdc=',cmmdc(a,b));
readln;
end.
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;
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;
write('x=');readln(x);
write('n=');readln(n);
write('Rezultatul este ',putere(x,n));
readln;
end.
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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('');
writeln
end;
function valid:boolean;
begin
valid:=true
end;
begin
clrscr;
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;
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;
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;
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);
var ii,jj:integer;
k:byte;
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;
write('n=');readln(n);
for i:=1 to n do
for j:=1 to n do t[1,j]:=0;
t[1,1]:=1;
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;
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;
begin
write('informatia care se sterge...');readln(inf);
c:=prim;
while c^.inf<>inf do c:=c^.urm;
c^.ant^.urm:=c^.urm;
c^.urm^.ant:=c^.ant;
dispose(c)
end;
procedure l_stanga_dreapta;
var c:ref;
begin
c:=prim;
while c<>nil do begin
write(c^.inf,' ');
c:=c^.urm
end;
writeln
end;
procedure l_dreapta_stanga;
var c:ref;
begin
c:=ultim;
while c<>nil do begin
write(c^.inf,' ');
c:=c^.ant
end
end;
begin
clrscr;
writeln('Se creaza lista');
creare;
l_stanga_dreapta;
a_dreapta;
l_stanga_dreapta;
a_stanga;
l_stanga_dreapta;
a_interior;
l_stanga_dreapta;
writeln('Se sterge ultimul element');
s_ultim;
l_stanga_dreapta;
writeln('Se sterge primul element');
s_prim;
l_stanga_dreapta;
s_interior;
l_stanga_dreapta;
writeln('Se listeaza de la dreapta la stanga');
l_dreapta_stanga;
readln;
end.
program l3;
uses crt;
type ref=^inr;
inr=record inf:char;
urm:ref
end;
var v:ref;
n,i:integer;
procedure adaug;
var c:ref;
inf:char;
begin
write('caracter=');readln(inf);
new(c);
c^.inf:=inf;
c^.urm:=v;
v:=c
end;
procedure scot;
var c:ref;
begin
if v=nil then writeln('Lista e vida')
else begin
c:=v;
v:=v^.urm;
dispose(c)
end
end;
procedure listare;
var c:ref;
begin
c:=v;
while c<>nil do begin
write(c^.inf,' ');
c:=c^.urm
end
end;
begin
clrscr;
write('Cate elemente adaugati?');readln(n);
for i:=1 to n do adaug;
write('Cate elemente scoateti?');readln(n);
for i:=1 to n do scot;
listare;
readln;
end
program l4;
uses crt;
type ref=^inr;
inr=record inf:char;
urm:ref
end;
var prim,ultim:ref;
n,i:integer;
procedure adaug;
var c:ref;
inf:char;
begin
write('caracter=');readln(inf);
new(c);
c^.inf:=inf;
c^.urm:=nil;
if ultim=nil then begin
prim:=c;
ultim:=c
end
else begin
ultim^.urm:=c;
ultim:=c
end
end;
procedure scot;
var c:ref;
begin
if prim=nil then writeln('Coada este vida')
else if prim=ultim then begin
c:=prim;
prim:=nil;
ultim:=nil;
dispose(c)
end
else begin
c:=prim;
prim:=prim^.urm;
dispose(c)
end
end;
procedure listare;
var c:ref;
begin
c:=prim;
while c<>nil do begin
write(c^.inf,' ');
c:=c^.urm
end
end;
begin
clrscr;
write('Cate elemente adaugati in coada? ');readln(n);
for i:=1 to n do adaug;
write('Cate elemente scoateti din coada? ');readln(n);
for i:=1 to n do scot;
listare;
readln;
end.
|
