felixee1.pas

来自「This ar the basic programs that i did in」· PAS 代码 · 共 55 行

program doi_plus_doi_egal_cinci;
var a:array [1..30,1..30] of byte;
    d:array[1..30,1..30]of array[0..30]of byte;
    n,x,y,i:integer;
procedure citire;
  var n,i,j,c:integer;
      f:text;
begin
assign(f,'graf.txt');
reset(f);
while not eof(f) do
                 begin
                 readln(f,i,j,c);
                 a[i,j]:=c;
                 a[j,i]=c;
                 end;
close(f);
for k:=1 to n do
    for i:=1 to n do
        for j:=1 to n do
            if a[i,j]=0 and(i<>j) then a[i,j]:=10000;
end;
procedure drum;
var i,j,k:integer;
begin
for i:=1 to n do
    for j:=1 to n do
    if a[i,j]<10000 and a[i,j]>0 then
       begin
       d[i,j][0]:=2;
       d[i,j][1]:=i;
       d[i,j][2]:=j;
       end;
for k:=1 to n do
    for i:=1 to n do
        forj:=1 to n do
        if a[i,j]>(a[i,k]+a[j,k]) then
                          begin
                          a[i,j]:=a[i,k]+a[j,k];
                          d[i,j][0]:=d[i,k][0]+a[j,k][0]-1;
                          for p:=1 to d[i,k][0] do d[i,j][p]:=d[i,k][p];
                          for q:=2 to d[k,j][0] do d[i,j][p+q-1]:=d[k,j][q];
                          end;
end;
begin
citire;
write('x=');read(x);
write('y=');read(y);
drum;
if a[x,y]=1000 then write ('nu exista');
               else begin
                    write('costul minim e' ,a[x,y]);
                    for i:=1 to d[x,y][0] do write(d[x,y][i],' ');
                    end;
end;