Home - Rasfoiesc.com
Educatie Sanatate Inginerie Business Familie Hobby Legal
Doar rabdarea si perseverenta in invatare aduce rezultate bune.stiinta, numere naturale, teoreme, multimi, calcule, ecuatii, sisteme




Biologie Chimie Didactica Fizica Geografie Informatica
Istorie Literatura Matematica Psihologie

C


Index » educatie » » informatica » C
» Liste, multimi, arbori, stive, cozi - algoritmi si probleme rezolvate


Liste, multimi, arbori, stive, cozi - algoritmi si probleme rezolvate


Liste, multimi, arbori, stive, cozi

1. Ciurul lui Eratostene-varianta multime

program Eratostene_varianta_multime;
type ind=0..255;
var n,i,j,k:ind;

mult:set of ind;

sf:char;
begin



sf := 'D';

repeat
write ('n=');
readln (n);
mult:=[.n];
j:=0;
writeln('Numerele prime pana la ',n);
for i:=2 to n do

if i in mult then

begin
write (i:4);
j:=j+1;
k:=2;
while i*k<=n do

begin

mult:=mult-[i*k];
k:=k+1;
end;

end;
writeln;
writeln('Numarul de elemente prime ',j);
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

Sume maxime de numere intregi

program sume_de_numere;
const nmax=100;
type sir=array[1..nmax]of byte;
var s,a:sir;

i,j,nr,n:byte;
f:file of byte;
l:string[80];
ss:longint;
nume:string[10];

sf:char;
begin
sf := 'D';

repeat
write('nume fisier input:');
readln(nume);
assign(f,nume);
rewrite(f);
write('dati nr. de linii:');
readln(n);
write(f,n);

for i:=1 to n do

begin
writeln('Linia cu',i:2,' numere');
for j:=1 to i do

begin

write(j:3,'. ');
readln(nr);
write(f,nr);

end;

end;
reset(f);
read(f,n);
for i:=1 to nmax do s[i]:=0;
writeln ('sumele partiale sunt:');
for i:=1 to n do

begin

for j:=1 to i+1 do a[j]:=s[j];
read(f,nr);
s[1]:=s[1]+nr;
for j:=2 to i do

begin

read(f,nr);
if a[j-1]<a[j] then s[j]:=a[j]+nr

else s[j]:=a[j-1]+nr;
end;
s[i+1]:=nr;
for j:=1 to i do write(s[j],' ');
writeln;

end;
ss:=s[1];
for j:=1 to i+1 do

if ss<s[j] then ss:=s[j];
writeln('Suma maxima=',ss:5);
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

3. Eliminare elemente-varianta vector logic

program cerc1_varianta_vector_boolean;
const nmax=100;
type nr=1..nmax;
var i,k,n:nr;

j,m:integer;
prezent:array[nr] of boolean;

sf:char;
begin

sf := 'D';

repeat
write('n='); readln(n);
write('m='); readln(m);
for i:=1 to n do prezent[i]:=true;
i:=n;
for k:=1 to n do begin

for j:=1 to m do
repeat
if i<n then i:=i+1 else i:=1

until prezent[i];
write(i:3);
prezent[i]:=false;

end;
writeln;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

4. Eliminare elemente-varianta vector numeric

program cerc2_varianta_vector_intregi;
const nmax =100;
type nr =1..nmax;
var i,k,n:nr;

j,m:integer;
next:array[nr] of nr;

sf:char;
begin
sf := 'D';

repeat
write('n='); readln(n);
write('m='); readln(m);
for i:=1 to n-1 do next[i]:=i+1;
next[n]:=1;
i:=n;
while next[i] <> i do begin

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

end;
writeln(i:3);
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

5. Eliminare elemente-varianta calcul iterativ

program cerc3_varianta_calcul_iterativ;
const nmax=100;
type nr=1..nmax;
var i,k,n:nr;

j,m:integer;
copil:array[nr] of nr;

sf:char;
begin
sf := 'D';

