Programe in Pascal si C++ - probleme de teoria grafurilor

Problema 1

program Kruskal;

type muchie = record

x,y,c:integer;

end;

var v:array[1..10] of muchie;

m,n,i,cost:integer; a1,a2:integer;

T:array[1..10] of integer;

procedure citire_vector;

var i,j,x,y,c:integer;

begin

write(‘Nr. de varfuri: ‘); readln(n);

write(‘Nr. de muchii: ‘); readln(m);

for i:=1 to m do begin

write(‘Muchia ‘,i,’ (extremitati, cost)’);

readln(v[i].x,v[i].y,v[i].c);

end;

end;

procedure ordonare;

var aux:muchie; i,j:integer;

begin

for i:=1 to m-1 do

for j:=i+1 to m do

if v[i].c>v[j].c then begin

aux:=v[i]; v[i]:=v[j]; v[j]:=aux;

end;

end;

procedure arbore_partial;

var i,j,k,l,nr:integer;

begin

for i:=1 to n do t[i]:=i;

cost:=0; i:=1;

nr:=0;

while nr<n-1 do begin

if t[v[i].x]<>t[v[i].y] then begin

nr:=nr+1;

cost:=cost+v[i].c;

write(‘[‘,v[i].x,’,’,v[i].y,’]’);

k:=t[v[i].x];l:=t[v[i].y];

for j:=1 to n do

if t[j]=k then t[j]:=l;

end;

i:=i+1;

end;

writeln;

writeln(‘Costul arborelui partial este: ‘, cost);

end;

begin

citire_vector; ordonare; arbore_partial;

end.

Problema 2

program drumuri;

type vect=array[1..30] of integer;

var a:array[1..30,1..30] of integer;

n,cost:integer; S,T,C:vect;

procedure citire_matrice;

var i,j:integer;

begin

Proiect: Fisa de lucru - operatii cu numere intregi Referat: Jocuri didactice matematica - lantul buclucas

write(‘Nr de localitati (impreuna cu orasul resedinta de judet): ‘); readln(n);

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

for i:=1 to n do

for j:=i+1 to n do begin

write(‘Cost a[‘,i,’,’,j,’]=’); readln(a[i,j]);

a[j,i]:=a[i,j];

end;

end;

procedure afisare;

var i:integer;

begin

for i:=2 to n do

writeln(t[i]:4,i:4);

cost:=0;

for i:=1 to n do cost:=cost+c[i];

end;

procedure formare_arbore;

var k,i,j,start,n1,n2,cost_min:integer;

begin

for i:=1 to n do begin

S[i]:=0; T[i]:=0; C[i]:=0;

end;

start:=1; s[start]:=1;

for k:=1 to n-1 do begin

cost_min:=maxint; n1:=-1; n2:=-1;

for i:=1 to n do

for j:=1 to n do

if (s[i]=1) and (s[j]=0) then

if (a[i,j]<cost_min) then begin

cost_min:=a[i,j]; n1:=i; n2:=j;

end;

s[n2]:=1; T[n2]:=n1; c[n2]:=a[n1,n2];

end;

end;

begin

citire_matrice; formare_arbore; afisare;

writeln(‘Costul minim este: ‘, cost);

end.

Problema 3

program arbori_partiali;

type matrice = array[1..20,1..20] of integer;

muchie = record

x,y,c:integer;

end;

vector=array[1..20] of muchie;

vector1=array[1..20] of integer;

var m,n,i,j,k,nr,cost,c_min:integer;

v:vector; st:vector1; a,mat,sol:matrice;

procedure citire;

var f:text;

begin

assign(f,’text.in’);reset(f);readln(f,n,m);

fillchar(a,sizeof(a),0);

for i:=1 to m do begin

readln(f,v[i].x,v[i].j,v[i].c);

a[v[i].x,v[i].y]:=1; a[v[i].y,v[i].x]:=1;

end;

close(f);

end;

function conex(a:matrice):Boolean;

var i,j,k:integer;

begin

for k:=1 to n do

for i:=1 to n do

for j:=1 to n do

if a[i,j]=0 then a[i,j]:=a[i,k]*a[k,j];

conex:=true;

for i:=2 to n do

if a[1,i]=0 then conex:=false;

end;

procedure verific;

var i,n1:integer; nod:vector1;

begin

fillchar(mat,sizeof(mat),0);fillchar(nod,sizeof(nod),0);

for i:=1 to n-1 do begin

mat[v[st[i]].x,v[st[i]].y]:=1;

mat[v[st[i]].y,v[st[i].x]]:=1;

nod[v[st[i]].x]:=1; nod[v[st[i].y]:=1;

end;

n1:=0;

for i:=1 to n do

if nod[i]=1 then n1:=n1+1;

if (n1=n) and conex(mat) then begin

cost:=0;

for i:=1 to n-1 do cost:=cost+v[st[i]].c;

if cost<c_min then begin

nr:=1;

c_min:=cost;

for i:=1 to n-1 do sol[nr,i]:=st[i];

end

else

if cost=c_min then begin

nr:=nr+1;

for i:=1 to n-1 do sol[nr,i]:=st[i];

end;

end;

end;

procedure back(k:integer);

var i:integer;

bagin

if k=n then

verific

else

if k=1 then

for i:=1 to m do begin

st[k]:=i; back(k+1);

end

else

for i:=st[k-1]+1 to m do begin

st[k]:=i; back(k+1);

end;

end;

procedure tipar;

begin

for i:=1 to nr do begin

for j:=1 to n-1 do

write(‘[‘,v[sol[i,j]].x,’,’,v[sol[i,j]].y,’] ‘);

writeln;

end;

end;

begin

citire;

if not conex(a) then

writeln(‘Graful nu este conex’)

else begin

c_min:=maxint; back(1); tipar;

end;

readln;

end.