Информационная система железнодорожной сети / GRAFUTIL

unit GrafUtil; {®ЇҐа жЁЁ б Ја д®¬ ®ЇЁб ­­л¬ ў types.pas}

interface

uses Types, CRT;
{Їа®ўҐаЄ  ­ «ЁзЁп ᮥ¤Ё­Ґ­Ёп ¬Ґ¦¤г бв ­жЁп¬Ё}
function Connected(const G:TGraph; Index1, Index2:byte):boolean;
{гбв ­®ўЁвм ᮥ¤Ё­Ґ­ЁҐ ¬Ґ¦¤г бв ­жЁп¬Ё}
procedure SetConnection(var G:TGraph; Index1, Index2:byte);
{гЎа вм ᮥ¤Ё­Ґ­ЁҐ ¬Ґ¦¤г бв ­жЁп¬Ё}
procedure RemoveConnection(var G:TGraph; Index1, Index2:byte);
{г¤ «Ґ­ЁҐ «Ёи­Ёе ббл«®Є ЇаЁ 㬥­м襭ЁЁ Ја д }
procedure ResizeGraph(var G:TGraph; newSize:byte);
{б®еа ­Ёвм ¦/¤ бҐвм Ё а бЇЁб ­ЁҐ ў д ©«}
procedure SaveGraph(var f:text; const G:TGraph);
{§ Јаг§Ёвм ¦/¤ бҐвм Ё а бЇЁб ­ЁҐ Ё§ д ©« }
procedure LoadGraph(var f:text; var G:TGraph);
{г¤ «Ёвм а бЇЁб ­ЁҐ, ўбҐ ᮥ¤Ё­Ґ­Ёп бв ­жЁ© Ё б ¬Ё бв ­жЁЁ}
procedure DeleteGraph(var G:TGraph);
{¤®Ў ўЁвм бва®Єг а бЇЁб ­Ёп ¤«п ўҐвўЁ}
procedure AddTimeTableLine(var G:TGraph; Index1,Index2:byte; R:TRoute);
{Ї®Є § вм в Ў«Ёжг а бЇЁб ­Ёп ¤«п ўҐвўЁ}
procedure ShowTimeTable(const G:TGraph; Index1,Index2:byte);
{ў®§ўа й Ґв гЄ § вҐ«м ­  в Ў®Ёжг а бЇЁб ­Ёп ўҐвўЁ}
function GetTimeTable(const G:TGraph; Index1,Index2:byte):PTimeTableElem;
{ў®§ўа й Ґв Ё­¤ҐЄб бв ­жЁЁ, бв®п饩 ­  § ¤ ­­®¬ ¬Ґб⥠ў бЇЁбЄҐ ᬥ¦­®бвЁ}
function GetIndex(const G:Tgraph; Index1,Order:byte):byte;
{Ї®ЁбЄ Єа в砩襣® ЇгвЁ}
procedure FastestWay(var G:TGraph; vFrom, vTo:byte; DT:TTime; var res:TWay; cheap:boolean; var err:boolean);

implementation

{Їа®ўҐаЁвм ­ «ЁзЁҐ ᮥ¤Ё­Ґ­Ёп}
function Connected(const G:TGraph; Index1, Index2:byte):boolean;
var t:PDestination;
begin
if Index1<>Index2 then
begin
t:=G.Vertices[Index1].Connections; {Їлв Ґ¬бп ­ ©вЁ б।Ё ᬥ¦­ле ­г¦­го}
while (t<>nil) and (t^.Where<>Index2) do t:=t^.NextStation;
Connected:=(t<>nil)
end else Connected:=false
end;