repeat
write('n='); readln(n);
write('m='); readln(m);
for i:=1 to n do copil[i]:=i;
i:=1;
for k:=n downto 1 do begin

i:=(i+m-2) mod k+1;
write(copil[i]:3);
for j:=i to k-1 do

copil[j]:=copil[j+1];
end;
writeln;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

6. Eliminare elemente-varianta multime

program cerc4_varianta_multime;
const nmax=100;
type numar=1..nmax;
var i,n:numar;

j,m:integer;
multime:set of numar;

sf:char;
begin
sf := 'D';

repeat
write('n='); readln(n);
write('m='); readln(m);
multime:=[1..n];
i:=n;

while multime<>[] do begin
for j:=1 to m do
repeat
if i<n then i:=i+1

else i:=1
until i in multime;
write(i:3);

multime:=multime-[i];
end;
writeln;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

7. Eliminare elemente-varianta alocare dinamica

program cerc5_varianta_alocare_dinamica;
const nmax=100;
type list=^term;

term=record
nr:integer;
next:list;
end;

var i,n:1..nmax;
j,m:integer;
prim,p:list;

sf:char;

begin
sf := 'D';

repeat
write('n='); readln(n);
write('m='); readln(m);
new(prim);
p:=prim;
for i:=1 to n do begin

p^.nr:=i;

if i<n then begin
new(p^.next);
p:=p^.next;

end;
end;
p^.next:=prim;
i:=n;
while i>0 do begin

for j:=1 to m-1 do p:=p^.next;
write(p^.next^.nr:3);
p^.next:=p^.next^.next;
i:=i-1;

end;
writeln;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

8. Diferenta multimilor alocate static

program diferenta_a_doua_multimi;
const n_max=50;
type vector=array[1..n_max] of integer;

header=string[20];
var a,b:vector;
na,nb:integer;

sf:char;
procedure citire_vector(var v:vector; var n:integer;x:char);
var i:integer;
begin

repeat
write('nr de componente:');
readln(n)

until n in [1..n_max];

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

end;

writeln;
end;
procedure afisare_vector(v:vector; n,nr_lin:integer;h:header);
var i:integer;
begin

write(h);
for i:=1 to length(h) do h[i]:=' ';
for i:=1 to n do begin

write(v[i]:3);
if (i mod nr_lin=0)and(i<n)then begin
writeln;

write(h)
end

end
end;
function exist(v:vector;val:integer; n:integer):boolean;
var i:integer;
begin

i:=1;
while (i<n) and (val<>v[i]) do inc(i);
exist:=(n>0) and (val=v[i])

end;
procedure insert(var v:vector;val:integer;var n:integer);
begin

if not exist(v,val,n) then begin
n:=n+1;
v[n]:=val

end;
end;
procedure det_dif (v1,v2:vector;n1,n2:integer; h:header);
var d:vector;

nd,i:integer;
procedure scrie_dif;
var i:integer;
begin

if nd=0 then write ('Diferenta vida')

else afisare_vector(d,nd,5,h)
end;
begin

nd:=0;
for i:=1 to n1 do
if not exist (v2,v1[i],n2) then
insert(d,v1[i],nd);

scrie_dif
end;
begin

sf := 'D';

repeat
writeln('First vector:');
citire_vector(a,na,'a');
sf := 'D'; repeat

writeln('Second vector:');
citire_vector(b,nb,'b');
sf := 'D'; repeat
afisare_vector(a,na,10,'First vector:');
writeln;

afisare_vector(b,nb,10,'Second vector:');
writeln;
det_dif(a,b,na,nb,'FirstSecond:');
writeln;
det_dif(b,a,nb,na,'SecondFirst:');
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

9. Operatii cu multimi generate dinamic

program reuniune_si_intersectie_generate_dinamic;
const nmax=100;
type list=^nod;

nod=record
info:integer;
next:list

end;

var a:array[1..nmax]of integer;
l,l1,l2:list;
n,i:integer;

sf:char;

function reun(l1,l2:list):list; forward;
function inters(l1,l2:list):list;forward;
function creal(i,n:integer):list;
var l:list;
begin

