Probleme 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]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;
procedure oraş;
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
if (a[s[i],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;
t[j]:=-1;
s[j]:=-1;
for i:=1 to n do
begin
a[i,j]:=0;
a[j,i]:=0;
end;
end;
write('Costul arborelui este:',cost);
end;
begin {main}
clrscr;
citire;
writeln('Dati vf de pornire!');readln(v);
write('m=');read(m);
write('p=');read(p);
for i:=1 to n do
s[i]:=v;
s[v]:=0;
for i:=1 to n do
t[i]:=0;
for k:=1 to m-1 do
begin
for i:=1 to n do
begin
if t[i]=0 then
begin
write(i,' ');
prim;
for j:=1 to n do
if t[j]=0 then s[j]:=i;
s[i]:=-1;writeln;
end;
s[v]:=-1;
t[v]:=-1;
end;
end;
readkey;
end.
Problema 5
Se defineşte o muchie a unui graf neorientat ca fiind o înregistrare cu trei câmpuri, două vârfuri extremităţi şi un cost afişare. Să se afişeze muchia de cost minim.
Rezolvare
Program cost;
type muchie=record;
vf1, vf2, cost:integer;
end;
var