1 cho minh gui nho chieu delete ngen Tue Jun 19, 2012 11:07 am
Beokaka
Vip
PROGRAM ddnt;
CONST
max=100;
maxa=10000;
VAR m,n,s,c:BYTE;
a:ARRAY[0..max,0..max] OF INTEGER;
d:ARRAY[0..max] OF INTEGER;
q:ARRAY[0..max] OF INTEGER;
p:ARRAY[0..max] OF INTEGER;
PROCEDURE doctep;
VAR u,v,i:BYTE;
f:TEXT;
BEGIN
assign(f,'dothi.inp');
reset(f);
read(f,m,n,s,c);
{ FOR u:=1 TO n DO
FOR v:=1 TO n DO
IF(u=v)THEN a[u,v]:=0 ELSE a[u,v]:= maxa;}
fillchar(a,sizeof(a),0);
FOR i:=1 TO m DO BEGIN
readln(f,u,v,a[u,v]);
a[v,u]:=a[u,v];
END;
close(f);
END;
PROCEDURE khoitao;
VAR i:INTEGER;
BEGIN
FOR i:=1 TO n DO BEGIN
q[i]:=i;
d[i]:=maxa;
END;
d[s]:=0;
{fillchar(t,sizeof(t),true);}
END;
PROCEDURE xoa(u:INTEGER);
VAR k,i:INTEGER;
BEGIN
k:=n;
FOR i:=1 TO k-1 DO BEGIN
q[i]:=q[i+1];
k:=k-1;
END;
END;
PROCEDURE tinh;
VAR i,u,v,min,c:INTEGER;
BEGIN
REPEAT
u:=0;min:=maxa;
IF (d[i] d[i]:=min;
u:=i;
END;
IF (u>0) THEN BEGIN
xoa(u);
FOR v:=1 TO n DO
IF d[v]>d[u]+a[u,v] THEN
BEGIN
d[v]:=d[u]+a[u,v];
p[v]:=u;
END;
END;
UNTIL FALSE;
END;
PROCEDURE xuat;
VAR u,j:INTEGER;
k:ARRAY[0..max]OF INTEGER;
BEGIN
j:=0;
u:=c;
WHILE u>0 DO BEGIN
inc(j);
k[j]:=u;
u:=p[u];
END;
FOR u:=j DOWNTO 1 DO write(k[j]:5);
END;
BEGIN
doctep;
khoitao;
tinh;
xuat;
readln;
END.
CONST
max=100;
maxa=10000;
VAR m,n,s,c:BYTE;
a:ARRAY[0..max,0..max] OF INTEGER;
d:ARRAY[0..max] OF INTEGER;
q:ARRAY[0..max] OF INTEGER;
p:ARRAY[0..max] OF INTEGER;
PROCEDURE doctep;
VAR u,v,i:BYTE;
f:TEXT;
BEGIN
assign(f,'dothi.inp');
reset(f);
read(f,m,n,s,c);
{ FOR u:=1 TO n DO
FOR v:=1 TO n DO
IF(u=v)THEN a[u,v]:=0 ELSE a[u,v]:= maxa;}
fillchar(a,sizeof(a),0);
FOR i:=1 TO m DO BEGIN
readln(f,u,v,a[u,v]);
a[v,u]:=a[u,v];
END;
close(f);
END;
PROCEDURE khoitao;
VAR i:INTEGER;
BEGIN
FOR i:=1 TO n DO BEGIN
q[i]:=i;
d[i]:=maxa;
END;
d[s]:=0;
{fillchar(t,sizeof(t),true);}
END;
PROCEDURE xoa(u:INTEGER);
VAR k,i:INTEGER;
BEGIN
k:=n;
FOR i:=1 TO k-1 DO BEGIN
q[i]:=q[i+1];
k:=k-1;
END;
END;
PROCEDURE tinh;
VAR i,u,v,min,c:INTEGER;
BEGIN
REPEAT
u:=0;min:=maxa;
IF (d[i]
u:=i;
END;
IF (u>0) THEN BEGIN
xoa(u);
FOR v:=1 TO n DO
IF d[v]>d[u]+a[u,v] THEN
BEGIN
d[v]:=d[u]+a[u,v];
p[v]:=u;
END;
END;
UNTIL FALSE;
END;
PROCEDURE xuat;
VAR u,j:INTEGER;
k:ARRAY[0..max]OF INTEGER;
BEGIN
j:=0;
u:=c;
WHILE u>0 DO BEGIN
inc(j);
k[j]:=u;
u:=p[u];
END;
FOR u:=j DOWNTO 1 DO write(k[j]:5);
END;
BEGIN
doctep;
khoitao;
tinh;
xuat;
readln;
END.