EXERCITII DE ARITMETICA

Exercitiul 1

Sa se determine daca un numar introdus de la tastatura este numar prim sau nu.

Solutie Conditia suficienta ca un numar n sa fie prim este ca acesta sa nu se divida cu nici un alt numar din intervalul 1..[].

program nr_prim;

uses crt;

var

n:word;

a:real;

i,m:word;

prim:boolean;

begin

clrscr;

write('Introduceti numarul pentru test ');

readln(n);

prim:=true;

a:=n;

m:=trunc(sqrt(a));

i:=2;

while(i<=m) and prim do

if (n mod i) = 0 then prim:=false

else i:=i+1;

if prim then writeln('Numarul este prim')

else writeln('Numarul nu este prim');

readln;

end.

Exercitiul 2

Sa se determine suma si produsul a doua polinoame.

Solutie: Fie polinoamele p₁, p₂ cu deg(p_i)=grad_i, i=1..2 si grad=max(grad₁, grad₂). Suma celor doua polinoame se calculeaza dupa formula: suma[i]= p₁[i]+p₂[i], i=1..grad (daca unul din gradele celor doua polinoame este strict inferior lui grad, coeficientii "lipsa" sunt 0). Produsul celor doua polinoame se calculeaza dupa formula:

, i=0..grad₁+grad₂.

Polinoamele sunt reprezentate prin vectorii coeficientilor cores-punzatori. Gradele polinoamelor, precum si coeficientii corespunzatori vor fi introdusi de la tastatura.

program polinoame;

uses crt;

var

p1,p2,suma,produs:array[0..40] of integer;

i,j,grad1,grad2,grad: integer;

procedure sumapol;

var k:integer;

begin

for k:=0 to grad do

suma[k]:=p1[k]+p2[k]

end;

procedure produspol;

var k,l,prod:integer;

begin

for k:=0 to grad1+grad2 do

begin

prod:=0;

for l:=0 to k do

prod:=prod+p1[l]*p2[k-l];

produs[k]:=prod

end

end;

begin

clrscr;

write('Dati gradul maxim al polonmului1 '); readln(grad1);

write('Dati coeficientii primului polinom ');

for i:=0 to grad1 do readln(p1[i]);

write('Dati gradul maxim al celui de-al doilea polinom'); readln(grad2);

write('Dati coeficientii celui de-al doilea polinom ');

for i:=0 to grad2 do read(p2[i]);

if grad1>grad2 then grad:= grad1

else grad:=grad2;

sumapol;

produspol;

writeln('Suma polinoamelor este: ');

for i:=0 to grad-1 do

if( suma[i+1]>=0)then write(suma[i],'*X^',i,'+')

else write(suma[i],'*X^',i);

writeln(suma[grad],'*X^',grad);

writeln('Produsul polinoamelor este: ');

for i:=0 to grad1+grad2-1 do

if( produs[i+1]>=0)then write(produs[i],'*X^',i,'+')

else write(produs[i],'*X^',i);

writeln(produs[grad1+grad2],'*X^',grad1+grad2);

end.

Exercitiul 3

Sa se genereze toate permutarile multimii , unde n este un numar natural citit de la tastatura, n

Solutie: Problema va fi rezolvata utilizandu-se metoda backtracking. Forma standard a acestei metode se aplica problemelor in care trebuie gasit un vector x=(x₁, x₂, , x_n) din spatiul solutiilor S=S₁ S₂ S_n unde, pentru orice 1 i n, S_i = s_i (numar finit de elemente) si pe S_i este definita o relatie de ordine, iar x reprezinta solutia rezultat satisfacand conditiile interne corespunzatoare problemei. Ca variante de iesiri sunt posibile cazurile: o singura solutie rezultat, toate solutiile rezultat (in probleme de generare asemanatoare celei propuse), o solutie rezultat care optimizeaza (minim sau maxim) un criteriu f:S R.

Constructia unei solutii se face astfel:

se presupun determinate la momentul curent x₁, x₂, , x_k;

daca secventa anterior calculata satisface conditiile de continuare specifice problemei (daca exista sansa de a se obtine o solutie rezultat) se alege x_k+1 I S_k+1

altfel, daca x_k are succesor in S_k, x_k succ(x_k)

altfel, daca x_k nu are succesor in S_k, se procedeaza in aceeasi maniera cu "resatisfacerea" lui x_k-1.

Procedura generala de calcul este urmatoarea:

procedure back(k:byte);

begin

if k=n+1 then final

else

begin

x[k]:=init(k);

while succ(k) do

if continuare(k) then back(k+1);

end;

end;

in care:

final este o procedura specifica momentului in care s-a determinat o solutie rezultat x (se afiseaza rezultatul, se testeaza o functie criteriu pentru solutia obtinuta, aceasta selectandu-se doar in anumite conditii de optim samd);

init(k) este o functie de initializare a lui x_k cu predecesorulu primului element din S_k;

succ(k) este o functie booleana care testeaza existenta succesorului lui x_k in S_k si daca acest lucru este posibil se inlocuieste x_k cu succesorul lui din S_k;

continuare(k) este o functie booleana care testeaza conditiile de continuare (daca secventa determinata pana la momentul curent poate duce la o solutie rezultat).

In continuare este prezentata problema generarii tuturor permutarilor multimii aplicandu-se exact metoda generala si tinandu-se cont de urmatoarele aspecte:

S₁ = S₂ = = S_n = (deci functia init nu depinde de nici un parametru, intorcand valoarea 0 indiferent de indicele elementului de initializat);

conditia ca secventa sa fie una corecta pentru a se initia generarea lui x_k+1 (stiind ca este corecta) este cea data de definitia unei permutari: x_k

Programul Pascal este:

program permutare;

uses crt;

type tip_elem=0..7;

var x:array[1..7] of tip_elem;

n:byte;

function init:byte;

begin

init:=0;

end;

function succ(k:byte):boolean;

begin

succ:=x[k]<n; inc(x[k]);

end;

function continuare(k:byte):boolean;

var i:byte;

begin

i:=1;

while(i<k)and(x[i]<>x[k]) do inc(i);

continuare:=i=k;

end;

procedure final;

var i:byte;

begin

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

readln;

end;

procedure back(k:byte);

begin

if k=n+1 then final

else

begin

x[k]:=init;

while succ(k) do

if continuare(k) then back(k+1);

end;

end;

begin

clrscr;

write('Numarul de elemente al permutarii: ');

readln(n);

back(1);

end.

Dupa cum se poate remarca, unele din opera]iile precedente (cum ar fi functia init, lucrul cu functia succ in conditiile in care S₁ = S₂ = =S_n = ) pot fi reformulate intr-o maniera ce simplifica scrierea programului. De exemplu, o alta varianta corecta de rezolvare este:

program permutare_1;

uses crt;

type tip_elem=0..7;

var x:array[1..7] of tip_elem;

n:byte;

procedure final;

var i:byte;

begin

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

readln;

end;

function continuare(k:byte):boolean;

var i:byte;

begin

i:=1;

while(i<k)and(x[i]<>x[k]) do inc(i);

continuare:=i=k;

end;

procedure back(k:byte);

var i:byte;

begin

if k=n+1 then final

else

for i:=1 to n do

begin

x[k]:=i;

if continuare(k) then back(k+1);

end;

end;

begin

clrscr;

write('Numarul de elemente al permutarii: ');

readln(n);

back(1);

end.

Problema 5 Sa se scrie programul Pascal pentru generarea tuturor submultimilor multimii , unde n este un numar natural citit de la tastatura, n

