Курсовая работа: Структуры данных и алгоритмы
Var P:Pflight; I,J:CityCode; D,DDelay:Word; K:WayClass; B1,B2:Boolean;
NPattern:Blank; NPath:Link; c:Longint;
{Проверка допустимости маршрута (проверка дублирования города)}
Function Posible (P:Link; L:CityCode):Boolean;
Var b:boolean; i:citycode; Q:pway;
Begin
b:=true;
While (P<>nil) and b do begin {Просмотр всех предидущих пересадок}
Q:=P^.flight^.path;
i:=1;
while Q^.way[i].city<>P^.bcity do begin {Поиск города отправления}
i:=(i mod 4)+1; if i=1 then Q:=Q^.next;
end;
repeat
b:=Q^.way[i].city<>L; {Проверка города на дублирование}
i:=(i mod 4)+1; if i=1 then Q:=Q^.next
until (Q^.way[i].city=P^.target) or not b; {переход к следующему пока не город назначения}
p:=p^.last
end;
Posible:=b;
End;
begin
New(NPath);
NPath^.last:=Path;
P:=FlightList;
While P<>nil do begin {Просмотр всех рейсов}
if ((Path=nil) or (P<>Path^.Flight)) and Pattern.Kind[P^.Kind] then {не повторяется рейс и сответствует тип перевозки}
begin
I:=1; {Поиск среди городов следования начальный пункт}
While (I<P^.TotalStation-1) and (CityInPath(P^.path, I)^.city<>Pattern.BCity) do inc (I);
If CityInPath(P^.path, I)^.city=Pattern.BCity then begin {Если начальный найден}
NPattern:=Pattern; {Подготовка нового шаблона и новой пересадки}
if Npattern.reboading>1 then dec(Npattern.reboading);
Npath^.flight:=P;
For K:=1 to Mclass do Npath^.cost[k]:=0;
Npath^.bcity:=pattern.bcity;
Npath^.Ddelay:=DepartureDelay(P,I,Pattern.delay);
Npath^.waytime:=0;
J:=I;
Repeat {просмотр следующих городов}
Inc(J);
{Внесение исправлений в шаблон и элемент маршрута о цене и времени}
For K:=1 to MClass do If Pattern.Class[K] and P^.class[K] then
Npath^.cost[k]:=Npath^.cost[k]+CityInPath(P^.path,J)^.Cost[K];
Npath^.waytime:=Npath^.waytime+CityInPath(P^.path,J)^.delay;
Npath^.target:=CityInPath(P^.path,J)^.City;
NPattern.Bcity:=CityInPath(P^.path,J)^.City;
Npattern.WayTime:=Pattern.WayTime-Npath^.ddelay-Npath^.waytime;
Npattern.Delay:=(pattern.Delay+Npath^.Ddelay+Npath^.wayTime) mod 10080;
B1:=Posible(Path,CityInPath(P^.path,J)^.City) and (NPattern.WayTime>=0);
{Проверка: не превышены лимиты времени и стоимости и нет повтора пути}
B2:=CityInPath(P^.path,J)^.city=Pattern.ECity; {приехали?}
{Если не приехали и лимиты не превышены то делаем рассмотроим маршруты от текущего до конечного городов}
if B1 and (not B2) and (Pattern.reboading>1) then Search(FlightList,Npattern,Npath);
Npath^.waytime:=Npath^.waytime+CityInPath(P^.path,J)^.reboard;
Until (not B1) or B2 or (J>=P^.totalStation); {Выходим, если есть нарушения или рейс закончился или прехали}
If B2 and B1 then Answer(Npath,pattern.cost); {Если приехали, добавить маршрут в список}
end {найден начальный город}
end; {маршрут подходит по типу}
P:=P^.next; {переход к следущему циклу}
end;
Dispose(NPath)
end;
{Загрузка исходных данных из файла}
Function Load (A:PFlight; FName:String;var City:cities):PFlight;
Var
Source:Text; P:Pflight; I:WayClass; J,MC:CityCode; K:byte;
C:char; Q:Pway; G,L:DayTable; D:string[8];
Begin
Assign(Source,FName);
Reset(Source);
readln(Source,MC); {Количество городов}
{Считывание название городов и координат на карте }
For J:=1 to MC do begin ReadLn(source,City[j].name); readln(source,city[j].x,city[j].y) end;
While Not EOF(Source) do begin
New(P);
P^.Next:=A;
A:=P;
{Общая информация о рейсе}
ReadLn(Source, P^.company);
ReadLn(Source, P^.number);
ReadLn(Source, P^.kind);
{Стоимость каждого из классов}
For I:=1 to MClass do begin Read(Source,C); P^.class[i]:=C='X' end;
ReadLn(Source, P^.TotalStation);
New(P^.path);
Q:=P^.path;
{информация о городах следования времени пути, стоянках}
For J:=1 to P^.TotalSTation do begin
K:=((J-1) mod 4)+1;
Read(Source,Q^.Way[K].City,Q^.Way[K].Delay,Q^.Way[K].Reboard);
For I:=1 to MClass do If P^.class[I] then Read(Source,Q^.Way[K].cost[I])
else Q^.Way[K].cost[I]:=0;
If (J mod 4)=0 then begin
If (J<>P^.TotalStation) then begin New(Q^.Next); Q:=Q^.next end
else Q^.next:=nil;
end;
ReadLn(Source);
end;
New(P^.Table);
G:=P^.Table;
L:=G;
{Информация о отправлении из начального пункта}
While Not EOLn(Source) do begin
Read(Source,D);
G^.Time:=(ord(D[1])-ord('0')-1)*1440+((ord(D[3])-ord('0'))*10+ord(D[4])-ord('0'))*60
+(ord(D[6])-ord('0'))*10+ord(D[7])-ord('0');
if L^.time>G^.time then write('Wrong data');
If not EOLn(Source) then begin New(G^.next); G:=G^.next end else G^.next:=nil;
end;
ReadLn(Source);
end;
Load:=A;
end;
const line='--------------------------------------------------------------------------------';
procedure graphout(const city:cities);
var
grDriver: Integer;
grMode: Integer;
p:citycode;
begin
grDriver := Detect;
InitGraph(grDriver, grMode,'');
setcolor(12);
outtextxy(200,0,'Карта транспортной схемы');
p:=1;
while (p<maxcity) and (city[p].name<>'') do begin
setcolor(5);
fillellipse(4*city[p].x,380-3*city[p].y,2,2);
setcolor(11);
outtextxy(4*city[p].x+5,376-3*city[p].y,city[p].name);
inc(p)
end;
end;
var List:PFLight; pattern:blank; st:string; p:answerlist;
city:cities; a:dat;
Procedure Input(var Pattern:blank; var a:dat);
var i:citycode; st:string; b:dat; w:real;
begin
with pattern do begin
GotoXY(30,1);
WriteLn('Ввод исходных данных');
write(line);
repeat
write('Начальный город ... ');
readln(st);
Bcity:=1; while (BCity<Maxcity) and (City[BCity].name<>st) do inc(BCity);
until BCity<>MaxCity;
repeat
write('Конечный город ... ');
readln(st);
Ecity:=1; while (ECity<Maxcity) and (City[ECity].name<>st) do inc(ECity);
until Ecity<>MaxCity;
repeat
gotoxy(1,5);
WriteLn('Дата отправление:');
DTInput(a);
delay:=a.Dweek*1440+a.time;
Write('Максимальное время пути (сутки):');
readln(w);
waytime:=round(1440*w);
until waytime>0;
write('Максимальная стоимость ... ');
ReadLn(cost);
write('Максимальное число пересадок ... ');
readln(reboading);
write('Тип перевозки (авиа,ж.д.,авто,водн.) ... ');
readln(st);
if st='' then for i:=1 to 4 do kind[i]:=true else
for i:=1 to 4 do kind[i]:=(st[i]='Y') or (st[i]='y') or (st[i]='X') or (st[i]='x');
write('Допустимые классы 123456 ... ');
readln(st);
if st='' then for i:=1 to 4 do class[i]:=true else
for i:=1 to 4 do class[i]:=(st[i]='Y') or (st[i]='y') or (st[i]='X') or (st[i]='x');
end;
end;
procedure outres(p:Answerlist; a:dat);
var k:word; q:link; b:dat; i:citycode; y:pway; c:byte;
begin
k:=0;
while P<>nil do begin
inc(k);
{ write(p^.path^.bcity);}
Q:=P^.path;
b:=a;
while Q<>nil do begin
write(city[q^.bcity].name);
Writeln(' <',q^.flight^.company,q^.Flight^.Number,'> ',city[Q^.Target].name);
newdat(b,Q^.ddelay,b);
write('Отправление: '); writedat(b);
newdat(b,Q^.waytime,b);
write(' Прибытие: '); writedat(b); writeln;
Q:=Q^.last;
end;
newdat(a,p^.waytime,b);
writeln (' цена: ',P^.mincost,' - ',p^.maxcost);
readln(st);
if st='p' then begin
graphout(city);
q:=p^.path;
c:=2;
while q<>nil do begin
i:=1;
y:=q^.flight^.path;
while y^.way[i].city<>q^.bcity do begin
i:=(i mod 4)+1; if i=1 then y:=y^.next;
end;
setcolor(c);
moveto(4*city[q^.bcity].x,380-3*city[q^.bcity].y);
repeat
i:=(i mod 4)+1; if i=1 then y:=y^.next;
lineto(4*city[y^.way[i].city].x,380-3*city[y^.way[i].city].y);
until (y^.way[i].city=q^.target);
Q:=Q^.last; inc(c);
end; repeat until keypressed; CloseGraph;
end;
P:=P^.next;
end;
if k=0 then write('При данных условиях добраться нельзя') else writeln('Всего ',k,' маршшрутов');
end;
Begin
List:=Load(nil,'trafic',city);
graphout(city);
repeat until keypressed;
closegraph;
Input(pattern,a);
new(lanswer);
lanswer^.next:=nil;
Search(List,pattern,nil);
outres(Lanswer^.next,a);
end.
6. Выбор и обоснование набора тестов
В качестве транспортной системы бала взята система, состоящая из 23 городов, соединенных 19 прямыми и таким же числом обратных рейсами. Название городов и перевозчиков вымышленные. Рейсы были разработаны так, что имеется несколько крупных транспортных развязок: Palace of Dream, Diamond World, Golden River, Seaside City; и несколько «удаленных» городов: Far Star City, Oil City, North Star City.
Разные рейсы отправляются от 3 до 18 раз в неделю.
1. Общий тест
Начальный город ... Tropic Port
Конечный город ... Beatiful
Дата отправление:
Дата ... 8.5.2008 Пт
Время ... 0:0
Максимальное время пути (сутки):3
Максимальная стоимость ... 200
Максимальное число пересадок ... 3
Тип перевозки (авиа,ж.д.,авто,водн.) ...
Допустимые классы 123456 ...
Tropic Port <GoldenAirBridge004> Palace Of The Dream
Отправление: 14:29 8.5.2008 Пт Прибытие: 19:14 8.5.2008 Пт
Palace Of The Dream <GoldenAirBridge009> Diamond World
Отправление: 2:15 9.5.2008 Пт Прибытие: 5:15 9.5.2008 Пт
Diamond World <DiamondAirlines003> Beatiful
Отправление: 17:20 9.5.2008 Пт Прибытие: 19:20 9.5.2008 Пт
цена: 195 – 250
Tropic Port <GoldenAirBridge004> Lakes Land
Отправление: 14:29 8.5.2008 Пт Прибытие: 16:29 8.5.2008 Пт
Lakes Land <DiamondAirlines006> Diamond World
Отправление: 0:25 9.5.2008 Пт Прибытие: 3:25 9.5.2008 Пт
Diamond World <DiamondAirlines003> Beatiful
Отправление: 17:20 9.5.2008 Пт Прибытие: 19:20 9.5.2008 Пт
цена: 165 - 195
Tropic Port <DeepWater02> Oil City
Отправление: 12:0 8.5.2008 Пт Прибытие: 4:40 9.5.2008 Пт
Oil City <TransExpress002> Beatiful
Отправление: 12:0 9.5.2008 Пт Прибытие: 16:10 10.5.2008 Пт
цена: 75 – 105
2. Тест с «урезанием бюджета»
Начальный город ... Tropic Port
Конечный город ... Beatiful
Дата отправление:
Дата ... 8.5.2008 Пт
Время ... 0:0
Максимальное время пути (сутки):3
Максимальная стоимость ... 180
Максимальное число пересадок ... 3
Тип перевозки (авиа,ж.д.,авто,водн.) ...
Допустимые классы 123456 ...
Tropic Port <GoldenAirBridge004> Lakes Land
Отправление: 14:29 8.5.2008 Пт Прибытие: 16:29 8.5.2008 Пт
Lakes Land <DiamondAirlines006> Diamond World
Отправление: 0:25 9.5.2008 Пт Прибытие: 3:25 9.5.2008 Пт
Diamond World <DiamondAirlines003> Beatiful
Отправление: 17:20 9.5.2008 Пт Прибытие: 19:20 9.5.2008 Пт
цена: 165 - 195
Tropic Port <DeepWater02> Oil City
Отправление: 12:0 8.5.2008 Пт Прибытие: 4:40 9.5.2008 Пт
Oil City <TransExpress002> Beatiful
Отправление: 12:0 9.5.2008 Пт Прибытие: 16:10 10.5.2008 Пт
цена: 75 – 105
3. Уменьшение числа пересадок
Начальный город ... Tropic Port
Конечный город ... Beatiful
Дата отправление:
Дата ... 8.5.2008 Пт
Время ... 0:0
Максимальное время пути (сутки):3
Максимальная стоимость ... 200
Максимальное число пересадок ... 2
Тип перевозки (авиа,ж.д.,авто,водн.) ...
Допустимые классы 123456 ...
Tropic Port <DeepWater02> Oil City
Отправление: 12:0 8.5.2008 Пт Прибытие: 4:40 9.5.2008 Пт
Oil City <TransExpress002> Beatiful
Отправление: 12:0 9.5.2008 Пт Прибытие: 16:10 10.5.2008 Пт
цена: 75 – 105
4. Нереальные условия
Начальный город ... Tropic Port
Конечный город ... Beatiful
Дата отправление:
Дата ... 8.5.2008 Пт
Время ... 0:0
Максимальное время пути (сутки):3
Максимальная стоимость ... 200
Максимальное число пересадок ... 1
Тип перевозки (авиа,ж.д.,авто,водн.) ...
Допустимые классы 123456 ...
При данных условиях добраться нельзя
7. Анализ результатов
1. Время пути зависит от дня оправления.
2. По причине ожидания рейса можно с меньшим числом пересадок добраться позже, чем с большим
3. Дороже – не значит быстрее
4. Для нормальной транспортной системы нужно как можно больше больших транспортных узлов
Приложение
Unit Date;
interface
Var DTErr:boolean;
Type Dat=record
day:1..31;
month:1..12;
year:integer;
dweek:0..6;
time:word;
end;
Const EWeek:array[0..6] of string[2]=('Mo','Tu','We','Th','Fr','Sa','Sa');
Const RWeek:array[0..6] of string[2]=('Џ','‚в','‘а','—в','Џв','‘Ў','‚б');
procedure newdat(a:dat; delay:word; var b:dat);
procedure writedat(b:dat);
Function DayDiffer(A,B:dat):Integer;
Function STime(st:string):word;
Function dweek (a:dat):byte;
Procedure DTInput(var d:dat);
Procedure SDate(St:string; var a:dat);
Implementation
uses dos,crt;
Function DayInMonth(m:byte; y:integer):byte;forward;
procedure SDate(St:string; var a:dat);
const mthe:array[1..12] of string[3] =('JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC');
const mthru:array[1..12] of string[3] =('џЌ‚','”…‚','ЊЂђ','ЂЏђ','ЊЂ‰','ˆћЌ','ˆћ‹','Ђ‚ѓ','‘…Ќ','ЋЉ’','ЌЋџ','„…Љ');
const mthrl:array[1..12] of string[3] =('пў','䥢','¬ а',' Їа','¬ ©','Ёо','Ёо«',' ўЈ','бҐ','®Єв','®п','¤ҐЄ');
var i,j,e:byte; mode:byte; S:word; err:boolean; D,M,Y,wd:word; c:shortint;
Procedure add(mode:byte;s:word;var a:dat);
begin
case mode of
1:if (s>0) and (s<=31) then A.day:=S else DTErr:=true;
3:if (s>0) and (s<=12) then A.month:=S else DTErr:=true;
5:if s>=100 then A.year:=S else A.year:=S+100*(Y div 100);
end;
end;
begin
DTErr:=false;
GetDate(Y,M,D,wd);
e:=length(st);
i:=1; mode:=0;
while (i<=e) do begin
c:=ord(st[i])-ord('0');
if ((mode mod 2)=0) and (c>=0) and (c<=9) then begin S:=c; inc(mode) end
else if (c<=9) and (c>=0) then S:=S*10+c
else if (mode mod 2)=1 then begin Add(mode,S,a); Inc(mode) end;
if (mode=2) then
for j:=1 to 12 do
if (mthe[j,1]=upcase(st[i])) and (mthe[j,2]=upcase(st[i+1])) and (mthe[j,3]=upcase(st[i+2])) or
((mthru[j,1]=st[i]) or (mthrl[j,1]=st[i])) and ((mthru[j,2]=st[i+1]) or (mthrl[j,2]=st[i+1])) and
((mthru[j,3]=st[i+2]) or (mthrl[j,3]=st[i+2])) then
begin add(3,j,a); mode:=4 end;
inc(i);
end;
if (mode mod 2)=1 then add(mode,S,a);
if mode<1 then add(1,D,a);
if mode<3 then add(3,M,a);
if mode<5 then add(5,Y,a);
if not DTErr then DTErr:=a.day>DayInMonth(a.month,a.year);
if not DTErr then a.dweek:=dweek(a);
end;
function dweek (a:dat):byte;
var n,m,y:word;
begin
DTErr:=false;
y:=a.year;
if a.month<=2 then begin m:=a.month+12; dec(y) end else m:=a.month;
n:=(A.day+2*m+trunc(0.6*(m+1))+y+(y div 4)-(y div 100)+(y div 400)) mod 7;
dweek:=n;
end;
Function STime (st:string):Word;
var i,e,mode:byte; a,s:word; c:shortint;
begin
DTErr:=false;
e:=length(st);
i:=1; mode:=0; a:=0;
while (i<=e) do begin
c:=ord(st[i])-ord('0');
if ((mode mod 2)=0) and (c>=0) and (c<=9) then begin S:=c; inc(mode) end
else if (c<=9) and (c>=0) then S:=S*10+c
else if mode=1 then begin A:=S; inc(mode) end
else if mode=3 then begin A:=A*60+S; inc(mode) end;
inc(i)
end;
if mode=3 then A:=a*60+s;
if a<1440 then Stime:=a else DTErr:=true;
end;
Function DayInMonth(m:byte; y:integer):byte;
const DayInM:array[1..12] of byte=(31,29,31,30,31,30,31,31,30,31,30,31);
begin
If M<>2 then DayInMonth:=DayInM[M]
else if (y mod 4)<>0 then DayInMonth:=28
else if (y mod 100)<>0 then DayInMonth:=29
else if (y mod 400)<>0 then DayInMonth:=28 else DayInMonth:=29
end;
Function DayDiffer(A,B:dat):Integer;
Var m1,m2,y1,y2:Integer;
Begin
DTErr:=false;
y1:=A.year;
y2:=B.year;
if a.month<=2 then begin m1:=a.month+12; dec(y1) end else m1:=a.month;
if b.month<=2 then begin m2:=b.month+12; dec(y2) end else m2:=b.month;
DayDiffer:=-(A.day+30*m1+trunc(0.6*(m1+1))+365*y1+(y1 div 4)-(y1 div 100)+(y1 div 400))+
(B.day+30*m2+trunc(0.6*(m2+1))+365*y2+(y2 div 4)-(y2 div 100)+(y2 div 400));
End;
Procedure DTInput(var d:dat);
var st:string; y:byte;
const empty=' ';
begin
y:=wherey;
repeat
GotoXY(1,y);
Write('„ в ... ',empty);
GotoXY(10,y);
ReadLn(St);
SDate(st,d);
Until not DTErr;
GotoXY(10,y);
writeln(d.day,'.',d.month,'.',d.year,' ',Rweek[Dweek(d)]);
repeat
gotoxy(1,y+1);
write('‚६п ... ',empty);
gotoxy(11,y+1);
readln(st);
d.time:=stime(st);
until not DTErr;
gotoxy(11,y+1);
writeln(stime(st) div 60,':',stime(st) mod 60);
end;
procedure writedat(b:dat);
begin
write(b.time div 60,':',b.time mod 60,' ',b.day,'.',b.month,'.',b.year,' ',Rweek[b.dweek]);
end;
procedure newdat(a:dat; delay:word; var b:dat);
var c:word;
begin
B:=A;
B.time:=(a.time+(delay mod 1440)) mod 1440;
delay:=(delay div 1440)+((a.time+(delay mod 1440)) div 1440);
while delay+b.day>DayInMonth(b.month,b.year) do begin
delay:=delay-1-DayInMonth(b.month,b.year)+b.day;
b.day:=1;
b.month:=(b.month mod 12)+1;
if b.month=1 then inc(b.year);
end;
b.day:=delay+b.day;
end;
begin
end.
[1] Текущий город – есть пункт назначения.