if i>n then creal:=nil

else

begin
new(l);
l^.next:=creal(i+1,n);
l^.info:=a[i];
creal:=l

end;
end;
procedure afisl(l:list);
begin

if l<>nil then begin
write(l^.info,' ');
afisl(l^.next)

end

end;

function atasare(x:integer;l1,l2:list):list;

var prim:list;

begin
new(prim);
prim^.info:=x;
prim^.next:=reun(l1,l2);
atasare:=prim;

end;

function atasare1(x:integer;l1,l2:list):list;

var prim:list;

begin
new(prim);
prim^.info:=x;
prim^.next:=inters(l1,l2);
atasare1:=prim;

end;

function reun(l1,l2:list):list;

begin
if (l1=nil)and(l2=nil) then reun:=nil
else if l1=nil then
reun:=atasare(l2^.info,nil,l2^.next)
else if l2=nil then
reun:=atasare(l1^.info, l1^.next,nil)
else if l1^.info<l2^.info then
reun:=atasare(l1^.info,l1^.next,l2)
else if l1^.info>l2^.info then
reun:=atasare(l2^.info,l1,l2^.next)
else
reun:=atasare(l1^.info,l1^.next,l2^.next)

end;

function inters(l1,l2:list):list;

begin
if (l1=nil)or(l2=nil) then inters:=nil
else if l1^.info<l2^.info then
inters:=inters(l1^.next,l2)
else if l1^.info>l2^.info then
inters:=inters(l1,l2^.next)

else

inters:=atasare1(l1^.info,l1^.next,l2^.next);
end;
begin

sf := 'D';

repeat
write('prima lista, n='); readln(n);
for i:=1 to n do read (a[i]);
l1:=creal(1,n);
writeln;
afisl(l1);
writeln;
write('A doua lista, n='); readln(n);
for i:=1 to n do read (a[i]);
l2:=creal(1,n);
writeln;
afisl(l2);
writeln;
l:=reun(l1,l2);
writeln('reuniunea');
afisl(l);
writeln;
l:=inters(l1,l2);
writeln('intersectia');
afisl(l);
writeln;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

10. Ordonare dinamica recursiva sir numeric

program sortare_dinamica_recursiva_prin_separare;
const nmax=100;
type list=^nod;

nod=record
info:integer;
next:list

end;

var     a:array[1..nmax]of integer;
k,n:integer;
l:list;

sf:char;

function fuzi(l1,l2:list):list;

begin
if l1=nil then fuzi:=l2
else if l2=nil then fuzi:=l1

else if l1^.info<=l2^.info then

begin
l1^.next:=fuzi(l1^.next,l2);
fuzi:=l1

end

else begin
l2^.next:=fuzi(l1,l2^.next);
fuzi:=l2

end
end;
function separ(l:list):list;
var l1:list;
begin

if l=nil then separ:=nil
else if l^.next=nil then separ:=nil

else begin
l1:=l^.next;
l^.next:=l1^.next;
l1^.next:=separ(l1^.next);
separ:=l1;

end;
end;
procedure sortfuzi(var l:list);
var l1:list;
begin

if l<>nil then

if l^.next <>nil then begin
l1:=separ(l);
sortfuzi(l);
sortfuzi(l1);
l:=fuzi(l,l1);

end;
end;
function creal(i,n:integer):list;
var l:list;

begin
if i>n then creal:=nil

else begin
new(l);
l^.next:=creal(i+1,n);
l^.info:=a[i];
creal:=l;

end;
end;
procedure afisl(l:list);
begin

if l<>nil then begin
write(l^.info,' ');
afisl(l^.next);

end;
end;
begin

sf := 'D';

repeat
write('n=');
readln(n);
for k:=1 to n do begin

write('a[',k,']=');

readln(a[k]);
end;
l:=creal(1,n);
sortfuzi(l);
afisl(l);
writeln;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

11. Polinoame de o variabila generate dinamic

program polinoame_generate_dinamic;
type poli=^term;