Solutie Se vor genera, prin metoda backtracking, toate submultimile cu k elemente, 1 k n. Modul de reprezentare a unei submultimi SubS a lui S (privite ca vectori) este:

Conditiile de continuare sunt cele ce caracterizeaza o submultime a unei multimi, momentul terminarii generarii unei solutii - o submultime cu k elemente - sesizandu-se cand suma elementelor vectorului generat este k. In momentul determinarii unei submultimi, aceasta este trecuta intr-un vector, generandu-se astfel P().

Programul Pascal este:

program submultime;

type elem=0..1;

sub=array[1..10] of elem;

var

n,dim:byte;

x:sub;

tot:array[1..200] of sub;

k,j:integer;

nr:byte;

function suma(t,k:byte):boolean;

var

s,i:byte;

begin

s:=0;

for i:=1 to t do s:=s+x[i];

if s<=k then suma:=true

else suma:=false;

end;

function sumaf:byte;

var

s,i:byte;

begin

s:=0;

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

sumaf:=s;

end;

procedure back(k,t:byte);

var

i:byte;

begin

if (t=n+1) then

if(sumaf=k) then

begin

inc(nr);

for i:=1 to n do tot[nr][i]:=x[i];

end

else

else

for i:=2 downto 1 do

begin

x[t]:=i-1;

if suma(t,k) then back(k,t+1);

end;

end;

begin

readln(n);

nr:=0;

for dim:=1 to n do back(dim,1);

writeln('Submultimile sunt:');

for k:=1 to nr do

begin

for j:=1 to n do

if tot[k][j]=1 then write(j,' ');

writeln;

end;

end.

Problema 6 Sa se realizeze un unit care sa cuprinda subprograme pentru:

a) calculul vectorului medie pentru o selectie data de vectori aleatori;

b) calculul matricei de covarianta pentru o selectie data de vectori aleatori;

c) calculul matricei de autocorelatie pentru o selectie data de vectori aleatori;

d) determinarea valorilor si vectorilor proprii corespunzatori matricei de covarianta calculata pe o selectie data de vectori aleatori.

Solutie Fie X un vector aleator cu medie m si matrice de covarianta S, o selectie bernoulliana de volum m asupra lui X.

media de selectie se calculeaza astfel: ;

matricea de covarianta de selectie se calculeaza dupa formula: ;

matricea de autocorelatie de selectie este data prin formula: ;

cum matricea de covarianta de selectie este simetrica si pozitiv definita, rezulta ca se poate aplica algoritmul lui Jacobi [citarea algoritmului]; valorile proprii vor fi reale, pozitive, iar vectorii proprii vor avea cu componente reale.

Unit-ul complet este:

unit stat;

interface

type vect_ra=array[1..30] of real;

selectie=array[1..50] of vect_ra;

matrice=array[1..30,1..30] of real;

procedure media(var s:selectie; var med:vect_ra;dim_v,vol_sel:byte);

procedure covarianta(var s:selectie;var sigma:matrice;dim_v,vol_sel:byte);

procedure autocorelatie(var s:selectie;var auto:matrice;dim_v,vol_sel:byte);

procedure vect_val_pr(var sel:selectie;var val_pr:vect_ra; var vect_pr: matrice; dim_v, vol_sel:byte; eps:real; itmax:word);

implementation

procedure media;

var

i,j:byte;

begin

for i:=1 to dim_v do

begin

med[i]:=0;

for j:=1 to vol_sel do

med[i]:=med[i]+s[j][i];

med[i]:=med[i]/vol_sel;

end;

end;

procedure covarianta;

var

i,j,k:byte;

medie:vect_ra;

begin

media(s,medie,dim_v,vol_sel);

for i:=1 to dim_v do

for j:=1 to dim_v do

begin

sigma[i,j]:=0;

for k:=1 to vol_sel do

sigma[i,j]:=sigma[i,j]+(s[k][i]-medie[i])*(s[k][j]-medie[j]);

sigma[i][j]:=sigma[i,j]/(vol_sel-1);

end;

end;

procedure autocorelatie;

var

i,j,k:byte;

begin

for i:=1 to dim_v do

for j:=1 to dim_v do

begin

auto[i,j]:=0;

for k:=1 to vol_sel do

auto[i,j]:=auto[i,j]+s[k][i]*s[k][j];

auto[i][j]:=auto[i,j]/vol_sel;

end;

end;

procedure vect_val_pr;

var

i,it,j,k:byte;

aii,aji,ajj,amax,c,c1,s,t,inter,inter1:real;

sigma:matrice;

begin

it:=0;

covarianta(sel,sigma,dim_v,vol_sel);

for i:=1 to dim_v do

begin

for j:=1 to dim_v do

vect_pr[i][j]:=0;

vect_pr[i][i]:=1;

val_pr[i]:=sigma[i,i];

end;

amax:=1;

while((amax>eps)and(it<itmax)) do

begin

inc(it);amax:=0;

for j:=2 to dim_v do

for i:=1 to j-1 do

begin

aii:=val_pr[i];ajj:=val_pr[j];

aji:=abs(sigma[j,i]);

if(amax<aji) then amax:=aji;

if(aji>eps) then

begin

c:=0.5*(aii-ajj)/sigma[j,i];

t:=1/(abs(c)+sqrt(1+c*c));

if c<0 then t:=-t;

c:=1/sqrt(1+t*t);s:=c*t;

for k:=1 to i-1 do

begin

t:=sigma[i,k]*c+sigma[j,k]*s;

sigma[j,k]:=sigma[j,k]*c-sigma[i,k]*s;

sigma[i,k]:=t;

end;

for k:=i+1 to j-1 do

begin

t:=sigma[k,i]*c+sigma[j,k]*s;

sigma[j,k]:=sigma[j,k]*c-sigma[k,i]*s;

sigma[k,i]:=t;

end;

for k:=j+1 to dim_v do

begin

t:=sigma[k,i]*c+sigma[k,j]*s;

sigma[k,j]:=sigma[k,j]*c-sigma[k,i]*s;

sigma[k,i]:=t;

end;

for k:=1 to dim_v do

begin

t:=vect_pr[k,i]*c+vect_pr[k,j]*s;

vect_pr[k,j]:=vect_pr[k,j]*c-vect_pr[k,i]*s;

vect_pr[k,i]:=t;

end;

t:=2*s*c*sigma[j,i];

val_pr[i]:=aii*c*c+ajj*s*s+t;

val_pr[j]:=aii*s*s+ajj*c*c-t;

sigma[j,i]:=0;

end;

end;

end;

for i:=1 to dim_v-1 do

for j:=i+1 to dim_v do

if(val_pr[i]<val_pr[j]) then

begin

inter:=val_pr[i];val_pr[i]:=val_pr[j];val_pr[j]:=inter;

for k:=1 to dim_v do

begin

inter1:=vect_pr[k,i];

vect_pr[k,i]:=vect_pr[k,j];

vect_pr[k,j]:=inter1;

end;

end;

end;

end.

Probleme propuse

1. Sa se scrie programul Pascal pentru determinarea celui mai mic multiplu comun al doua numere.

2. Sa se scrie un subprogram Pascal pentru a decide daca doua numere naturale sunt prime intre ele.

3. Sa se scrie programul Pascal pentru generarea tuturor numerelor prime mai mici decat n, n citit de la tastatura.

4. Sa se scrie un subprogram Pascal pentru calculul celui mai mare divizor comun a n numere naturale, n

5. Sa se scrie un subprogram Pascal pentru descompunerea unui numar natural in factori primi.

6. Sa se scrie programul Pascal pentru generarea tuturor combinarilor de k elemente ale unei multimi de n elemente, n k.

