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

.PAS
Скачиваний:
Добавлен:
01.05.2014
Размер:
13 Кб
Скачать
☆
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.
Соседние файлы в папке Информационная система железнодорожной сети
#
01.05.201413 Кб7GRAFUTIL.PAS
#
01.05.201424 Кб7INPUT.PAS
#
01.05.2014509 б9ReadMe!.txt
#
01.05.20143 Кб7RWROUTER.PAS
#
01.05.2014120 Кб11Specification.doc
#
01.05.2014701 б9Task.txt