{ᮥ¤Ё­пҐв ¤ўҐ бв ­жЁЁ, ЇаЁ н⮬ ЇаҐ¤Ї®« Ј Ґвбп, з⮠ᮥ¤Ё­Ґ­Ёп ҐйҐ ­Ґв}
procedure SetConnection(var G:TGraph; Index1, Index2:byte);
var t,t2,x:PDestination;
begin
if Index1<>Index2 then
begin
new(t); {ᮥ¤Ё­Ёвм ЇҐаўго б® ўв®а®©}
t^.Where:=Index2;
t^.TimeTable:=nil;
t^.TimeTableLines:=0;
t^.NextStation:=nil;
x:=G.Vertices[Index1].Connections;
if x<>nil then {­®ў п бв ­жЁп ЇаЁб®Ґ¤Ё­пҐвбп ў Є®­Ґж бЇЁбЄ }
begin
while x^.NextStation<>nil do x:=x^.NextStation;
x^.NextStation:=t
end else G.Vertices[Index1].Connections:=t;
new(t2); {ᮥ¤Ё­Ёвм ўв®аго б ЇҐаў®©}
t2^.Where:=Index1;
t2^.TimeTable:=nil;
t2^.TimeTableLines:=0;
t2^.NextStation:=nil;
x:=G.Vertices[Index2].Connections;
if x<>nil then
begin
while x^.NextStation<>nil do x:=x^.NextStation;
x^.NextStation:=t2
end else G.Vertices[Index2].Connections:=t2;
end;
end;

{г¤ «пҐв ᮥ¤Ё­Ґ­ЁҐ ¬Ґ¦¤г бв ­жЁп¬Ё, ЇаЁ н⮬ ЇаҐ¤Ї®« Ј Ґвбп, зв® ®­® Ґбвм}
procedure RemoveConnection(var G:TGraph; Index1, Index2:byte);
var t,t1:PDestination;
p:PTimeTableElem;
begin
t:=G.Vertices[Index1].Connections;
t1:=t;
while t^.Where<>Index2 do {­ ©вЁ ᮥ¤Ё­Ґ­ЁҐ}
begin
t1:=t;
t:=t^.NextStation;
end;
p:=t^.TimeTable;
while t^.TimeTable<>nil do {г¤ «Ёвм а бЇЁб ­ЁҐ ўҐвўЁ}
begin
t^.TimeTable:=p^.Next;
dispose(p);
p:=t^.TimeTable
end;
if t=t1 then G.Vertices[Index1].Connections:=t^.NextStation
else t1^.NextStation:=t^.NextStation;
dispose(t);
{в® ¦Ґ б ¬®Ґ б® ўв®а®© бв ­жЁҐ©}
t:=G.Vertices[Index2].Connections;
t1:=t;
while t^.Where<>Index1 do
begin
t1:=t;
t:=t^.NextStation;
end;
p:=t^.TimeTable;
while t^.TimeTable<>nil do
begin
t^.TimeTable:=p^.Next;
dispose(p);
p:=t^.TimeTable
end;
if t=t1 then G.Vertices[Index2].Connections:=t^.NextStation
else t1^.NextStation:=t^.NextStation;
dispose(t);
end;

{г¤ «Ёвм ўбҐ б®Ґ¤Ё­Ґ­Ёп ¬Ґ¦¤г ўбҐ¬Ё бв ­жЁп¬Ё}
procedure ResizeGraph(var G:TGraph; NewSize:byte);
var i,j:byte;
begin
if NewSize<G.Number then
begin
for i:=1 to NewSize do
for j:=NewSize+1 to G.Number do
if Connected(G,i,j) then RemoveConnection(G,i,j)
end;
G.Number:=NewSize;
end;

{¤®Ў ўЁвм бва®Єг а бЇЁб ­Ёп ¤«п ўҐвўЁ, ЇаҐ¤Ї®« Ј Ґвбп, зв® ўҐвўм Ґбвм}
procedure AddTimeTableLine(var G:TGraph; Index1,Index2:byte; R:TRoute);
var t:PDestination; {гЄ § вҐ«м ­  бЇЁб®Є ᬥ¦­®бвЁ}
p:PTimeTableElem; {гЄ § вҐ«м ­  а бЇЁб ­ЁҐ}
pp:PTimeTableElem;
begin
t:=G.Vertices[Index1].Connections;
while t^.Where<>Index2 do t:=t^.NextStation; {­ ©вЁ ᮥ¤Ё­Ґ­ЁҐ б® ўв®а®©}
if t^.TimeTableLines<>MaxLines then {Ґб«Ё ­Ґ ¤®бвЁЈ­г⠯।Ґ« ®ЎкҐ¬ }
begin {а бЇЁб ­Ёп}
new(pp);
pp^.Next:=nil;
pp^.Route:=R;
p:=t^.TimeTable;
if p<>nil then
begin {­®ў п бва®Є  а бЇЁб ­Ёп ЇаЁб®Ґ¤Ё­пҐвбп ў Є®­Ґж в Ў«Ёжл}
while p^.Next<>nil do p:=p^.next;
p^.next:=pp
end else t^.TimeTable:=pp;
inc(t^.TimeTableLines);
end;
end;