7. Sa se scrie un subprogram Pascal pentru calculul valorii unui polinom intr-un punct dat.

8. Sa se scrie un subprogram Pascal pentru calculul derivatei unui polinom.

9. Sa se scrie un subprogram Pascal pentru determinarea compunerii a doua polinoa-me.

10. Utilizand algoritmul lui Euclid, sa se scrie subprogramele Pascal pentru determinarea celui mai mare divizor comun si a celui mai mic multiplu comun pentru doua polinoame.

11. Sa se realizeze programul Pascal pentru calculul polinomului de interpolare Lagrange pentru un set de perechi citite de la tastatura.

program gaussexp;

uses crt;

var csi,o,z,z0:real;

i:integer;

procedure norm01(var z:real);

var suma:real;

i:integer;

begin

suma:=0;

for i:=1 to 12 do

suma:=suma+random;

suma:=suma-6;

z:=suma;

end;

begin

clrscr;

randomize;

for i:=1 to 100 do

begin

readln(o);

norm01(z0);

norm01(csi);

z:=o*z0+sqrt(1-o*o)*csi;

writeln(z);

end;

end.

program gauss;

uses crt;

var v:array[1..100] of real;

x,a:real;

i,n,p:integer;

begin

clrscr;

randomize;

readln(a,n,p);

for i:=1 to n do v[i]:=random;

for i:=1 to n-p do v[i]:=v[i+p];

x:=0;

for i:=1 to n-p do

x:=x+v[i];

for i:=1 to p do

v[n-p+i]:=-a+2*a*random;

for i:=n-p+1 to n do

x:=x+v[i];

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

end.

program gener;

uses crt;

var

f1:text;

q,u1,v:real;

i,n,j,l:integer;

function fp(m:real):integer;

var

u,s,p:real;

k:integer;

begin

k:=0;p:=exp(-m);

u:=random;

s:=p;

while u>s do begin

k:=k+1;

p:=p*m/k;

s:=s+p;

end;

fp:=k;

end;

begin

writeln('Dati q ');

readln(q);

writeln('Dati numarul generarilor ');

readln(l);

assign(f1,'as.txt');

rewrite(f1);

randomize;

for j:=1 to l do begin

n:=fp(q*3.14);

writeln(n);

for i:=1 to n do begin

repeat

u1:=2*random-1;

v:=2*random-1;

until u1*u1+v*v<=1;

writeln(f1,' ',u1,' ',v);

end;

end;

close(f1);

writeln;

end.

program Gslaca;

uses crt;

var x,y,s:real;

z:array[1..2] of real;

i:integer;

procedure expon(var x:real);

begin

x:=-ln(random)/0.3;

end;

function fct(x:real):real;

begin

fct:=1.2/(1+exp(-x))

end;

begin

randomize;

clrscr;

s:=0;

repeat

for i:=1 to 2 do

begin

expon(x);

z[i]:=1-fct(x)

end;

s:=s+random;

if (z[i]>1) then exit

else begin

y:=(1-z[i])/z[i];

x:=y*x;

end;