term=record

cf:real;
ex:integer;
next:poli

end;
var p,q,sum,mult:poli;

sf:char;
procedure readp (var p:poli);
var n:0..maxint;

i:integer;
crt:poli;

begin
write('nr. termeni:');
readln(n);
if n=0 then p:=nil

else begin
writeln('introd. coef+exp in ordine descresc:');
new(p);
crt:=p;
for i:=1 to n do begin

with crt^ do read(cf,ex);

if i<n then begin
new(crt^.next);
crt:=crt^.next

end
end;
crt^.next:=nil

end;
end;
procedure adaug(cf:real;ex:integer;var p:poli; var
n:integer);
begin

if n<>1 then p:=p^.next;
n:=n+1;
p^.cf:=cf;
p^.ex:=ex;
new(p^.next)

end;
procedure writep(p:poli);
var crt:poli;
begin

crt:=p;
while crt<>nil do begin

with crt^ do begin
if cf<0 then write('-')
else if cf>0 then write('+');
if (abs(cf)<>1) or (ex=0) then write(abs(cf):2:0);
if ex>0 then write('x');
if ex>1 then write('^',ex:1)

end;

crt:=crt^.next
end;
writeln

end;
procedure sumap(p,q:poli; var sum:poli);
var crt:poli;

n:integer;

begin
new(sum);
crt:=sum;
n:=1;
while (p<>nil)and(q<>nil) do

if p^.ex < q^.ex then begin
adaug(q^.cf,q^.ex,crt,n);
q:=q^.next

end

else if p^.ex > q^.ex then begin
adaug(p^.cf,p^.ex,crt,n);
p:=p^.next

end
else begin
if p^.cf+q^.cf<>0 then

adaug(p^.cf+q^.cf,p^.ex,crt,n);
p:=p^.next;
q:=q^.next

end;

while p<>nil do begin
adaug(p^.cf,p^.ex, crt,n);
p:=p^.next

end;

while q<>nil do begin
adaug(q^.cf,q^.ex, crt,n);
q:=q^.next

end;

crt^.next:=nil

end;
procedure prodp(p,q:poli; var mult:poli);
var crt,crtp,crtq:poli;

exc,rex,n:integer;

cfc:real;

begin
if (p=nil) or (q=nil) then mult:=nil
else begin

new(mult);
crt:=mult;
n:=1;
exc:=p^.ex+q^.ex;
while exc>=0 do begin

cfc:=0;
crtp:=p;
repeat

rex:=exc-crtp^.ex;

if rex>0 then begin
crtq:=q;
while

(crtq^.ex>rex)and(crtq^.next<>nil) do
crtq:=crtq^.next;
if crtq^.ex=rex then

cfc:=cfc+crtp^.cf*crtq^.cf;
end;
crtp:=crtp^.next;

until crtp=nil;
if cfc<>0 then
adaug(cfc,exc,crt,n);

exc:=exc-1
end;
crt^.next:=nil

end;

end;

begin
sf := 'D';

repeat
readp(p);
readp(q);
write('p(x)=');
writep(p);
write('q(x)=');

writep(q);
sumap(p,q,sum);
write('p(x)+q(x)');
writep(sum);
prodp(p,q,mult);
write('p(x)*q(x)=');
writep(mult);
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

1 Afisare vector in ordine inversa

program vector_inversat;
const nmax=100;
type vector=array[1..nmax] of integer;
var v:vector;

n,i:integer;

sf:char;
begin
sf := 'D';

repeat
repeat

write('Numar elemente [1..100]:');

readln(n)
until n in [1..100];
writeln('Dati cele ',n,' elemente');
for i:=1 to n do begin

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

readln(v[i])
end;
writeln('Elementele in ordine inversa:');
for i:=n downto 1 do begin

write(v[i]:3);

if (n-i+1) mod 10=0 then writeln
end;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

13. Cautare secventiala in vector neordonat

program cautare_secventiala;
const nmax=100;

type     arr=array[1..nmax] of integer;