{ўлўҐбвЁ а бЇЁб ­ЁҐ ¤«п ўҐвўЁ}
procedure ShowTimeTable(const G:TGraph; Index1,Index2:byte);
var t:PDestination;
p:PTimeTableElem;
begin
if Connected(G,Index1,Index2) then {Їа®ўҐаЁвм, Ґбвм «Ё ўҐвўм}
begin
clrscr;
t:=G.Vertices[Index1].Connections;{­ ©вЁ ў бЇЁбЄҐ ўв®аго бв ­жЁо}
while t^.Where<>Index2 do t:=t^.NextStation;
p:=t^.TimeTable; {гЄ § вҐ«м ­  а бЇЁб ­ЁҐ}
while p<>nil do {Їа®©вЁ Ї® ўбҐ© в Ў«ЁжҐ а бЇЁб ­Ёп Ё ўлўҐбвЁ ҐҐ ­  нЄа ­}
begin
writeTime(p^.Route.DepTime);
write(' ');
writeTime(p^.Route.ArrTime);
write(' ');
writeln(p^.Route.price);
p:=p^.Next
end;
end;
end;

{б®еа ­Ёвм ¦/¤ бҐвм б а бЇЁб ­ЁҐ¬ ў д ©«}
procedure SaveGraph(var f:text; const G:TGraph);
var i:byte;
t:PDestination;
p:PTimeTableElem;
begin
writeln(f,#0); {Є®­ва®«м­л© бЁ¬ў®«}
{б®еа ­Ёвм бЇЁб®Є бв ­жЁ©}
for i:=1 to G.Number do SaveStr(f,G.Vertices[i].Name);
writeln(f);
for i:=1 to G.Number do {б®еа ­Ёвм ᮥ¤Ё­Ґ­Ёп бв ­жЁ©}
begin
write(f,'#'); {б«г¦Ґо­л© бЁ¬ў®« ¤«п ®вб«Ґ¦Ёў ­Ёп Ё§®«Ёа®ў ­­ле бв ­жЁ©}
t:=G.Vertices[i].Connections;
while t<>nil do
begin
write(f,t^.where:4);
t:=t^.NextStation
end;
writeln(f);
end;
writeln(f);
for i:=1 to G.Number do {б®еа ­Ёвм а бЇЁб ­ЁҐ Ї®бва®з­® ў б«Ґ¤го饩 д®а¬Ґ:}
begin {# <бв ­жЁп1> <бв ­жЁп2> <®вЇа ў«Ґ­ЁҐ> <ЇаЁЎлвЁҐ> <бв®Ё¬®бвм>}
t:=G.Vertices[i].Connections;
while t<>nil do
begin
p:=t^.TimeTable;
while p<>nil do
begin
write(f,'#',i:3,' ',t^.where:2,' ');
SaveTimeTableLine(f,p^.route);
p:=p^.next
end;
t:=t^.NextStation
end;
end;
close(f);
end;

{§ Јаг§Ёвм ¦/¤ бҐвм б а бЇЁб ­ЁҐ¬}
procedure LoadGraph(var f:text; var G:TGraph);
var i,l:byte;
t:PDestination;
p:PTimeTableElem;
s:ArrString;
c:char;
ttl:TimeTableString;
e:boolean;
r:TRoute;
begin
DeleteGraph(G); {г¤ «Ёвм бв аго ¦/¤ бҐвм}
i:=1;
repeat {§ Јаг§Ёвм Ё¬Ґ­  бв ­жЁ©}
LoadStr(f,s,l);
if l<>0 then
begin
G.Vertices[i].Name:=s;
inc(i);
inc(G.Number)
end;
readln(f);
until l=0;
for i:=1 to G.Number do {§ Јаг§Ёвм ᮥ¤Ё­Ґ­Ёп}
begin
read(f,c);
while not eoln(f) do
begin
read(f,l);
if l>i then SetConnection(G,i,l);
end;
readln(f);
end;
readln(f);
read(f,c);
while c='#' do {§ Јаг§Ёвм а бЇЁб ­ЁҐ}
begin
read(f,i,l);
read(f,c);
readln(f,ttl);
EncodeTimeTableLine(ttl,e,r);
AddTimeTableLine(G,i,l,r);
read(f,c);
end;
end;

{г¤ «Ёвм ¦/¤ бҐвм: г¤ «Ёвм а бЇЁб ­ЁҐ, ᮥ¤Ё­Ґ­Ёп бв ­жЁ© Ё Ёе ­ §ў ­Ёп}
procedure DeleteGraph(var G:TGraph);
var i,j:byte;
t:PDestination;
p:PTimeTableElem;
begin
for i:=1 to G.Number do {Їа®©вЁ Ї® ўбҐ¬ бв ­жЁп¬}
begin
for j:=1 to 15 do G.Vertices[i].Name[j]:=#0; {г¤ «Ёвм Ё¬Ґ­ }
t:=G.Vertices[i].Connections;
while t<>nil do {Їа®©вЁ Ї® ўбҐ¬ ᮥ¤Ё­Ґ­Ёп¬ нв®© бв ­жЁЁ}
begin
p:=t^.TimeTable;
while p<>nil do {г¤ «Ёвм а бЇЁб ­ЁҐ ўҐвўЁ}
begin
t^.TimeTable:=p^.Next;
dispose(p);
p:=t^.TimeTable
end;{while p}
G.Vertices[i].Connections:=t^.NextStation;
dispose(t);
t:=G.Vertices[i].Connections
end;{while t}
end;{for i}
G.Number:=0
end;

function GetTimeTable(const G:TGraph; Index1,Index2:byte):PTimeTableElem;
var t:PDestination;
begin
t:=G.Vertices[Index1].Connections;
while t^.where<>Index2 do t:=t^.nextStation;
GetTimeTable:=t^.TimeTable
end;

{Ї®«гзЁвм Ё­¤ҐЄб ўҐаиЁ­л, бв®п饩 ў бЇЁбЄҐ ᬥ¦­®бвЁ ­  § ¤ ­­®¬ ¬ҐбвҐ}
function GetIndex(const G:Tgraph; Index1,Order:byte):byte;
var t:PDestination;
i:byte;
begin
t:=G.Vertices[Index1].Connections;
i:=1;
while i<>Order do
begin
t:=t^.NextStation;
inc(i)
end;
GetIndex:=t^.where
end;

procedure RebuildLabels(var G:Tgraph; var dl:TVertexArray; from:byte; when:TTime);
var i:byte;
min,min1:LongInt;
p,minp,maxp:PTimeTableElem;
begin
for i:=1 to G.Number do {а ббв ўЁвм ­ з «м­лҐ §­ зҐ­Ёп а ббв®п­Ё©}
if dl[i].Attr then
begin
{dl[i].VTime:=nil;}
if Connected(G,From,i) then {Ґб«Ё ўҐаиЁ­  ᮥ¤Ё­Ґ­  б® бв ав®ў®©}
begin {в® ®ЇаҐ¤Ґ«Ёвм ў в Ў«ЁжҐ а бЇЁб ­Ёп Ў«Ё¦ ©йЁ© Ї®Ґ§¤}
p:=GetTimeTable(G,From,i);
min:=High(LongInt);
min1:=High(LongInt);
while p<>nil do
begin
if p^.Route.DepTime>=when then {Ґб«Ё Ґбвм Ї®Ґ§¤  ў нв®в ¤Ґ­м}
begin
if (p^.Route.ArrTime-when)<min
then begin min:=p^.Route.ArrTime-when; minp:=p end;
end
else begin {Ґб«Ё Ґбвм в®«мЄ® ­  б«Ґ¤гойЁ©}
if (1440-when+p^.Route.ArrTime)<min1
then begin min1:=1440-when+p^.Route.ArrTime; maxp:=p end;
end;
p:=p^.Next;
end; {while}
if (Min<>High(LongInt)) and (Min1<>High(LongInt)) then
begin
if Min=High(LongInt) then
begin
dl[i].VLabel:=dl[from].VLabel+min1;
dl[i].VTime:=maxp
end
else begin
dl[i].VLabel:=dl[from].VLabel+min;
dl[i].VTime:=minp
end;
end;
end;
end; {for i}
end;

procedure RebuildLabels2(var G:Tgraph; var dl:TVertexArray; from:byte; when:TTime);
var i:byte;
min:LongInt;
p,minp:PTimeTableElem;
begin
for i:=1 to G.Number do {а ббв ўЁвм ­ з «м­лҐ §­ зҐ­Ёп а ббв®п­Ё©}
if dl[i].Attr then
begin
if Connected(G,From,i) then {Ґб«Ё ўҐаиЁ­  ᮥ¤Ё­Ґ­  б® бв ав®ў®©}
begin {в® ®ЇаҐ¤Ґ«Ёвм ў в Ў«ЁжҐ а бЇЁб ­Ёп Ў«Ё¦ ©йЁ© Ї®Ґ§¤}
p:=GetTimeTable(G,From,i);
min:=High(LongInt);
while p<>nil do
begin
if p^.Route.Price<min then
begin
min:=p^.Route.Price;
minp:=p
end;
p:=p^.Next;
end; {while}
dl[i].VLabel:=dl[i].VLabel+min;
dl[i].VTime:=minp
end;
end; {for i}
end;

{Ї®ЁбЄ б ¬®Ј® Ўлбва®Ј® ЇгвЁ}
procedure FastestWay(var G:TGraph; vFrom, vTo:byte; DT:TTime; var res:TWay; cheap:boolean; var err:boolean);
var i:byte;
dl,dl1:TVertexArray; {¬ ббЁў Єа вз ©иЁе а ббв®п­Ё© ®в бв ав®ў®© ¤® ®бв «м­ле}
t:byte; {бзҐвзЁЄ ­Ґ®Ўа Ў®в ­­ле ўҐаиЁ­}
cur,tcur:byte; {­®¬Ґа ⥪г饩 ўҐаиЁ­л}
min:LongInt; {¤«п ®ЇаҐ¤Ґ«Ґ­Ёп ¬Ё­Ё¬г¬®ў}
label quit;
begin
err:=false;
for i:=1 to G.Number do
begin
dl[i].Attr:=true;
dl[i].VLabel:=0;
dl[i].VTime:=nil
end;
if Cheap then RebuildLabels2(G,dl,vFrom,DT) else RebuildLabels(G,dl,vFrom,DT);
dl1:=dl;
dl[vFrom].VLabel:=0;
dl[vFrom].Attr:=false; {used attribute}
t:=G.Number-1;
cur:=vFrom;
res[G.Number-t].Station:=vFrom;
while t<>0 do {Ї®Є  Ґбвм ­Ґ®Ўа Ў®в ­­лҐ ўҐаиЁ­л}
begin
min:=High(LongInt);
tcur:=0;
for i:=1 to G.Number do {®ЇаҐ¤Ґ«Ёвм Ў«Ё¦ ©иго Є ⥪г饩 ўҐаиЁ­г}
if dl[i].Attr then if Connected(G,cur,i) then
if (dl[i].VLabel<min) and (dl[i].VLabel<>0) then
begin
min:=dl[i].VLabel;
tcur:=i
end;
if tcur=0 then begin err:=true; goto quit end;
cur:=tcur;
dl[cur].Attr:=false; {Ё ¤®Ў ўЁвм ҐҐ Є Їа®б¬®в७­л¬}
dl[cur].VLabel:=min;
res[G.Number-t].Time:=dl[cur].VTime;
dec(t);
res[G.Number-t].Station:=cur;
{ЇҐаҐбзЁв вм а ббв®п­Ёп ¤® ўҐаиЁ­}
if Cheap then RebuildLabels2(G,dl,cur,dl[cur].VTime^.Route.ArrTime)
else RebuildLabels(G,dl,cur,dl[cur].VTime^.Route.ArrTime);
for i:=1 to G.Number do if dl[i].Attr then
begin
if Connected(G,cur,i) then
if (dl1[i].VLabel<dl[i].VLabel) and (dl1[i].VLabel<>0)
then dl[i].VLabel:=dl1[i].VLabel;
end;
dl1:=dl;
end; {while t}
quit:
end; {proc}

end.