writeln(x) ;write(#7);

until (readkey='q') or (s>4);

end.

program Markov;

uses crt;

var

a,b:real;

F,P:array[1..2,1..2] of real;

i,j,k:integer;

suma,U:real;

begin

clrscr;

readln(a);

readln(b);

if((a>=1)or(a<=0)or(b>=1)or(b<=0)) then begin

writeln('Date incorecte!');

exit;

end;

P[1,1]:=a;P[1,2]:=1-a;

P[2,1]:=1-b;P[2,2]:=b;

for i:=1 to 2 do begin

suma:=0;

for j:=1 to 2 do begin

for k:=1 to j do

suma:=suma+P[i,k];

F[i,j]:=suma;

end;

end;

j:=1;

randomize;

U:=random;

i:=1;

while (F[i,j]<=U) do j:=j+1;

writeln('S-a generat starea ',j-1);

end.

program poisson1;

uses crt;

var

l,x0,x:real;

n:integer;

begin

clrscr;

randomize;

readln(l,x0);

x:=0;n:=0;

while x<=x0 do

begin

x:=x-(1/l)*ln(1-random);

n:=n+1;

writeln(x,' ',n);

end;

end.

program poisson2;

uses crt;

var

l,x0,x,y0,y:real;

n:integer;

begin

clrscr;

randomize;

readln(l,x0,y0);

x:=0;n:=0;

while x<=x0 do

begin

x:=x-(1/l)*ln(1-random);

y:=random*y0;

n:=n+1;

writeln(x,' ',y,' ',n);

end;

end.

EXERCITII DIVERSE

Exercitiul 1

Sa se determine daca un numar introdus de la tastatura este prim sau nu.

Solutie: Conditia suficienta ca un numar n sa fie prim este ca acesta sa nu se divida cu nici un alt numar din intervalul 1..[].

program nr_prim;

uses crt;

var

n:word;

a:real;

i,m:word;

prim:boolean;

begin

clrscr;

write('Introduceti numarul pentru test ');

readln(n);

prim:=true;

a:=n;

m:=trunc(sqrt(a));

i:=2;

while(i<=m) and prim do

if (n mod i) = 0 then prim:=false

else i:=i+1;

if prim then writeln('Numarul este prim')

else writeln('Numarul nu este prim');

readln;

end.

Exercitiul 2

Sa se determine suma si produsul a doua polinoame.

Solutie: Fie polinoamele p₁, p₂ cu deg(p_i)=grad_i, i=1..2 si grad=max(grad₁, grad₂). Suma celor doua polinoame se calculeaza dupa formula: suma[k]= p₁[k]+p₂[k], k=1..grad (daca unul din gradele celor doua polinoame este strict inferior lui grad, coeficientii "lipsa" sunt 0). Produsul celor doua polinoame se calculeaza dupa formula:

, k=0..grad₁+grad₂.

Polinoamele sunt reprezentate prin vectorii coeficientilor cores-punzatori. Gradele polinoamelor, precum si coeficientii corespunzatori vor fi introdusi de la tastatura.

program polinoame;

uses crt;

var

p1,p2,suma,produs:array[0..40] of integer;

i,j,grad1,grad2,grad: integer;

procedure sumapol;

var k:integer;

begin

for k:=0 to grad do

suma[k]:=p1[k]+p2[k]

end;

procedure produspol;

var k,l,prod:integer;

begin

for k:=0 to grad1+grad2 do

begin

prod:=0;

for l:=0 to k do

prod:=prod+p1[l]*p2[k-l];

produs[k]:=prod

end

end;

begin

clrscr;

write('Dati gradul maxim al polonmului1 '); readln(grad1);

write('Dati coeficientii primului polinom ');

for i:=0 to grad1 do readln(p1[i]);

write('Dati gradul maxim al celui de-al doilea polinom'); readln(grad2);

write('Dati coeficientii celui de-al doilea polinom ');

for i:=0 to grad2 do read(p2[i]);

if grad1>grad2 then grad:= grad1

else grad:=grad2;

sumapol;

produspol;

writeln('Suma polinoamelor este: ');

for i:=0 to grad-1 do

if( suma[i+1]>=0)then write(suma[i],'*X^',i,'+')

else write(suma[i],'*X^',i);

writeln(suma[grad],'*X^',grad);

writeln('Produsul polinoamelor este: ');

for i:=0 to grad1+grad2-1 do

if( produs[i+1]>=0)then write(produs[i],'*X^',i,'+')

else write(produs[i],'*X^',i);

writeln(produs[grad1+grad2],'*X^',grad1+grad2);

end.

Exercitiul 3

Sa se genereze toate permutarile multimii , unde n este un numar natural citit de la tastatura, n

Solutie: Problema va fi rezolvata utilizandu-se metoda backtracking. Forma standard a acestei metode se aplica problemelor in care trebuie gasit un vector x=(x₁, x₂, , x_n) din spatiul solutiilor S=S₁ S₂ S_n unde, pentru orice 1 i n, S_i = s_i (numar finit de elemente) si pe S_i este definita o relatie de ordine, iar x reprezinta solutia rezultat satisfacand conditiile interne corespunzatoare problemei. Ca variante de iesiri sunt posibile cazurile: o singura solutie rezultat, toate solutiile rezultat (in probleme de generare asemanatoare celei propuse), o solutie rezultat care optimizeaza (minim sau maxim) un criteriu f:S R.

Constructia unei solutii se face astfel:

se presupun determinate la momentul curent x₁, x₂, , x_k;

daca secventa anterior calculata satisface conditiile de continuare specifice problemei (daca exista sansa de a se obtine o solutie rezultat) se alege x_k+1 I S_k+1

altfel, daca x_k are succesor in S_k, x_k succ(x_k)

altfel, daca x_k nu are succesor in S_k, se procedeaza in aceeasi maniera cu "resatisfacerea" lui x_k-1.

Procedura generala de calcul este urmatoarea:

procedure back(k:byte);

begin

if k=n+1 then final

else

begin

x[k]:=init(k);

while succ(k) do

if continuare(k) then back(k+1);

end;

end;

in care:

final este o procedura specifica momentului in care s-a determinat o solutie rezultat x (se afiseaza rezultatul, se testeaza o functie criteriu pentru solutia obtinuta, aceasta selectandu-se doar in anumite conditii de optim s.a.m.d.);

init(k) este o functie de initializare a lui x_k cu predecesorulu primului element din S_k;

succ(k) este o functie booleana care testeaza existenta succesorului lui x_k in S_k si, daca acest lucru este posibil, se inlocuieste x_k cu succesorul lui din S_k;

continuare(k) este o functie booleana care testeaza conditiile de continuare (daca secventa determinata pana la momentul curent poate duce la o solutie rezultat).

In continuare este prezentata problema generarii tuturor permutarilor multimii aplicandu-se exact metoda generala si tinandu-se cont de urmatoarele aspecte:

S₁ = S₂ = = S_n = (deci functia init nu depinde de nici un parametru, intorcand valoarea 0 indiferent de indicele elementului de initializat);

conditia ca secventa sa fie una corecta pentru a se initia generarea lui x_k+1 (stiind ca este corecta) este cea data de definitia unei permutari: x_k

Programul Pascal este:

program permutare;

uses crt;

type tip_elem=0..7;

var x:array[1..7] of tip_elem;

n:byte;

function init:byte;

begin

init:=0;

end;

function succ(k:byte):boolean;

begin

succ:=x[k]<n; inc(x[k]);

end;

function continuare(k:byte):boolean;

var i:byte;

begin

i:=1;

while(i<k)and(x[i]<>x[k]) do inc(i);

continuare:=i=k;

end;

procedure final;

var i:byte;

begin

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

readln;

end;

procedure back(k:byte);

begin

if k=n+1 then final

else

begin

x[k]:=init;

while succ(k) do

if continuare(k) then back(k+1);

end;

end;

begin

clrscr;

write('Numarul de elemente al permutarii: ');

readln(n);

back(1);

end.

Dupa cum se poate remarca, unele din operatiile precedente (cum ar fi functia init, lucrul cu functia succ in conditiile in care S₁ = S₂ = =S_n = ) pot fi reformulate intr-o maniera ce simplifica scrierea programului. De exemplu, o alta varianta corecta de rezolvare este:

program permutare_1;

uses crt;

type tip_elem=0..7;

var x:array[1..7] of tip_elem;

n:byte;

procedure final;

var i:byte;

begin

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

readln;

end;

function continuare(k:byte):boolean;

var i:byte;

begin

i:=1;

while(i<k)and(x[i]<>x[k]) do inc(i);

continuare:=i=k;

end;

procedure back(k:byte);

var i:byte;

begin

if k=n+1 then final

else

for i:=1 to n do

begin

x[k]:=i;

if continuare(k) then back(k+1);

end;

end;

begin

clrscr;

write('Numarul de elemente al permutarii: ');

readln(n);

back(1);

end.

Exercitiul 4

Sa se scrie programul Pascal pentru generarea tuturor submultimilor multimii , unde n este un numar natural citit de la tastatura, n

Solutie: Se vor genera, prin metoda backtracking, toate submultimile cu k elemente, 1 k n. Modul de reprezentare a unei submultimi SubS a lui S (privite ca vectori) este:

Conditiile de continuare sunt cele ce caracterizeaza o submultime a unei multimi, momentul terminarii generarii unei solutii - o submultime cu k elemente - sesizandu-se cand suma elementelor vectorului generat este k. In momentul determinarii unei submultimi, aceasta este trecuta intr-un vector, generandu-se astfel P().

Programul Pascal este:

program submultime;

type elem=0..1;

sub=array[1..10] of elem;

var

n,dim:byte;

x:sub;

tot:array[1..200] of sub;

k,j:integer;

nr:byte;

function suma(t,k:byte):boolean;

var

s,i:byte;

begin

s:=0;

for i:=1 to t do s:=s+x[i];

if s<=k then suma:=true

else suma:=false;

end;

function sumaf:byte;

var

s,i:byte;

begin

s:=0;

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

sumaf:=s;

end;

procedure back(k,t:byte);

var

i:byte;

begin

if (t=n+1) then

if(sumaf=k) then

begin

inc(nr);

for i:=1 to n do tot[nr][i]:=x[i];

end

else

else

for i:=2 downto 1 do

begin

x[t]:=i-1;

if suma(t,k) then back(k,t+1);

end;

end;

begin

readln(n);

nr:=0;

for dim:=1 to n do back(dim,1);

writeln('Submultimile sunt:');

for k:=1 to nr do

begin

for j:=1 to n do

if tot[k][j]=1 then write(j,' ');

writeln;

end;

end.

Exercitiul 5

Sa se realizeze o unitate Pascal care sa cuprinda subprograme pentru rezolvarea urmatoarelor operatii:

calculul vectorului medie pentru o selectie data de vectori aleatori;

calculul matricei de covarianta pentru o selectie data de vectori aleatori;

calculul matricei de autocorelatie pentru o selectie data de vectori aleatori;

determinarea valorilor si vectorilor proprii corespunzatori matricei de covarianta calculata pe o selectie data de vectori aleatori.

Solutie: Fie X un vector aleator cu medie m si matrice de covarianta S, o selectie bernoulliana de volum m asupra lui X.

media de selectie se calculeaza astfel: ;

matricea de covarianta de selectie se calculeaza dupa formula: ;

matricea de autocorelatie de selectie este data prin formula: ;

cum matricea de covarianta de selectie este simetrica si pozitiv definita, rezulta ca se poate aplica algoritmul lui Jacobi [citarea algoritmului]; valorile proprii vor fi reale, pozitive, iar vectorii proprii vor avea componente reale.

Unitatea completa este:

unit stat;

interface

type vect_ra=array[1..30] of real;

selectie=array[1..50] of vect_ra;

matrice=array[1..30,1..30] of real;

procedure media(var s:selectie; var

med:vect_ra;dim_v,vol_sel:byte);

procedure covarianta(var s:selectie;var

sigma:matrice;dim_v,vol_sel:byte);

procedure autocorelatie(var s:selectie;var

auto:matrice;dim_v,vol_sel:byte);

procedure vect_val_pr(var sel:selectie;var val_pr:vect_ra;

var vect_pr: matrice; dim_v, vol_sel:byte; eps:real; itmax:word);

implementation

procedure media;

var i,j:byte;

begin

for i:=1 to dim_v do

begin

med[i]:=0;

for j:=1 to vol_sel do

med[i]:=med[i]+s[j][i];

med[i]:=med[i]/vol_sel;

end;

end;

procedure covarianta;

var

i,j,k:byte;

medie:vect_ra;

begin

media(s,medie,dim_v,vol_sel);

for i:=1 to dim_v do

for j:=1 to dim_v do

begin

sigma[i,j]:=0;

for k:=1 to vol_sel do

sigma[i,j]:=sigma[i,j]+

(s[k][i]-medie[i])*(s[k][j]-medie[j]);

sigma[i][j]:=sigma[i,j]/(vol_sel-1);

end;

end;

procedure autocorelatie;

var

i,j,k:byte;

begin

for i:=1 to dim_v do

for j:=1 to dim_v do

begin

auto[i,j]:=0;

for k:=1 to vol_sel do

auto[i,j]:=auto[i,j]+s[k][i]*s[k][j];

auto[i][j]:=auto[i,j]/vol_sel;

end;

end;

procedure vect_val_pr;

var

i,it,j,k:byte;

aii,aji,ajj,amax,c,c1,s,t,inter,inter1:real;

sigma:matrice;

begin

it:=0;

covarianta(sel,sigma,dim_v,vol_sel);

for i:=1 to dim_v do

begin

for j:=1 to dim_v do

vect_pr[i][j]:=0;

vect_pr[i][i]:=1;

val_pr[i]:=sigma[i,i];

end;

amax:=1;

while((amax>eps)and(it<itmax)) do

begin

inc(it);amax:=0;

for j:=2 to dim_v do

for i:=1 to j-1 do

begin

aii:=val_pr[i];ajj:=val_pr[j];

aji:=abs(sigma[j,i]);

if(amax<aji) then amax:=aji;

if(aji>eps) then

begin

c:=0.5*(aii-ajj)/sigma[j,i];

t:=1/(abs(c)+sqrt(1+c*c));

if c<0 then t:=-t;

c:=1/sqrt(1+t*t);s:=c*t;

for k:=1 to i-1 do

begin

t:=sigma[i,k]*c+sigma[j,k]*s;

sigma[j,k]:=sigma[j,k]*c-sigma[i,k]*s;

sigma[i,k]:=t;

end;

for k:=i+1 to j-1 do

begin

t:=sigma[k,i]*c+sigma[j,k]*s;

sigma[j,k]:=sigma[j,k]*c-sigma[k,i]*s;

sigma[k,i]:=t;

end;

for k:=j+1 to dim_v do

begin

t:=sigma[k,i]*c+sigma[k,j]*s;

sigma[k,j]:=sigma[k,j]*c-sigma[k,i]*s;

sigma[k,i]:=t;

end;

for k:=1 to dim_v do

begin

t:=vect_pr[k,i]*c+vect_pr[k,j]*s;

vect_pr[k,j]:=vect_pr[k,j]*c-

vect_pr[k,i]*s;

vect_pr[k,i]:=t;

end;

t:=2*s*c*sigma[j,i];

val_pr[i]:=aii*c*c+ajj*s*s+t;

val_pr[j]:=aii*s*s+ajj*c*c-t;

sigma[j,i]:=0;

end;

end;

end;

for i:=1 to dim_v-1 do

for j:=i+1 to dim_v do

if(val_pr[i]<val_pr[j]) then

begin

inter:=val_pr[i];val_pr[i]:=val_pr[j];val_pr[j]:=inter;

for k:=1 to dim_v do

begin

inter1:=vect_pr[k,i];

vect_pr[k,i]:=vect_pr[k,j];

vect_pr[k,j]:=inter1;

end;

end;

end;

end.

Exercitii propuse

1. Sa se scrie programul Pascal pentru determinarea celui mai mic multiplu comun al n numere.

2. Sa se scrie un subprogram Pascal pentru a decide daca doua numere naturale sunt prime intre ele.

3. Sa se scrie programul Pascal pentru generarea tuturor numerelor prime mai mici decat n, n citit de la tastatura.

4. Sa se scrie un subprogram Pascal pentru calculul celui mai mare divizor comun a n numere naturale, n

5. Sa se scrie un subprogram Pascal pentru descompunerea unui numar natural in factori primi.

6. Sa se scrie programul Pascal pentru generarea tuturor combinarilor de k elemente ale unei multimi de n elemente, n k

7. Sa se scrie un subprogram Pascal pentru calculul valorii unui polinom intr-un punct dat.

8. Sa se scrie un subprogram Pascal pentru calculul derivatei unui polinom.

9. Sa se scrie un subprogram Pascal pentru determinarea compunerii a doua polinoame.

10. Utilizand algoritmul lui Euclid, sa se scrie subprogramele Pascal pentru determinarea celui mai mare divizor comun si a celui mai mic multiplu comun pentru doua polinoame.

11. Sa se realizeze programul Pascal pentru calculul polinomului de interpolare Lagrange, pentru un set de perechi , citite de la tastatura.

Exercitiul 1.

Sa se scrie un program care citeste un text (maxim 255 caracter) de la tastatura si il afiseaza compactat, prin eliminarea spatiilor suplimentare.

Rezolvare: Necesitatea compactarii apare in trei situatii diferite: exista caractere spatiu la inceputul textului sau la sfirsitul sau (acestea se vor elimina in totalitate) sau exista mai mult de un caracte intre cuvinte, caz in care se va pastra numai un caracter, restul eliminindu-se. Prin cuvint se intelege un subsir de caractere intre care nu exista nici un spatiu. Algoritmul parcurge sirul intr-o bucla WHILE-DO, verificind fiecare caracter;

daca nu este spatiu se trece la caracterul urmator (caracterul curent este indicat de contorul i); daca caracterul curent este spatiu trebuie trebuie sa decidem daca il eliminam sau il pastram. Caracterul trebuie eliminat daca este primul din sir, ultimul din sir sau desparte doua cuvinte iar urmatorul caracter este tot spatiu. Iesirea din bucla se petrece atunci cind contorul I are o valoare mai mare decit lungimea sirului (indica un carater aflat 'dincolo' de sfirsitul sirului). Daca decidem sa pastram spatiul, se trece la urmatorul caracter, prin incrementarea contorului i. Daca dorim sa eliminam caracterul se procedeaza astfel: 1) toate caracterele care urmeaza in sir vor fi mutate cu o pozitie

