EXERCIŢII DE ARITMETICĂ Exerciţiul 1 Să se determine dacă un număr introdus de la tastatură este număr prim sau nu. Soluţie Condiţia suficientă ca un număr n să fie prim este ca acesta să nu se dividă cu nici un alt număr 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. Exerciţiul 2 Să se determine suma şi produsul a două polinoame. Soluţie: Fie polinoamele p 1 , p 2 cu deg(p i )=grad i , i=1..2 şi grad=max(grad 1 , grad 2 ). Suma celor două polinoame se calculează după formula: suma[i]= p 1 [i]+p 2 [i], i=1..grad (dacă unul din gradele celor două polinoame este strict inferior lui grad, coeficienţii “lipsă” sunt 0). Produsul celor două polinoame se calculează după formula: 1
Transcript
EXERCIŢII DE ARITMETICĂ
Exerciţiul 1
Să se determine dacă un număr introdus de la tastatură este număr prim sau nu.
Soluţie Condiţia suficientă ca un număr n să fie prim este ca acesta să nu se dividă cu nici un alt număr 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.
Exerciţiul 2
Să se determine suma şi produsul a două polinoame.Soluţie: Fie polinoamele p1, p2 cu deg(pi)=gradi, i=1..2 şi grad=max(grad1, grad2). Suma celor două polinoame se calculează după formula: suma[i]= p1[i]+p2[i], i=1..grad (dacă unul din gradele celor două polinoame este strict inferior lui grad, coeficienţii “lipsă” sunt 0). Produsul celor două polinoame se calculează după formula:
, i=0..grad1+grad2.
Polinoamele sunt reprezentate prin vectorii coeficienţilor cores-punzători. Gradele polinoamelor, precum şi coeficienţii corespunzători vor fi introduşi de la tastatură.
program polinoame;uses crt;var p1,p2,suma,produs:array[0..40] of integer; i,j,grad1,grad2,grad: integer;
1
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 endend;{programul principal}beginclrscr;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.
Exerciţiul 3
Să se genereze toate permutările mulţimii {1, 2,..., n}, unde n este un număr natural citit de la tastatură, n 7.Soluţie: Problema va fi rezolvată utilizându-se metoda backtracking. Forma standard a acestei metode se aplică problemelor în care trebuie găsit un vector x=(x1, x2, ..., xn) din spaţiul soluţiilor S=S1S2...Sn
unde, pentru orice 1 i n, Si= si (număr finit de elemente) şi pe Si este definită o relaţie de ordine, iar x
2
reprezintă soluţia rezultat satisfăcând condiţiile interne corespunzătoare problemei. Ca variante de ieşiri sunt posibile cazurile: o singură soluţie rezultat, toate soluţiile rezultat (în probleme de generare asemănătoare celei propuse), o soluţie rezultat care optimizează (minim sau maxim) un criteriu f:SR.
Construcţia unei soluţii se face astfel: se presupun determinate la momentul curent x1, x2, ..., xk; dacă secvenţa anterior calculată satisface condiţiile de continuare specifice problemei (dacă
există şansa de a se obţine o soluţie rezultat) se alege xk+1 Sk+1
altfel, dacă xk are succesor în Sk, xk succ(xk) altfel, dacă xk nu are succesor în Sk, se procedează în aceeaşi manieră cu “resatisfacerea” lui xk-
1.Procedura generală de calcul este următoarea: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;
în care: final este o procedură specifică momentului în care s-a determinat o soluţie rezultat x (se
afişează rezultatul, se testează o funcţie criteriu pentru soluţia obţinută, aceasta selectându-se doar în anumite condiţii de optim samd);
init(k) este o funcţie de iniţializare a lui xk cu predecesorulu primului element din Sk; succ(k) este o funcţie booleană care testează existenţa succesorului lui xk în Sk şi dacă acest
lucru este posibil se înlocuieşte xk cu succesorul lui din Sk; continuare(k) este o funcţie booleană care testează condiţiile de continuare (dacă secvenţa
determinată până la momentul curent poate duce la o soluţie rezultat).În continuare este prezentată problema generării tuturor permutărilor mulţimii {1, 2,..., n} aplicându-
se exact metoda generală şi ţinându-se cont de următoarele aspecte: S1 = S2 = ... = Sn = {1, 2,..., n} (deci funcţia init nu depinde de nici un parametru, întorcând
valoarea 0 indiferent de indicele elementului de iniţializat); condiţia ca secvenţa {x1, x2,..., xk} să fie una corectă pentru a se iniţia generarea lui xk+1 (ştiind
că {x1, x2,..., xk-1} este corectă) este cea dată de definiţia unei permutări: xk {x1, x2,..., xk-1}.
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;
3
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;
beginclrscr;write('Numarul de elemente al permutarii: ');readln(n);back(1);end.
După cum se poate remarca, unele din opera]iile precedente (cum ar fi funcţia init, lucrul cu funcţia succ în condiţiile în care S1 = S2 = ... =Sn = {1, 2,..., n}) pot fi reformulate într-o manieră ce simplifică scrierea programului. De exemplu, o altă variantă corectă 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
4
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;
beginclrscr;write('Numarul de elemente al permutarii: ');readln(n);back(1);end.
Problema 5 Să se scrie programul Pascal pentru generarea tuturor submulţimilor mulţimii {1, 2,..., n}, unde n este un număr natural citit de la tastatură, n 10.
Soluţie Se vor genera, prin metoda backtracking, toate submulţimile cu k elemente, 1 k n. Modul de reprezentare a unei submulţimi SubS a lui S (privite ca vectori) este:
SubS[i] = 0, S[i]
S[i]
SubS
SubS1,
Condiţiile de continuare sunt cele ce caracterizează o submulţime a unei mulţimi, momentul terminării generării unei soluţii - o submulţime cu k elemente - sesizându-se când suma elementelor vectorului generat este k. În momentul determinării unei submulţimi, aceasta este trecută într-un vector, generându-se astfel P({1, 2,..., n}).
Programul Pascal este:program submultime;type elem=0..1; sub=array[1..10] of elem;var n,dim:byte; x:sub;
5
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;
beginreadln(n);nr:=0;for dim:=1 to n do back(dim,1);writeln('Submultimile sunt:');for k:=1 to nr do
6
begin for j:=1 to n do if tot[k][j]=1 then write(j,' '); writeln; end;end.
Problema 6 Să se realizeze un unit care să cuprindă subprograme pentru:a) calculul vectorului medie pentru o selecţie dată de vectori aleatori;b) calculul matricei de covarianţă pentru o selecţie dată de vectori aleatori;c) calculul matricei de autocorelaţie pentru o selecţie dată de vectori aleatori;d) determinarea valorilor şi vectorilor proprii corespunzători matricei de covarianţă calculată pe o
selecţie dată de vectori aleatori.
Soluţie Fie X un vector aleator cu medie şi matrice de covarianţă , {X1, X2,..., Xm} o selecţie bernoulliană de volum m asupra lui X.
media de selecţie se calculează astfel:
1
1mX i
i
m
;
matricea de covarianţă de selecţie se calculează după formula:
1
1 1mX Xi i
T
i
m
;
matricea de autocorelaţie de selecţie este dată prin formula: Sm
X Xi iT
i
mT
1
1
;
cum matricea de covarianţă de selecţie este simetrică şi pozitiv definită, rezultă că 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
7
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];
1. Să se scrie programul Pascal pentru determinarea celui mai mic multiplu comun al două numere.2. Să se scrie un subprogram Pascal pentru a decide dacă două numere naturale sunt prime între ele.3. Să se scrie programul Pascal pentru generarea tuturor numerelor prime mai mici decât n, n citit de
la tastatură.4. Să se scrie un subprogram Pascal pentru calculul celui mai mare divizor comun a n numere
naturale, n3.5. Să se scrie un subprogram Pascal pentru descompunerea unui număr natural în factori primi.6. Să se scrie programul Pascal pentru generarea tuturor combinărilor de k elemente ale unei mulţimi
de n elemente, nk.7. Să se scrie un subprogram Pascal pentru calculul valorii unui polinom într-un punct dat.8. Să se scrie un subprogram Pascal pentru calculul derivatei unui polinom.9. Să se scrie un subprogram Pascal pentru determinarea compunerii a două polinoa-me.10. Utilizând algoritmul lui Euclid, să se scrie subprogramele Pascal pentru determinarea celui mai
mare divizor comun şi a celui mai mic multiplu comun pentru două polinoame.11. Să se realizeze programul Pascal pentru calculul polinomului de interpolare Lagrange pentru un
set de perechi {(x1, y1 ), (x2, y2), …, (xn, yn)} citite de la tastatură.
{**** Acest program genereaza un proces gaussian cu functia de autocorelatie exponentiala Se genereaza procesul (Z,t) de medie 0 si dispersie 1 ****}
program gaussexp; uses crt; var csi,o,z,z0:real; i:integer;
procedure norm01(var z:real); var suma:real;
10
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.{**** Acest program va genera procesul gaussian cu functie de autocorelatie liniara folosind algoritmul clasic ****} 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.
{**** Acest program va genera procese Poisson in cerc care vor fi salvate in fisierul as.txt ****}
11
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.{**** Acest program genereaza numere aleatoare conform algoritmului clasic Gsalca cu repartitia de intrare exponentiala avand cealalta functie de intrare cea data de functia fct de mai jos
12
****}
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.
{**** Acest program genereaza o stare a unui lant Markov omogen cu doua stari, de ordinul intai, data fiind matricea de trecere P[i,j], 1<=i,j<=2 ****}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;
13
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;{***** Acest program genereaza un proces Poisson 1-dimensional omogen pe segmentul (0,x0] *****}uses crt;var
l,x0,x:real; n:integer;
beginclrscr;randomize;
readln(l,x0);x:=0;n:=0;
while x<=x0 do beginx:=x-(1/l)*ln(1-random);n:=n+1;writeln(x,' ',n);
end;end.
program poisson2;
14
{***** Acest program genereaza un proces Poisson 2-dimensional omogen pe dreptunghiul (0,x0] (0,y0] *****}
uses crt;
var l,x0,x,y0,y:real; n:integer;
beginclrscr;randomize;
readln(l,x0,y0);x:=0;n:=0;while x<=x0 do
beginx:=x-(1/l)*ln(1-random);
y:=random*y0;n:=n+1;writeln(x,' ',y,' ',n);
end;end.
15
EXERCIŢII DIVERSE
Exerciţiul 1
Să se determine dacă un număr introdus de la tastatură este prim sau nu.Soluţie: Condiţia suficientă ca un număr n să fie prim este ca acesta să nu se dividă cu nici un alt număr 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.
Exerciţiul 2
Să se determine suma şi produsul a două polinoame.Soluţie: Fie polinoamele p1, p2 cu deg(pi)=gradi, i=1..2 şi grad=max(grad1, grad2). Suma celor două polinoame se calculează după formula: suma[k]= p1[k]+p2[k], k=1..grad (dacă unul din gradele celor două polinoame este strict inferior lui grad, coeficienţii “lipsă” sunt 0). Produsul celor două polinoame se calculează după formula:
, k=0..grad1+grad2.
Polinoamele sunt reprezentate prin vectorii coeficienţilor cores-punzători. Gradele polinoamelor, precum şi coeficienţii corespunzători vor fi introduşi de la tastatură.
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
16
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 endend;{programul principal}beginclrscr;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.
Exerciţiul 3
Să se genereze toate permutările mulţimii {1, 2,..., n}, unde n este un număr natural citit de la tastatură, n 7.Soluţie: Problema va fi rezolvată utilizându-se metoda backtracking. Forma standard a acestei metode se aplică problemelor în care trebuie găsit un vector x=(x1, x2, ..., xn) din spaţiul soluţiilor S=S1S2...Sn
unde, pentru orice 1 i n, Si= si (număr finit de elemente) şi pe Si este definită o relaţie de ordine, iar x reprezintă soluţia rezultat satisfăcând condiţiile interne corespunzătoare problemei. Ca variante de ieşiri sunt posibile cazurile: o singură soluţie rezultat, toate soluţiile rezultat (în probleme de generare asemănătoare celei propuse), o soluţie rezultat care optimizează (minim sau maxim) un criteriu f:SR.
Construcţia unei soluţii se face astfel: se presupun determinate la momentul curent x1, x2, ..., xk; dacă secvenţa anterior calculată satisface condiţiile de continuare specifice problemei (dacă
există şansa de a se obţine o soluţie rezultat) se alege xk+1 Sk+1
17
altfel, dacă xk are succesor în Sk, xk succ(xk) altfel, dacă xk nu are succesor în Sk, se procedează în aceeaşi manieră cu “resatisfacerea” lui xk-
1.Procedura generală de calcul este următoarea: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;
în care: final este o procedură specifică momentului în care s-a determinat o soluţie rezultat x (se
afişează rezultatul, se testează o funcţie criteriu pentru soluţia obţinută, aceasta selectându-se doar în anumite condiţii de optim ş.a.m.d.);
init(k) este o funcţie de iniţializare a lui xk cu predecesorulu primului element din Sk; succ(k) este o funcţie booleană care testează existenţa succesorului lui xk în Sk şi, dacă acest
lucru este posibil, se înlocuieşte xk cu succesorul lui din Sk; continuare(k) este o funcţie booleană care testează condiţiile de continuare (dacă secvenţa
determinată până la momentul curent poate duce la o soluţie rezultat).În continuare este prezentată problema generării tuturor permutărilor mulţimii {1, 2,..., n} aplicându-
se exact metoda generală şi ţinându-se cont de următoarele aspecte: S1 = S2 = ... = Sn = {1, 2,..., n} (deci funcţia init nu depinde de nici un parametru, întorcând
valoarea 0 indiferent de indicele elementului de iniţializat); condiţia ca secvenţa {x1, x2,..., xk} să fie una corectă pentru a se iniţia generarea lui xk+1 (ştiind
că {x1, x2,..., xk-1} este corectă) este cea dată de definiţia unei permutări: xk {x1, x2,..., xk-1}.
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);
18
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;
beginclrscr;write('Numarul de elemente al permutarii: ');readln(n);back(1);end.
După cum se poate remarca, unele din operaţiile precedente (cum ar fi funcţia init, lucrul cu funcţia succ în condiţiile în care S1 = S2 = ... =Sn = {1, 2,..., n}) pot fi reformulate într-o manieră ce simplifică scrierea programului. De exemplu, o altă variantă corectă 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;
19
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;
beginclrscr;write('Numarul de elemente al permutarii: ');readln(n);back(1);end.
Exerciţiul 4
Să se scrie programul Pascal pentru generarea tuturor submulţimilor mulţimii {1, 2,..., n}, unde n este un număr natural citit de la tastatură, n 10.Soluţie: Se vor genera, prin metoda backtracking, toate submulţimile cu k elemente, 1 k n. Modul de reprezentare a unei submulţimi SubS a lui S (privite ca vectori) este:
Condiţiile de continuare sunt cele ce caracterizează o submulţime a unei mulţimi, momentul terminării generării unei soluţii - o submulţime cu k elemente - sesizându-se când suma elementelor vectorului generat este k. În momentul determinării unei submulţimi, aceasta este trecută într-un vector, generându-se astfel P({1, 2,..., n}).
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
20
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;
beginreadln(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.
Exerciţiul 5
Să se realizeze o unitate Pascal care să cuprindă subprograme pentru rezolvarea următoarelor operaţii:
calculul vectorului medie pentru o selecţie dată de vectori aleatori; calculul matricei de covarianţă pentru o selecţie dată de vectori aleatori; calculul matricei de autocorelaţie pentru o selecţie dată de vectori aleatori; determinarea valorilor şi vectorilor proprii corespunzători matricei de covarianţă calculată pe o
selecţie dată de vectori aleatori.Soluţie: Fie X un vector aleator cu medie şi matrice de covarianţă , {X1, X2,..., Xm} o selecţie bernoulliană de volum m asupra lui X.
media de selecţie se calculează astfel:
1
1mX i
i
m
;
21
matricea de covarianţă de selecţie se calculează după formula:
;
matricea de autocorelaţie de selecţie este dată prin formula: ;
cum matricea de covarianţă de selecţie este simetrică şi pozitiv definită, rezultă că se poate aplica algoritmul lui Jacobi [citarea algoritmului]; valorile proprii vor fi reale, pozitive, iar vectorii proprii vor avea componente reale.
Unitatea 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]);
22
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];
1. Să se scrie programul Pascal pentru determinarea celui mai mic multiplu comun al n numere.2. Să se scrie un subprogram Pascal pentru a decide dacă două numere naturale sunt prime între ele.3. Să se scrie programul Pascal pentru generarea tuturor numerelor prime mai mici decât n, n citit de la
tastatură.
24
4. Să se scrie un subprogram Pascal pentru calculul celui mai mare divizor comun a n numere naturale, n3.
5. Să se scrie un subprogram Pascal pentru descompunerea unui număr natural în factori primi.6. Să se scrie programul Pascal pentru generarea tuturor combinărilor de k elemente ale unei mulţimi
de n elemente, nk.7. Să se scrie un subprogram Pascal pentru calculul valorii unui polinom într-un punct dat.8. Să se scrie un subprogram Pascal pentru calculul derivatei unui polinom.9. Să se scrie un subprogram Pascal pentru determinarea compunerii a două polinoame.10. Utilizând algoritmul lui Euclid, să se scrie subprogramele Pascal pentru determinarea celui mai
mare divizor comun şi a celui mai mic multiplu comun pentru două polinoame.11. Să se realizeze programul Pascal pentru calculul polinomului de interpolare Lagrange, pentru un
set de perechi {(x1,y1),(x2,y2),…,(xn, yn)}, citite de la tastatură.
25
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 pozitiespre 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 .
26
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;
27
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
28
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;interfacetype 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.
29
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.
30
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 masiniCaracterul dupa care se insereaza: rAcest 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 toatecaracterele 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
31
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 testSubsir: sta este siAcerul de test
Exercitiul 7.{Sa se scrie un subprogram care numara aparitiile unui subsir intr-un sir de caractere dat. Nu este obligatoriu ca aparitiile subsirului sa fie disjuncte.
Rezolvare: Se parcurge sirul initial, s, pentru a detecta posibile aparitii ale subsirului de cautat. In acest scop se cauta primul caracter al subsirului, intre pozitia 1 si l-ll din sirul initial, unde l este lungimea sirului initial iar ll lungimea subsirului. Daca se intilneste o egalitate, atunci se verifica daca intr-adevar s-a detectat subsirul cautat, prin compararea caracter cu caracter, din pozitia curenta, pe o lungime de l caractere, cu sirul de cautat. Daca nu se intilnesc diferente, se incrementeaza numarul de aparitii detectate ale sirului ss.
procedure nr_apar(s,ss:string;var nr:byte);var i,j,l,ll:byte; var vb:boolean;begin l:=length(s); ll:=length(ss); nr:=0; for i:=1 to l-ll+1 do begin if s[i]=ss[1] then begin vb:=true; for j:=1 to ll-1 do if s[i+j]<>ss[j+1] then vb:=false; if vb then inc(nr); end; end;
32
end;
Exemplu de rulare:
Sirul initial: asasadfasdasdasadfgSir de cautat: asaNr. aparitii: 3
Exercitii propuse:
Sa se scrie un subprogram care sa inlocuiasca intr-un sir dat toate aparitiile unui subsir cu un alt sir de caractere.
Sa se scrie un subprogram care transforma caracterele unui text astfel incit prima litera din fiecare fraza sa fie majuscula iar restul litere mici. Frazele se incheie cu caracterul punct.
Sa se scrie un subprogram care transforma toate caracterele majuscule dintr-un text in litere mici si invers.
Sa se scrie un subprogram care transforma un sir de caractere in valoare numerica. Daca nu este posibila conversia se va semnala eroare.
Sa se scrie un subprogram care transforma un numar in sirul de caractere corespondent.
Sa se scrie un subprogram care anagrameaza un sir de caractere (un cuvint).
Sa se scrie un subprogram care cauta cel mai lung subsir sortat crescator intr-un sir dat.
33
LUCRUL CU MASIVE DE DATE
Exerciţiul 1
Să se proiecteze o unitate Pascal care să conţină subprograme pentru rezolvarea următoarelor probleme: reuniunea a două mulţimi; intersecţia a două mulţimi; diferenţa dintre două mulţimi; produsul cartezian dintre două mulţimi.Soluţie: a) Operaţia de reuniune dintre două mulţimi A şi B se defineşte astfel:
AB{xxA sau xB}Cunoscută sub numele “interclasare cu selecţie”, operaţia de reuniune presupune parcurgerea
secvenţială a mulţimilor iniţiale şi trecerea în mulţimea rezultat a elementelor care se regăsesc în cele două mulţimi, fiecare luat o singură dată.
b) Intersecţia dintre două mulţimi A şi B se defineşte astfel:AB{xxA şi xB}
În urma apelului procedurii Intersectie va fi obţinută o mulţime cu elementele comune mulţimilor iniţiale. Dacă intersecţia este mulţimea vidă, atunci cardinalul mulţimii rezultat este 0 (parametrul card).
c) Diferenţa dintre două mulţimi A şi B se defineşte, în sens matematic, astfel:A\B{xxA şi xB}.
d) Produsul cartezian dintre două mulţimi A şi B se defineşte ca fiind mulţimea perechilor ordonate (x,y), cu proprietatea că xA şi yB:
AxB{(x,y) xA şi yB}.Observaţie: Pentru rezolvarea problemei propuse, unitatea conţine subprograme corespunzătoare operaţiilor prezentate anterior (reuniune, intersecţie, diferenţă şi produs cartezian). Se utilizează două proceduri interne pentru sortarea elementelor unui vector respectiv pentru compactarea elementelor unui vector. Prin compactare se asigură unicitatea valorilor elementelor din mulţimile iniţiale.
Unitatea Pascal:
unit multimi;interfacetype 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
34
end;
procedure compactare(var n:byte; var v:multime);var i,j,k:byte;
beginsortare(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-kend;
procedure reuniune;const hv=maxint;var i,j,k,l:byte;begink:=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:=kend;
procedure intersectie;var i,j,k:byte;begink:=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:=kend;
35
procedure diferenta;var i,j,k:byte;begink:=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:=kend;
procedure produs_cartezian;var i,j,k:byte;begink:=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] endend;end.
Exerciţiul 2
Să se proiecteze o unitate Pascal care să conţină subprograme pentru calcularea următorilor indicatori statistici: media aritmetică ponderată, dispersia şi abaterea medie pătratică pentru un şir de observaţii statistice.Soluţie: Pentru rezolvarea problemelor statistice trebuie avute în vedere, pe lângă observaţiile propriu-zise, şi frecvenţele de apariţie a acestora în cadrul şirului iniţial. În cadrul unităţii au fost dezvoltate două subprograme frecvente_1 şi frecvente_2, care reprezintă variante ale aceleiaşi probleme.
Prima variantă determină vectorul valorilor caracteristicii observate (unice), precum şi vectorul de frecvenţe, prin parcurgerea secvenţială a şirului iniţial de observaţii statistice. Pentru fiecare observaţie iniţială se verifică existenţa în vectorul de valori unice: dacă există, atunci se incrementează frecvenţa corespunzătoare valorii respective, în caz contrar observaţia are o valoare nouă şi se adaugă şirului de valori unice.
A doua variantă presupune sortarea şirului iniţial de observaţii statistice şi obţinerea vectorului valorilor caracteristicii observate (unice) şi a vectorului de frecvenţe folosind algoritmul controlului după caracteristică.Formulele utilizate pentru determinarea indicatorilor statistici sunt:
Media: ;
36
Dispersia: ;
Abaterea medie pătratică: .
Unitatea Pascal:
unit statist;interfacetype 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 vbend;
procedure frecvente_1;var i,j:byte;beginy[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);
37
y[k]:=x[i]; f[k]:=1 end endend;
procedure frecvente_2;var i:byte;beginsortare(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 endend;
function media;var s:real; dim,i:byte;beginfrecvente_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 endelse begin s:=0; for i:=1 to dim do s:=s+y[i]*f[i]; media:=s/n endend;
function dispersia;var m:real; dim,i:byte; s:real;beginm:=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
38
end;
function abaterea_medie_patratica;beginabaterea_medie_patratica:=sqrt(dispersia(n,x,y,f))end;end.
Exerciţiul 3
Să se realizeze sortarea unui vector prin tehnica quicksort.Soluţie: Fie secvenţa (x(p),x(p+1),...,x(u)), unde p ia valoarea iniţială 1, iar u este dimensiunea vectorului. Se poziţionează x(p) astfel încât toate elementele din faţa lui să fie mai mici, iar toate de după el să fie mai mari, prin interschimbări repetate. Fie această poziţie i. Procedeul se reia pentru secvenţele (x(p),...x(i-1)), respectiv (x(i+1),...,x(u)). Poziţionarea lui x(p) se realizează astfel:
1. Se compară x(p) cu x(u), x(u-1),... până la primul u1, cu x(u1)<x(p); x(u1) şi x(p) se interschimbă, iar p1=p+1;
2. Se compară x(u1) cu x(p1), x(p1+1),... până la primul p2, cu x(p2)>x(u1); x(u1) şi x(p2) se interschimbă.
3. Pentru p=p2 şi u=u1 se repetă cei doi paşi până când pu.
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;
{di, dj sunt pasii de incrementare pentru i si j, indicand sensul parcurgerii}v:integer;
begin {program principal}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.
Exerciţiul 4
Să se realizeze sortarea unui vector prin tehnica de interclasare.Soluţie: Paşii algoritmului sunt:
1. Se împarte vectorul în două secvenţe astfel: S1= (v1, v2, ..., v[n/2]), S2= (v[n/2]+1, ..., v[n]);2. Se apelează recursiv procedura de sortare pentru S1 şi S2;3. Se interclasează S1 şi S2 obţinându-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 begini:=l;j:=m+1;k:=1;while(i<=m) and (j<=r) do
40
beginif v[i]<v[j] then begin
par[k]:=v[i];i:=i+1;k:=k+1
endelse begin
par[k]:=v[j];j:=j+1;k:=k+1
endend;
if i<=m thenfor j:=i to m do
beginpar[k]:=v[j];k:=k+1
endelse
for i:=j to r dobegin
par[k]:=v[i];k:=k+1
endend;
for i:=0 to r-l dov[l+i]:=par[i+1]
end;procedure inters(l,r:word);var i:word;begin
if l<r then begini:=(l+r)div 2;inters(l,i);inters(i+1,r);interc(l,i,r)
endend;begin {program principal}
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);
41
for i:=1 to n do write(v[i],' ')end.
Exerciţiul 5
Să se determine coincidenţele produse în cadrul modelului unei linii telefonice, pe un interval de timp prestabilit, dându-se parametrii repartiţiilor exponenţiale ( şi ) care caracterizează apelurile, precum şi 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;
for i:=1 to k dowriteln('S-a realizat o coincidenta la apelul ',P[i])
end.
Exerciţiul 6
Dându-se o matrice P pătratică, pozitiv definită, reală şi simetrică, să se determine un bloc inferior triunghiular T, cu proprietatea: P=T * Transpus(T).
Soluţie: Se foloseşte 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;
beginclrscr;readln(n);suma:=0;for i:=1 to n do
for j:=1 to n doreadln(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 dosuma:=suma+T[i,j]*T[i,j];T[i,i]:=sqrt(P[i,i]-suma)