var list:arr;
n,i:1..nmax;
ok:boolean;
elem:integer;

sf:char;

begin
sf := 'D';

repeat
repeat

write('Dati Numarul elementelor:');

readln(n)
until n in [1..nmax];
for i:=1 to n do begin

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

readln(list[i])
end;
write('Elementul cautat=');
readln(elem);
i:=1;
ok:=false;
while not ok and (i<n) do begin

i:=i+1;

if list[i]=elem then ok:=true
end;
if ok then writeln ('Elem. ',elem,' gasit pe pozitia ',i)
else writeln ('Elem. ',elem,' negasit');
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

14. Cautare binara in vector ordonat

program cautare_binara;
const nmax=100;
type arr=array[1..nmax] of integer;
var list:arr;

n,i,linf,lsup,med:1..nmax;
ok:boolean;
elem:integer;

sf:char;
begin
sf := 'D';

repeat
repeat

write('Dati Numarul elementelor:');

readln(n)
until n in [1..nmax];
for i:=1 to n do begin

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

readln(list[i])
end;
write('Elementul cautat=');
readln(elem);
ok:=false;
linf:=1;
lsup:=n;
repeat

med:=(linf+lsup) div 2;
if elem=list[med] then ok:=true
else if elem < list[med] then lsup:=med-1

else linf:=med+1
until ok or (linf>lsup);
if ok then writeln ('Elem. ',elem,' gasit pe pozitia ',med)
else writeln ('Elem. ',elem,' negasit');
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

15. Proceduri pe siruri de caractere

program proceduri_pe_siruri;
const size=20;
type line=string[size];
var s1,s2:line;

p,c:integer;
option:char;
buflen:word;

sf:char;
begin
sf := 'D';

repeat
s1:='';
repeat

writeln('String=',s1);
write('Option[Read, Delete, Insert,
Quit]:');

readln(option);
case upcase(option) of 'R':

begin
sf := 'D'; repeat
write('New string: ');
buflen:=size;
readln(s1);

end;
'D':

begin
write('Delete starting from: ');
readln (p);
write('Number of deleted characters: ');
readln(c);
delete(s1,p,c)

end;

'I':

begin
write('Insert substr: ');
buflen:=size;
read(s2);
write('Starting from: ');
readln(p);
insert (s2,s1,p)

end;
'Q':

begin
write ('Are you sure [Y/N]:');
readln(option);
if upcase(option)='Y' then option:='Q'
end
else writeln ('Incorrect')

end;
until option='Q';
writeln('Gata!');
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

16. Conversie ;ir de caractere ]n numeric

program str_to_val;
const size=10;
type line=string[size];
var s:line;
n,code:integer;
x:real;

sf:char;
begin
sf := 'D';

repeat
repeat
write ('Numeric constant: ');
readln (s);
if length(s)>0 then

begin