spre inceputul sirului; 2) se inscrie in s[0] noua lungime a sirului (cu 1 mai mica decit cea anterioara).

program compactare_sir;

var s:string;

i,j,l:byte;

begin write('Textul de compactat: ');

readln(s);

l:=length(s);

i:=1;

while i<=l do

begin if s[i]<>' ' then inc(i)

else begin if (i=1) or (i=l) or (s[i+1]=' ') then

begin for j:=i to l-1 do

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

dec(l);

s[0]:=chr(l);

end

else inc(i);

end;

end;

writeln(s);

readln;

end.

Exemplu de rulare:

Textul de compactat: Acesta este un exemplu de compactare a unui text .

Acesta este un exemplu de compactare a unui text .

Exercitiul 2.

Sa se scrie un program care numara cuvintele dintr-un text.

Rezolvare: se considera ca textul nu este compactat. Algoritmul presupune parcurgerea textului caracter cu caracter si incrementarea unui contor (initializat cu 0) atunci cind se detecteaza inceputul unui nou cuvint. Avem inceput de cuvint atunci cind dupa un spatiu urmeaza un caracter diferit de spatiu.

program numara_cuvinte;

var s:string;

i,n,l:byte;

begin write('Textul de prelucrat:');

readln(s);

l:=length(s);

