Floyd O(N^3) get TL. How can be faster? (+) CONST Dim = 207; oo = 1000000000.0; VAR D:Array[1..Dim,1..Dim] of real; B:Array[1..Dim,1..Dim] of integer; X,Y:Array[1..Dim] of real; P:Array[0..Dim] of integer; SF,SU,AX,AY,BX,BY:real; N:integer; PROCEDURE ReadData; var V1,V2,i,j:integer; T:real; begin readln(SF,SU); readln(N); for i:=1 to N do readln(X[i],Y[i]); for i:=1 to N do for j:=1 to N do D[i,j]:=sqrt(sqr(X[i]-X[j])+sqr(Y[i]-Y[j]))/SF; repeat readln(V1,V2); if V1+V2=0 then break; T:=sqrt(sqr(X[V1]-X[V2])+sqr(Y[V1]-Y[V2]))/SU; if T<D[V1,V2] then begin D[V1,V2]:=T; D[V2,V1]:=T end; until false; readln(AX,AY); readln(BX,BY); end; PROCEDURE WritePath(V1,V2:integer); begin if B[V1,V2]=V1 then begin inc(P[0]); P[P[0]]:=V1 end else begin WritePath(V1,B[V1,V2]); { write(B[V1,V2],' ');} WritePath(B[V1,V2],V2); end; end; PROCEDURE Solve; var V1,V2,k,i,j:integer; Min:real; begin for i:=1 to N do for j:=1 to N do B[i,j]:=i; for k:=1 to N do for i:=1 to N do for j:=1 to N do if D[i,k]+D[k,j]<D[i,j] then begin D[i,j]:=D[i,k]+D[k,j]; B[i,j]:=k; end; Min:=sqrt(sqr(AX-BX)+sqr(AY-BY)); V1:=0; V2:=0; for i:=1 to N do for j:=1 to N do if sqrt(sqr(AX-X[i])+sqr(AY-Y[i]))/SF + sqrt(sqr(BX-X[j])+sqr(BY-Y[j]))/SF + D[i,j] < Min then begin Min := sqrt(sqr(AX-X[i])+sqr(AY-Y[i]))/SF + sqrt(sqr(BX-X[j])+sqr(BY-Y[j]))/SF + D[i,j]; V1:=i; V2:=j; end; writeln(Min:0:7); if V1=V2 then writeln(0) else begin P[0]:=0; WritePath(V1,V2); inc(P[0]); P[P[0]]:=V2; write(P[0]); for i:=1 to P[0] do write(' ',P[i]); writeln end; end; BEGIN { assign(INPUT,'1205.dat'); reset(INPUT);} ReadData; { close(INPUT);} Solve; END. use dijkstra :) Posted by rbecq 19 Oct 2002 21:23 > CONST Dim = 207; > oo = 1000000000.0; > > VAR D:Array[1..Dim,1..Dim] of real; > B:Array[1..Dim,1..Dim] of integer; > X,Y:Array[1..Dim] of real; > P:Array[0..Dim] of integer; > SF,SU,AX,AY,BX,BY:real; > N:integer; > > PROCEDURE ReadData; > var V1,V2,i,j:integer; > T:real; > begin > readln(SF,SU); > readln(N); > for i:=1 to N do readln(X[i],Y[i]); > for i:=1 to N do > for j:=1 to N do D[i,j]:=sqrt(sqr(X[i]-X[j])+sqr(Y[i]-Y[j]))/SF; > repeat > readln(V1,V2); > if V1+V2=0 then break; > T:=sqrt(sqr(X[V1]-X[V2])+sqr(Y[V1]-Y[V2]))/SU; > if T<D[V1,V2] then begin D[V1,V2]:=T; D[V2,V1]:=T end; > until false; > readln(AX,AY); > readln(BX,BY); > end; > > PROCEDURE WritePath(V1,V2:integer); > begin > if B[V1,V2]=V1 > then begin inc(P[0]); P[P[0]]:=V1 end > else begin > WritePath(V1,B[V1,V2]); > { write(B[V1,V2],' ');} > WritePath(B[V1,V2],V2); > end; > end; > > PROCEDURE Solve; > var V1,V2,k,i,j:integer; > Min:real; > begin > for i:=1 to N do > for j:=1 to N do B[i,j]:=i; > for k:=1 to N do > for i:=1 to N do > for j:=1 to N do > if D[i,k]+D[k,j]<D[i,j] then begin > D[i,j]:=D[i,k]+D[k,j]; > B[i,j]:=k; > end; > Min:=sqrt(sqr(AX-BX)+sqr(AY-BY)); > V1:=0; V2:=0; > for i:=1 to N do > for j:=1 to N do > if sqrt(sqr(AX-X[i])+sqr(AY-Y[i]))/SF + > sqrt(sqr(BX-X[j])+sqr(BY-Y[j]))/SF + D[i,j] < Min then > begin > Min := sqrt(sqr(AX-X[i])+sqr(AY-Y[i]))/SF + > sqrt(sqr(BX-X[j])+sqr(BY-Y[j]))/SF + D[i,j]; > V1:=i; V2:=j; > end; > writeln(Min:0:7); > if V1=V2 then writeln(0) > else begin > P[0]:=0; > WritePath(V1,V2); inc(P[0]); P[P[0]]:=V2; > write(P[0]); > for i:=1 to P[0] do write(' ',P[i]); > writeln > end; > end; > > BEGIN > { assign(INPUT,'1205.dat'); reset(INPUT);} > ReadData; > { close(INPUT);} > Solve; > END. > Re: use dijkstra :) Posted by Smith 5 Jun 2009 18:37 Wrong programm noob =) |