val (s,n,code);
if code=0 then writeln('Is a
integer constant')

else

begin
val (s,x,code);
if code=0 then writeln('Is a real constant')

else

begin
writeln ('Error!');
writeln('Codul de eroare:19',code)
end
end

end
until s='';
writeln('Gata! Press any key');
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

17. Ordonare vector prin selectie

program sortare_prin_selectie;
const nmax=100;
var c:array[1..nmax]of integer;

k,n,min,i,j,aux:integer;

sf:char;
begin
sf := 'D';

repeat
write('Numarul componentelor:'); readln(n);

for i:=1 to n do begin

write ('c[',i,']='); readln (c[i])
end;
for i:=1 to n do begin

k:=i;
min:=c[i];
for j:=i to n do

if c[j]<min then begin
min:=c[j];
k:=j

end;
aux:=c[i];
c[i]:=c[k];
c[k]:=aux

end;
write('vectorul ordonat:');
for j:=1 to n do write(c[j],' ');
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

18. Ordonare vector prin enumerare

program sortare_prin_enumerare_da pozitia_in sirul sortat;
const nmax=100;
var c,rang:array[1..nmax]of integer;
n,i,j:integer;

sf:char;
begin
sf := 'D';

repeat
write('Numarul componentelor:'); readln(n);
for i:=1 to n do begin

rang[i]:=1;
write ('c[',i,']=');
readln (c[i])

end;
for i:=1 to n do
for j:=1 to i-1 do
if c[j]<c[i] then rang[i]:=rang[i]+1
else rang[j]:=rang[j]+1;
write('vectorul ordonat:');

for j:=1 to n do write(rang[j],' ');
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

19. Ordonare vector prin inserare

program sortare_prin_inserare;
const nmax=100;
var c:array[0..nmax]of integer;

k,n,cheie,i:integer;

sf:char;
begin
sf := 'D';

repeat
write('Numarul componentelor:'); readln(n);
for i:=1 to n do begin

write ('c[',i,']='); readln (c[i])
end;
c[0]:=-maxint;
for i:=1 to n-1 do begin

cheie:=c[i+1];
k:=i;
while cheie<c[k] do begin

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

k:=k-1
end;
c[k+1]:=cheie;

end;
write('vectorul ordonat:');
for i:=1 to n do write(c[i],' ');
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

20. Ordonare vector prin transpozitii

program sortare_prin_transpozitii;
const nmax=100;
var c:array[1..nmax]of integer;

k,n,max,i,aux:integer;
schimb:boolean;

sf:char;

begin
sf := 'D';

repeat

write('Numarul componentelor:'); readln(n);
for i:=1 to n do begin

write ('c[',i,']='); readln (c[i])
end;
k:=n;
schimb:=true;
while schimb do begin

max:=k;
schimb:=false;
for i:=1 to max-1 do

if c[i]>c[i+1] then begin
aux:=c[i];
c[i]:=c[i+1];
c[i+1]:=aux;
k:=i;
schimb:=true

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

end;
write('vectorul ordonat:');
for i:=1 to n do write(c[i],' ');
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

21. Generarea triunghiului lui Pascal

program Triunghiul_lui_Pascal;
const nmax=100;
var i,j,n:integer;

triunghi:array[1..nmax,1..nmax] of integer;

sf:char;
begin

sf := 'D';

repeat
write('n='); readln(n);
triunghi[1,1]:=1;
for j:=2 to n do triunghi[i,j]:=0;
for i:=1 to n do begin

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

triunghi[i,j]:=
triunghi[i-1,j]+triunghi[i-1,j-1];

write(triunghi[i,j]:4)
end;
for j:=i+1 to n do triunghi[i,j]:=0;
writeln

end;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

2 Generare stiva de intregi

program stiva_de_intregi;
const nmax=100;
var data,n:integer;

inalt:0..nmax;
stack:array[1..nmax] of integer;

sf:char;
begin
sf := 'D';

repeat
write('n='); readln(n);
inalt:=0;
writeln('introduceti ',n,' intregi');
while inalt <n do begin

read(data);
inalt:=succ(inalt);
stack[inalt]:=data;

end;

while inalt >0 do begin
data:=stack[inalt];
inalt:=pred(inalt);
write(data,' ')

end;
writeln;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

23. Generare coada de asteptare

program fir_de_asteptare_de_intregi;
const nmax=100;

var data,n:integer;
lung:0..nmax;
coada:array[1..nmax] of integer;

sf:char;

begin
sf := 'D';

repeat
write('n='); readln(n);
lung:=0;
writeln('introduceti ',n,' intregi');
while lung <n do begin

read(data);
lung:=succ(lung);
coada[lung]:=data;

end;
lung:=1;
while lung<=n do begin

data:=coada[lung];
lung:=succ(lung);
write(data,' ')

end;
writeln;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

24. Traversare arbore binar

program traversare_graf;
type ref=^nod;

nod=record
info:'a'..'z';
st,dr:ref

end ;
var rad:ref;

c:char;

sf:char;
procedure preordine (pointer:ref);
begin

if pointer<>nil then begin
write (pointer^.info);
preordine (pointer^.st);

preordine(pointer^.dr)

end
end;

procedure inordine (pointer:ref);
begin

if pointer<>nil then begin
inordine (pointer^.st);
write (pointer^.info);
inordine(pointer^.dr)

end
end;
procedure postordine (pointer:ref);
begin

if pointer<>nil then begin
postordine (pointer^.st);
postordine(pointer^.dr);
write (pointer^.info);

end
end;
procedure creare (var pointer:ref);
begin

read(c);

if c<>'.' then begin
new(pointer);
pointer^.info:=c;
creare (pointer^.st);
creare (pointer^.dr)

end else pointer:=nil
end;
begin

sf := 'D'; repeat
write('Arborele dat :':25);
creare (rad);
writeln;
write('Preordine :':25);
preordine (rad);
writeln;
write('Inordine :':25);
inordine (rad);
writeln;
write('Postordine :':25);
postordine (rad);
writeln;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

25. Modelarea matricilor rare

program matrice_rara;
type ind=0..25;

sir=array[ind]of integer;
mat=array[ind,ind]of integer;
var n,m,p:integer;

v:byte;

sf:char;
procedure varianta1;
var i,j,k:ind;

a,b:sir;
c:mat;

begin
writeln('Dati vectorii:'
write('Lungimea vectorilor:');
readln(m);
for i:=1 to m do begin

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

readln(a[i]);
end;
for i:=1 to m do begin

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

readln(b[i]);
end;
for i:= 1 to n do

for j:= 1 to n do
c[i,j]:=0;
for k:= 1 to m do

begin
j:=(b[k] div n)+1;
i:=b[k] mod n;
if i=0 then begin

i:=n;

j:=j-1;
end;
c[i,j]:=a[k];

end;

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

end
end;
procedure varianta2;
var i,j,k:ind;

a,b:sir;
c:mat;

begin
writeln('Dati matricea:');
k:=0;
for i:= 1 to n do

for j:=1 to n do begin
write('a[',i,',',j,']=');
readln(c[i,j]);
if c[i,j]<>0 then begin

k:=k+1;
a[k]:=c[i,j];
b[k]:=(i-1)*n+j;

end;
end;

for i:=1 to k do begin
write('v[',i,']=',a[i],' ');
writeln('o[',i,']=',b[i]);

end;
end;
procedure varianta3;
var i,j,k:ind;

a,b,c,d:sir;
e:mat;

begin
write('Dati prima matrice:');
write('Dati lungimea vectorilor:');
readln(m);
for i:=1 to m do begin

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

write('o[',i,']='); readln(b[i]);
end;
write('Dati a doua matrice:');
write('Dati lungimea vectorilor:');
readln(p);
for i:=1 to p do begin

write('v[',i,']='); readln(c[i]);
write('o[',i,']='); readln(d[i]);

end;
k:=m;
for j:= 1 to p do

begin
k:=i;
while(d[j]<>b[i]) and(i<=m) do

i:= i+1;

if i>m then begin
k:=k+1;
a[k]:=c[j];
b[k]:=d[j];

end
else a[i]:=a[i]+c[j];

end;
m:=k;
for i:= 1 to n do

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

for k:=1 to m do begin
j:=(b[k] div n)+1;
i:=b[k] mod n;
if i=0 then begin

i:=n;
j:=j-1;

end;
e[i,j]:=a[k];
end;
writeln('Matrice suma este:');
for i:= 1 to n do begin

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

end;
end;
begin

sf := 'D';

repeat
writeln('1-Se dau v si o,sa se calculeze a');
writeln('2-Se da a,sa se calculeze v si o ');

writeln('3-Se dau doua matrici sa se calculeze suma ');
write('Alegeti varianta 1,2,3:');
readln(v);
write('Dati dimensiunea matricei:');

readln(n);
case v of

varianta1;

varianta2;

3: varianta3;
end;
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.

26. Polinoame de m variabile generate static

program polinoame_de_mai_multe_variabile;
type adev=0..1;

ind=0..50;
sir=array[ind] of real;
mat=array[ind,ind]of byte;

var m,n,p,q:ind;
a,c,e:sir;
b,d,f:mat;

sf:char;

procedure citire_p(r:ind;var x:sir;var y:mat);
var i,j:ind;
begin

writeln('Dati coeficienti monoamelor:');

for i:=1 to r do begin
write('a(',i,')=');
readln(x[i]);

end;
writeln('Dati exponenti necunoscute:');
for i:=1 to r do

for j:=1 to m do begin
write('b(',i,',',j,')=');
readln(y[i,j]);

end;
end;
procedure suma_p(x,z:sir;y,t:mat;var r:ind;var u:sir;var v:mat);
var i,j:ind;
begin

for i:=1 to n do begin
u[i]:=x[i];
for j:=1 to m do v[i,j]:=y[i,j];

end;

for i:=1 to p do begin
u[n+1]:=z[i];
for j:=1 to m do v[n+1,j]:=t[i,j];

end;

r:=n+p;
end;
procedure produs_p(x,z:sir;y,t:mat;var r:ind;var u:sir;var v:mat);
var i,j,k:ind;
begin

r:=0;
for i:=1 to n do

for j:=1 to p do begin
r:=r+1;
u[r]:=x[i]*z[j];
for k:=1 to m do

v[r,k]:=y[i,k]+t[j,k];

end;
end;
procedure reducere_p(r:ind;var x:sir;var y:mat);

var i,j,k:ind;
v_adev:adev;
begin

for i:=1 to r-1 do begin
j:=i+1;
v_adev:=0;
while (v_adev=0) and (j<=r) do begin

k:=1;
v_adev:=1;
while (v_adev=1) and (k<=m) do

if y[i,k]<>y[j,k] then v_adev:=0
else k:=k+1;

j:=j+1;
end;
if v_adev=1 then begin

x[j-1]:=x[j-1]+x[i];
x[i]:=0;
end;

end;
end;
procedure micsorare_p(var r:ind;var x:sir;var y:mat);
var i,j,k:ind;
begin

i:=1;
while i<=n do begin
if x[i]=0 then begin

for j:=i+1 to r do begin
x[j-1]:=x[j];
for k:=1 to m do

y[j-1,k]:=y[j,k];
end;
r:=r-1;
i:=i-1;

end;
i:=i+1;

end;
end;
procedure afisare_p(r:ind;x:sir;y:mat);
var i,j:ind;
begin

write('P(a');
for i:=1 to m-1 do write(',',chr(ord('a')+i));
write(')=');
if x[1]<>0 then begin

write (x[1]:3:1);
for j:=1 to m do

if y[1,j]<>0 then begin
write('*',chr(ord('a')+j-1));
write('^',y[1,j]);

end;
end;
for i:=2 to r do

if x[i]<>0 then begin
if x[i]>0 then write('+')

else write('-');
write(abs(x[i]):3:1);
for j:=1 to m do

if y[i,j]<>0 then begin
write('*',chr(ord('a')+j-1));
write('^',y[i,j]);

end;

end;

writeln;
end;
begin

sf := 'D';

repeat
writeln('Dati primul polinom:');
write('Dati Numarul de monoame:');
readln(n);
write('Dati Numarul de necunoscute:');
readln(m);
citire_p(n,a,b);
writeln('Primul polinom este:');
afisare_p(n,a,b);
writeln('Dati al doilea polinom:');
write('Dati Numarul de monoame:');
readln(p);
citire_p(p,c,d);
writeln('Al doilea polinom este:');
afisare_p(p,c,d);
suma_p(a,c,b,d,q,e,f);
reducere_p(q,e,f);
micsorare_p(q,e,f);
writeln('Polinomul suma este:');
afisare_p(q,e,f);
produs_p(a,c,b,d,q,e,f);
reducere_p(q,e,f);
micsorare_p(q,e,f);
writeln('Polinomul produs este:');
afisare_p(q,e,f);
writeln(' Continuati (D / N) ? ');

read(sf);

until sf = 'N';

end.






Politica de confidentialitate




Copyright © 2024 - Toate drepturile rezervate