n:=0;

for i:=1 to l-1 do

if (s[i]=' ') and (s[i+1]<>' ') then

inc(n);

writeln('Textul contine ',n,' cuvinte.');

readln;

end.

Exemplu de rulare:

Textul de prelucrat: Programul va numara cuvintele acestui text.

Textul contine 6 cuvinte.

Exercitiul 3.

Sa se relizeze un program care introduce cite un spatiu intre fiecare 2 caractere diferite de spatiu ale unui sir citit de la tastatura. Observatie: sirul initial va avea maxim 122 caractere pentru a evita problemele legate de depasirea lungimii maxime a unui sir.

Rezolvare: Vom trata sirul de caractere tot ca vector. Intr-o bucla WHILE-DO se va parcurge sirul caracter cu caracter pina cind contorul va depasi sfirsitul acestuia. Daca intilnim doua caractere, ambele diferite de spatiu, se mareste lungimea sirului cu 1, se deplaseaza restul sirului spre dreapta cu o pozitie (spre sfirsitul sirului) iar in pozitia i+1 (deci intre cele 2 caractere detectate anterior) se inscrie un caracter spatiu.

program extindere;

var s:string;

l,i,j:byte;

begin write('Sirul initial: ');

readln(s);

l:=length(s);

i:=1;

while i<=l do

begin if (s[i]<>' ') and (s[i+1]<>' ') then

begin l:=l+1;

s[0]:=chr(l);

for j:=l downto i+2 do

s[j]:=s[j-1];

s[i+1]:=' ';

i:=i+2;

end

else i:=i+1;

end;

writeln(s);

readln;

end.

Exemplu de rulare:

Sirul initial: aaa bbb c c c c c

a a a b b b c c c c c

Exercitiul 4.

Sa se scrie un unit cu subprograme care realizeaza urmatoarele prelucrari:

1. codificarea/decodificarea unui sir de caractere prin metoda ROT13;

2. codificarea/decodificarea unui sir prin interschimbarea grupurilor de 4 biti;

3. contorizarea numarului de aparitii ale fiecarul caracter ASCII intr-un sir.

Rezolvare:

1. Metoda ROT13 presupune rotirea setului de caractere ASCII cu 13 pozitii. Astfel litera A devine N, B devine O, a devine n si asa mai departe. Algoritmul presupune parcurgerea sirului intr-o bucla FOR-DO si inlocuirea fiecarui caracter cu caracterul care are codul ASCII mai mare cu 13. Daca se depaseste valoarea maxima (255) - adica se trece dincolo de sfirsitul setului ASCII - se reia numaratoarea de la inceputul setului. Decodificare este asemanatoare, cu diferenta ca se inlocuiesc caracterele cu cele care au, respectiv, codul ASCII cu 13 mai mic. Procedurile primesc ca parametru sirul care trebuie (de)codificat.

2. Pentru interschimbarea grupurilor de 4 biti (superior si inferior)dintr-un caracter se pot folosi operatiile pe biti (logice si de deplasare). Deoarece aceste operatii se efectueaza pe operanzi numerici, vom suprapune un vector cu elemente de tip byte peste sirul de codificat/decodificat si vom lucra cu acesta. Prin operatii de deplasare (shl si shr) se separa cele doua grupuri de cite 4 biti in doua variabile auxiliare, de tip byte. Folosind convenabil operatia de deplasare, grupurile de biti sint deja in pozitia finala. Ultima operatie consta in suprapunerea celor doua grupuri printr-o operatie sau pe biti. Procedurile primesc ca parametru sirul care trebuie (de)codificat.

Exemplu: 1011011

00001011

01110000 => 00001011

01110000

01111011

3. Pentru numararea aparitiilor fiecarui caracter intr-un sir se foloseste un vector initializat cu valori nule, cu atitea elemente cite caractere are setul ASCII. Fiecare element al vectorului va contoriza aparitiile caracterului cu codul ASCII corespunzator (astfel elementul cu numarul 64 va arata numarul aparitiilor caracterului A, 65 pentru B etc.). Intr-o bucla FOR-DO se parcurge sirul si, pentru fiecare caracter este incrementat elementul corespunzator din vector (dat de codul ASCII al caracterului, disponibil prin apelarea functiei ORD).

unit codif;

interface

type vector=array[0..255]of byte;

const hi=$f0;

lo=$0f;

procedure codrot13(var s:string);

procedure decodrot13(var s:string);

procedure codec4b(var s:string);

procedure contor(s:string; var nr:vector);

implementation

procedure contor(s:string; var nr:vector);

var i:byte;

begin for i:=0 to 255 do

nr[i]:=0;

for i:=1 to length(s) do

inc(nr[ord(s[i])]);

end;

procedure codec4b(var s:string);

var c,d:byte;

i:byte;

x:array[0..255]of byte absolute s;

begin for i:=1 to length(s) do

begin c:=x[i] shl 4;

d:=x[i] shr 4;

x[i]:=c or d;

end;

end;

procedure codrot13(var s:string);

var i:byte;

begin for i:=1 to length(s) do

s[i]:=chr((ord(s[i])+13) mod 255);

end;

procedure decodrot13(var s:string);

var i:byte;

begin for i:=1 to length(s) do

s[i]:=chr((255+ord(s[i])-13) mod 255);

end;

end.

Exemplu de program apelator:

program apel;

uses codif;

var s:string;

x:vector;

i,k:byte;

begin write('Sirul de prelucrat: ');

readln(s);

write('Sirul de prelucrat: ');

writeln('Codificare/decodificare ROT13:');

codrot13(s);

writeln(s);

decodrot13(s);

writeln(s);

