Referat Probleme De Informatica
Mai jos puteti citi fragmente din
Referat Probleme De Informatica si de asemenea puteti face
Download Referat Probleme de informaticaCiteste fragmente din Referat Probleme De Informatica
Problema 1
Se dau n oraşe. Se cunoaşte distanţa dintre oricare două oraşe. Un
distribuitor de carte caută să-şi facă un depozit în unul dintre
aceste oraşe. Se cere să se găsească traseul optim de la depozit
către celelalte oraşe astfel încât distanţa totală pe care o va
parcurge pentru a distribui în toate celelalte n-1 oraşe să fie
minimă. Să se precizeze care ar fi oraşul în care să se afle
depozitul pentru ca toate celelalte oraşe să fie uşor accesibile {din
acel centru de depozitare să se poată pleca spre cât mai multe alte
oraÅŸe}.
Rezolvare:
program oraÅŸ_depozit;
uses crt;
type muchie=record
vf1, vf2, cost:integer;
end;
type vector=array[1..100] of longint;
vector1=array[1..100] of muchie;
matrice=array[1..50,1..50] of longint;
var n, i, j, k, v, cost:integer;
s, t:vector:
x:vector1;
a:matrice;
f:text;
procedure citire;
var i, j, m:integer;
begin
assign (f, ‘depozit.txt’);
reset (f);
readln (f, n); m:=0;
while not eof(f) do
begin
inc(m);
read (f,x[m].vf1);
read (f,x[m].vf2);
read (f,x[m].cost);
end;
for i:=1 to m do
begin
a[x[i].vf1, x[i].vf2:=x[i].cost];
a[x[i].vf2, x[i].vf1:=x[i].cost];
end;
writeln (‘matricea costurilor este:’);
for i:=1 to n do
begin
for j:=1 to n do
write (a[i,j], ‘ ‘);
writeln;
end;
end;
procedure prim;
var i, j, min:integer;
begin
for i:= to n do
s[i]:=v;
s[v]:=0
for i:=1 to n do
t[i]:=0;
cost:=0;
for k:=1 to n-1 do
begin
min:=maxint;
for i:=1 to n do
if (s[i]<>0) then
if (a[s[i], i]
0) then
begin
min:=a[s[i], i];
j:=1;
end;
t[j]:=s[j];
cost:=cost+a[j, s[j]];
s[j]:=0
for i:=1 to n do
if (s[i]<>0) then
if (a[i,s[i]]=0) or (a[i,s[i]]>a[i,j]) then
if a [i,j]<>0 theen
s[i]:=j;
end;
end;
function fii(x:integer):integer;
var k:integer;
begin
k:=0;
for i:=1 to n do
if t[i]=x then
inc(k);
fii:=k;
end;
procedure tata(v:integer);
var i:integer;
begin
for I:=1 to n do
if t[v]=i then
begin
t[i]:=v;
t[v]:=0;
end;
end;
ÅŸ;
var max,i,j:integer;
begin
max:=0;
for i:=1 to n do
if fii(i)>max then
max:=fii(i);
writeln(‘orasele optime sunt:’)
for i:=1 to n do
if fii(i)=max then
begin
write(i,’ ‘);
tata(i);
write (‘vectorul tata este:’);
for j:=1 to n do write(t[j], ‘ ‘);
writeln;
end;
end;
begin
clrscr;
citire;
writeln(‘dati vf de pornire’) ; readln(v) ;
prim ;
writeln(‘costul arborelui este :’, cost) ;
oras;
readkey ;
end.
Problema 2
Se dă un graf neorientat. Să se creeze un arbore parţial de cost
minim care să poată fi memorat apoi sub forma unei liste.
Rezolvare:
Program arbore_lista;
uses crt;
type muchie=record
vf1, vf2, cost:integer;
end;
type vector=array[1..50] of longint;
vector1=array[1..100]of muchie;
matrice=array[1..20,1..50]of longint
var n,i,j,k,v,cost,y,z,m:integer;
s,t,s1,t1:vector;
x:vector1;
a,a1:matrice;
f:text;
procedure citire;
var i,j,m:integer;
begin
assign (f, ’depozit.txt’);
reset (f);
readln (f,n); m:=0;
while not eof (f) do
begin
inc(m);
read (f,x[m].vf1);
read (f,x[m].vf2);
read (f,x[m].cost);
readln (f);
end;
for i:=1 to m do
begin
a[x[i].vf1, x[i].vf2:=x[i].cost];
a[x[i].vf2, x[i].vf1:=x[i].cost];
end;
writeln ( ’matricea costurilor este:’);
for i:=1 to n do
begin
for j:=1 to n do
write (a[i,j], ’ ’);
writeln
end;
end;
function fii (y:integer):integer;
var k,j:integer;
begin
k:=0;
for j:=1 to n do
if t[j]=y then
inc(k);
fii:=k;
end;
procedure prim (a:matrice);
var i,j,min:integer;
begin
min:=maxint;
for i:=1 to n do
if (s[i]<>0) then
if (a[s[i], i]0
then
begin
min:=a[s[i], i];
j:=i;
end;
if (((s[j]<>v) and (fii(s[j])=0)) or (s[j]=v) and (fii(s[j])<=1))) then
begin
t[j]:=s[j];
cost:=cost+a[j,s[j]];
s[j]:=0;
for i:=1 to n do
if (s[i]<>0) then
if (a[i,s[i]]=0) or (a[i,s[i]]>a[i,j]) then
if a[i,j]<>0 then
s[i]:=j;
inc(m);
end;
else
begin
a1:=a;
a1[s[j],j]:=0;
prim (a1);
end;
end;
begin
clrscr;
citire;
writeln(’dati vf de pornire’); readln(v);
m:=0;
for i:=1 to n do
s[i]:=v;
s[v]:=0;
for i:=1 to n do
t[i]:=0;
cost:=0;
repeat prim(a);
until m=n-1;
write (’vectorul tata este:’);
for i:=1 to n do
write (t[i], ’ ’);
writeln;
writeln (’costul arborelui este:’ , cost);
readkey;
end.
Problema 3
Se dă un graf orientat şi se cere să se afle dacă există un arbore
parţial de cost minim. Dar o arborescenţă de cost minim? Dacă
există să se afle care este este vârful acesteia.
Rezolvare
program arborescenta;
uses crt;
type muchie=record
vf1,vf2,cost:integer;
end;
type vector=array[1..100] of longint;
vector1=array[1..100] of muchie;
matrice=array[1..50,1..50] of longint;
var n,i,j,k,v,cost:integer;
s,t:vector;
x:vector1;
a:matrice;
f:text;
procedure citire;
var i,j,m:integer;
begin
assign(f, orient.txt );
reset(f);
readln(f,n);m:=0;
while not eof(f) do
begin
inc(m);
read(f,x[m].vf1);
read(f,x[m].vf2);
read(f,x[m].cost);
readln(f);
end;
for i:=1 to m do
a[x[i].vf1,x[i].vf2]:=x[i].cost;
writeln( Matricea costurilor este: );
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j], );
writeln;
end;
end;
procedure prim;
var i,j,min:integer;
begin
for i:=1 to n do
s[i]:=v;
s[v]:=0;
for i:=1 to n do
t[i]:=0;
cost:=0;
for k:=1 to n-1 do
begin
min:=maxint;
for i:=1 to n do
if (s[i]<>0) then
if (a[s[i],i]0) then
begin
min:=a[s[i],i];
j:=i;
end;
t[j]:=s[j];
cost:=cost+a[s[j],j];
s[j]:=0;
for i:=1 to n do
if (s[i]<>0) then
if (a[s[i],i]=0) or (a[s[i],i]>a[j,i]) then
if a[j,i]<>0 then
s[i]:=j;
end;
end;
begin笠æ…Âæ¹©à µ½æ±£çÂ²ç‰£à ´»â€ æŒ ç‘©ç‰©ãÂ¥â€Â†牷瑩汥⡮ä§瑡â©