writeln(''Codificare/decodificare 4b:');

codec4b(s);writeln(s);

codec4b(s);writeln(s);

writeln('Statistica caractere:');

contor(s,x);

k:=1;

for i:=0 to 255 do begin if x[i]<>0 then begin write(chr(i):1,' - ',x[i]:2,' ');

inc(k);

end;

if k mod 7=0 then writeln(' ');

end;

readln;

end.

Exemplu de rulare:

Exercitiul 5.

Sa se scrie un subprogram care insereaza intr-un sir un alt sir in pozitia imediat urmatoare primei apariti a unui caracter dat; daca acesta nu este gasit atunci inserarea se face la sfirsit.

Rezolvare: Primul pas este determinarea pozitiei in care se va insera al doilea sir. In acest scop se parcurge sirul initial intr-o bucla WHILE-DO pina la detectarea caracterului dupa care se insereaza. La iesirea din bucla variabila i va indica pozitia caracterului dupa care se insereaza; adaugind 1 obtinem pozitia in care se insereaza. Pasul urmator consta in inscrierea noii lungimi a sirului (lungimea initiala + lungimea sirului care se insereaza) in pozitia 0. Caracterele din pozitia i pina la sfirsitul sirului initial trebuie deplasate la dreapta pentru a face loc sirului care se insereaza. Ultimul pas este copierea caracterelor sirului de inserat in sirul initial, din pozitia i.

procedure inser(var s:string;ss:string;c:char);

var i,j,l,ll:byte;

vb:boolean;

begin i:=1;

vb:=false;

l:=length(s);ll:=length(ss);

while (i<l) and (not vb) do

begin if s[i]=c then vb:=true

else inc(i);

end;

i:=i+1;

s[0]:=chr(l+ll);

for j:=0 to l-i do

s[l+ll-j]:=s[l-j];

for j:=1 to ll do

s[i+j-1]:=ss[j];

end;

Exemplu de rulare:

Sirul initial: Acest calendar este de anul trecut.

Sirul de inserat: cu masini

Caracterul dupa care se insereaza: r

Acest calendar cu masini este de anul trecut.

Exercitiul 6:

Sa se scrie un subprogram care sterge dintr-un sir un subsir dat (prima aparitie a subsirului).

Rezolvare: pentru a pute sterge subsirul, acesta trebuie intii localizat in sirul initial. Daca notam cu l lungimea sirului initial si cu ll lungimea subsirului de sters, atunci inceputul acestuia poate fi oriunde intre pozitia 1 si l-ll in sirul initial. Se parcurge sirul s intr-o bucla WHILE-DO pina cind se depaseste pozitia l-ll sau a fost detectat si sters subsirul dat. O posibila aparitie a subsirului este luata in calcul atunci cind caracterul curent din s este identic cu primul caracter din subsirul de sters (ss). Atunci cind se intilneste o astfel de situatie se verifica daca intr-adevar s-a intilnit subsirul ss; pentru aceasta se compara caracter cu caracter sirul s, din pozitia curenta, pe o lungime ll cu subsirul ss. Daca nu se intilneste nici o diferenta se sterge subsirul si se marcheaza prin variabila booleana vb terminarea prelucrarilor. Pentru stergere se deplaseaza toate

caracterele ramase din sirul s, din pozitia curenta+ll, cu ll pozitii la stinga si se inscrie noua lungime a sirului s in pozitia s[0].

procedure sterg(var s:string; ss:string);

var i,j,l,ll:byte;

vb,vb1:boolean;

begin l:=length(s);

ll:=length(ss);

vb:=false;

i:=1;

while (i<=l-ll) and (not vb) do

begin if s[i]<>ss[1] then inc(i)

else begin vb1:=true;

for j:=1 to ll do

if ss[j]<>s[i+j-1] then vb1:=false;

if vb1 then

begin vb:=true;

for j:=i+ll to l do

s[j-ll]:=s[j];

s[0]:=chr(l-ll);

end

else inc(i);

end;

end;

end;

Exemplu de rulare:

Sir initial: Acesta este sirul de test

Subsir: sta este si

Acerul de test

Exercitiul 7.

Cunoscuta sub numele "interclasare cu selectie", operatia de reuniune presupune parcurgerea secventiala a multimilor initiale si trecerea in multimea rezultat a elementelor care se regasesc in cele doua multimi, fiecare luat o singura data.

b) Intersectia dintre doua multimi A si B se defineste astfel:

A B

In urma apelului procedurii Intersectie va fi obtinuta o multime cu elementele comune multimilor initiale. Daca intersectia este multimea vida, atunci cardinalul multimii rezultat este 0 (parametrul card).

c) Diferenta dintre doua multimi A si B se defineste, in sens matematic, astfel:

A B

d) Produsul cartezian dintre doua multimi A si B se defineste ca fiind multimea perechilor ordonate (x,y), cu proprietatea ca xIA si yIB:

AxB

Observatie: Pentru rezolvarea problemei propuse, unitatea contine subprograme corespunzatoare operatiilor prezentate anterior (reuniune, intersectie, diferenta si produs cartezian). Se utilizeaza doua proceduri interne pentru sortarea elementelor unui vector respectiv pentru compactarea elementelor unui vector. Prin compactare se asigura unicitatea valorilor elementelor din multimile initiale.

Unitatea Pascal:

unit multimi;

interface

type multime=array[1..50] of integer;

produs=array[1..100] of record x,y:integer end;

procedure reuniune(m,n:byte; var a,b,c:multime; var card:byte);

procedure intersectie(m,n:byte; var a,b,c:multime; var card:byte);

procedure diferenta(m,n:byte; var a,b,c:multime; var card:byte);

procedure produs_cartezian(m,n:byte; var a,b:multime; var c:produs);

implementation

procedure sortare(n:byte; var v:multime);

var i:byte; aux:integer;vb:boolean;

begin

repeat

vb:=false;

for i:=1 to n-1 do

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

aux:=v[i];

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

v[i+1]:=aux;

vb:=true

end

until not vb

end;

procedure compactare(var n:byte; var v:multime);

var i,j,k:byte;

begin

sortare(n,v);

k:=0; i:=1;

while i<=n-k do

if v[i]=v[i+1] then begin

k:=k+1;

for j:=i to n-k+1 do v[j]:=v[j+1]

end

else inc(i);

n:=n-k

end;

procedure reuniune;

const hv=maxint;

var i,j,k,l:byte;

begin

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

while (a[i]<>hv) or (b[j]<>hv) do

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

inc(k);

c[k]:=a[i];

inc(i);

if i>m then a[i]:=hv

end

else if a[i]>b[j] then begin

inc(k);

c[k]:=b[j];

inc(j);

if j>n then b[j]:=hv

end

else begin inc(i); if i>m then a[i]:=hv end;

card:=k

end;

procedure intersectie;

var i,j,k:byte;

begin

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

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

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

inc(k);

c[k]:=a[i];

i:=i+1

end

else if a[i]>b[j] then inc(j) else inc(i);

card:=k

end;

procedure diferenta;

var i,j,k:byte;

begin

k:=0;

for i:=1 to m do begin

j:=1;

while (a[i]<>b[j]) and (j<=n) do inc(j);

if j>n then begin inc(k);

c[k]:=a[i]

end

end;

card:=k

end;

procedure produs_cartezian;

var i,j,k:byte;

begin

k:=0;

for i:=1 to m do

for j:=1 to n do

begin

inc(k);

c[k].x:=a[i];

c[k].y:=b[j]

end

end;

end.

Exercitiul 2

Sa se proiecteze o unitate Pascal care sa contina subprograme pentru calcularea urmatorilor indicatori statistici: media aritmetica ponderata, dispersia si abaterea medie patratica pentru un sir de observatii statistice.

Solutie: Pentru rezolvarea problemelor statistice trebuie avute in vedere, pe langa observatiile propriu-zise, si frecventele de aparitie a acestora in cadrul sirului initial. In cadrul unitatii au fost dezvoltate doua subprograme frecvente_1 si frecvente_2, care reprezinta variante ale aceleiasi probleme.

Prima varianta determina vectorul valorilor caracteristicii observate (unice), precum si vectorul de frecvente, prin parcurgerea secventiala a sirului initial de observatii statistice. Pentru fiecare observatie initiala se verifica existenta in vectorul de valori unice: daca exista, atunci se incrementeaza frecventa corespunzatoare valorii respective, in caz contrar observatia are o valoare noua si se adauga sirului de valori unice.

A doua varianta presupune sortarea sirului initial de observatii statistice si obtinerea vectorului valorilor caracteristicii observate (unice) si a vectorului de frecvente folosind algoritmul controlului dupa caracteristica.

Formulele utilizate pentru determinarea indicatorilor statistici sunt:

media: ;

Dispersia:  ;

Abaterea medie patratica: .

Unitatea Pascal:

unit statist;

interface

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

vector1=array[1..50] of byte;

procedure frecvente_1(n:byte; var x,y:vector; var f:vector1; var k:byte);

procedure frecvente_2(n:byte; var x,y:vector; var f:vector1; var k:byte);

function media(n:byte; var x,y:vector; var f:vector1):real;

function dispersia(n:byte; var x,y:vector; var f:vector1):real;

function abaterea_medie_patratica(n:byte; var x,y:vector; var f:vector1):real;

implementation

procedure sortare(n:byte; var v:vector);

var i:byte; aux:real;

vb:boolean;

begin

repeat

vb:=false;

for i:=1 to n-1 do

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

aux:=v[i];

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

v[i+1]:=aux;

vb:=true

end

until not vb

end;

procedure frecvente_1;

var i,j:byte;

begin

y[1]:=x[1]; f[1]:=1; k:=1;

for i:=2 to n do

begin

j:=1;

while (x[i]<>y[j]) and (j<=k) do inc(j);

if j<=k then inc(f[j])

else begin

inc(k);

y[k]:=x[i];

f[k]:=1

end

end

end;

procedure frecvente_2;

var i:byte;

begin

sortare(n,x);

k:=0; i:=1;

while i<=n do

begin

k:=k+1;

y[k]:=x[i];

f[k]:=0;

while (x[i]=y[k]) and (i<=n) do

begin

inc(f[k]);

inc(i)

end

end

end;

function media;

var s:real; dim,i:byte;

begin

frecvente_1(n,x,y,f,dim);

if dim=n then begin

s:=0;

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

media:=s/n

end

else begin

s:=0;

for i:=1 to dim do s:=s+y[i]*f[i];

media:=s/n

end

end;

function dispersia;

var m:real; dim,i:byte; s:real;

begin

m:=media(n,x,y,f);

frecvente_2(n,x,y,f,dim);

s:=0;

for i:=1 to dim do s:=s+sqr(y[i]-m)*f[i];

dispersia:=s/n

end;

function abaterea_medie_patratica;

begin

abaterea_medie_patratica:=sqrt(dispersia(n,x,y,f))

end;

end.

Exercitiul 3

Sa se realizeze sortarea unui vector prin tehnica quicksort.

Solutie: Fie secventa (x(p),x(p+1),,x(u)), unde p ia valoarea initiala 1, iar u este dimensiunea vectorului. Se pozitioneaza x(p) astfel incat toate elementele din fata lui sa fie mai mici, iar toate de dupa el sa fie mai mari, prin interschimbari repetate. Fie aceasta pozitie i. Procedeul se reia pentru secventele (x(p),x(i-1)), respectiv (x(i+1),,x(u)). Pozitionarea lui x(p) se realizeaza astfel:

1. Se compara x(p) cu x(u), x(u-1), pana la primul u1, cu x(u1)<x(p); x(u1) si x(p) se interschimba, iar p1=p+1;

2. Se compara x(u1) cu x(p1), x(p1+1), pana la primul p2, cu x(p2)>x(u1); x(u1) si x(p2) se interschimba.

3. Pentru p=p2 si u=u1 se repeta cei doi pasi pana cand p u.

program quick_sort;

uses crt;

var

x:array[1..100] of integer;

n,i:byte;

procedure poz(p,u:byte; var k:byte);

var

i,j:byte;

l,di,dj:shortint;

v:integer;

begin

i:=p;j:=u;di:=0;dj:=-1;

while i<j do

if x[i]>x[j] then

begin

v:=x[i];

x[i]:=x[j];

x[j]:=v;

l:=di;di:=-dj;dj:=-l;

i:=i+di;j:=j+dj

end

else begin

i:=i+di;j:=j+dj

end;

k:=i

end;

procedure quick(p,u:byte);

var

i:byte;

begin

if p>=u then

else begin

poz(p,u,i);

quick(p,i-1);

quick(i+1,u)

end

end;

begin

clrscr;

write('Dimensiunea vectorului:');

readln(n);

write('Elementele vectorului:');

for i:=1 to n do begin

write('x[', i , ']= ');

readln(x[i])

end;

quick(1,n);

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

end.

Exercitiul 4

Sa se realizeze sortarea unui vector prin tehnica de interclasare.

Solutie: Pasii algoritmului sunt:

1. Se imparte vectorul in doua secvente astfel: S1= (v1, v2, , v[n/2]), S2= (v[n/2]+1, , v[n]);

2. Se apeleaza recursiv procedura de sortare pentru S1 si S2;

3. Se interclaseaza S1 si S2 obtinandu-se vectorul sortat.

program inter_sort;

uses crt;

var

n,i:word;

v:array[1..1000] of real;

par:array[1..1000] of real;

procedure interc(l,m,r:word);

var i,j,k:word;

begin

if l<r then begin

i:=l;

j:=m+1;

k:=1;

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

begin

if v[i]<v[j] then begin

par[k]:=v[i];

i:=i+1;

k:=k+1

end

else begin

par[k]:=v[j];

j:=j+1;

k:=k+1

end

end;

if i<=m then

for j:=i to m do

begin

par[k]:=v[j];

k:=k+1

end

else

for i:=j to r do

begin

par[k]:=v[i];

k:=k+1

end

end;

for i:=0 to r-l do

v[l+i]:=par[i+1]

end;

procedure inters(l,r:word);

var i:word;

begin

if l<r then begin

i:=(l+r)div 2;

inters(l,i);

inters(i+1,r);

interc(l,i,r)

end

end;

begin

clrscr;

write('Dimensiunea vectorului:');

readln(n);

write('Elementele vectorului:');

for i:=1 to n do begin

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

readln(v[i])

end;

inters(1,n);

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

end.

Exercitiul 5

Sa se determine coincidentele produse in cadrul modelului unei linii telefonice, pe un interval de timp prestabilit, dandu-se parametrii repartitiilor exponentiale (l si m) care caracterizeaza apelurile, precum si duratele convorbirilor.

program apeluri;

uses crt;

type sir=array[1..100] of real;

var

A,D:sir;

P:array[1..100] of integer;

T,lambda,miu,suma:real;

i,j,k,numar:integer;

indic:boolean;

procedure expon(medie:real;var x:real);

begin

x:=-ln(random)/medie

end;

begin

clrscr;

randomize;

suma:=0;

readln(lambda);

readln(miu);

readln(T);

i:=0;

repeat

i:=i+1;

expon(lambda,A[i]);

expon(miu,D[i]);

suma:=suma+A[i]

until suma>T;

numar:=i; k:=0;

for i:=1 to numar do

begin

indic:=true;

for j:=1 to numar do

if((abs(A[i]-D[j])<0.11) and indic) then

begin

k:=k+1;

P[k]:=i;

indic:=false

end

end;

writeln('Numarul apelurilor telefonice este: ',numar);

for i:=1 to k do

writeln('S-a realizat o coincidenta la apelul ',P[i])

end.

Exercitiul 6

Dandu-se o matrice P patratica, pozitiv definita, reala si simetrica, sa se determine un bloc inferior triunghiular T, cu proprietatea: P=T * Transpus(T).

Solutie: Se foloseste algoritmul lui Crout de stabilire a blocului T.

program Crout;

uses crt;

var

P: array [1..10,1..10] of real;

T: array [1..10,1..10] of real;

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

suma:real;

begin

clrscr;

readln(n);

suma:=0;

for i:=1 to n do

for j:=1 to n do

readln(P[i,j]);

T[1,1]:=sqrt(P[1,1]);

for i:=2 to n do T[i,1]:=P[i,1]/T[1,1];

for i:=2 to n do begin

for j:=1 to i-1 do

suma:=suma+T[i,j]*T[i,j];

T[i,i]:=sqrt(P[i,i]-suma)

end;

suma:=0;

for j:=1 to n do

for i:=j+1 to n do begin

for k:=1 to j-1 do

suma:=suma+T[i,k]*T[j,k];

T[i,j]:=sqrt(P[i,j]-suma)

end;

for i:=1 to n do begin

for j:=1 to n do

write(T[i,j],' ');

writeln

end

end.