Структуры данных и алгоритмы
Обновлено
- 1.
uses Crt, Date, Graph;
Const MaxCity=100; MClass=6;
Type
CityCode=1..maxcity; {Внутрений код города}
Week=0..10079; {Тип время в минутак с 0:00 понедельника}
DayTable=^IDayTable; {Таблица отправлений от начальной станции}
IDayTable=record
Time:Week;
Next:DayTable;
end;
WayKind=1..4; {Тип пути (аэро, море, ж.д, авто)}
WayClass=1..MClass; {Класс или тип перевозки}
Cities=array[CityCode] of {Названия и координаты городов}
record
name:string[20];
x,y:word;
end;
mcost=array[wayclass] of longint; {Таблица стоимости по классам}
Way=record
City:Citycode;
Delay,Reboard:Word;
Cost:mcost;
end;
WayP=^way;
PWay=^Way1; {Информация о городах следования рейса}
Way1=record
Way:array [1..4] of way;
next:PWay;
end;
wclass=array [WayClass] of boolean;
PFlight=^Flight;
Flight=record {Информация о рейсе}
company:string[20];
number:string[10];
totalstation:CityCode;
table:DayTable;
path:PWay;
kind:WayKind;
class:WClass;
next:PFlight;
end;
Blank=record {Шаблон для поиска пути}
delay:Week;
BCity,ECity:CityCode;
Kind:array [WayKind] of boolean;
ReBoading:CityCode;
WayTime:Integer;
Cost:Longint;
Class:WClass;
end;
Link=^CityList; {Цепочка рейсов для проезда от начала до конца}
CityList=record {Информация о проезде между двумя пунктами одним рейсом}
DDelay:Word;
waytime:word;
cost:mcost;
Bcity,Target:CityCode;
Flight:PFlight;
Last:Link;
end;
AnswerList=^IAnswer; {Список всех возможных маршрутов следования}
IAnswer=record
path:link;
reboard:citycode;
mincost,maxcost:longint;
waytime:word;
next:AnswerList;
end;
var Lanswer:AnswerList; {глобальная переменная - начало списка маршрутов }
{Добавления нового найденного маршрута}
Procedure Answer(A:Link;cost:longint);
var P,Q:Link; d,s1,s2:word; W,PAnswer:answerlist; r:citycode;
function min(a:mcost):longint; {Минимальная стоимость по классам}
var i:integer; m:longint;
begin
m:=1000000000;
for i:=1 to Mclass do if (m>a[i]) and (a[i]>0) then m:=a[i];
min:=m
end;
function max(a:mcost):longint; {Максимальная стоимость по классам}
var i:integer; m:longint;
begin
m:=a[1];
for i:=2 to Mclass do if m<a[i] then m:=a[i];
max:=m
end;
begin
new(PAnswer);
Panswer^.path:=nil;
P:=A;
s1:=0; s2:=0; {верхняя и нижняя границы цены}
r:=1; {количество пересадок}
d:=0; {время пути}
Repeat
s1:=s1+min(P^.cost); {Подсчет суммы параметров по рейсам в маршруте}
s2:=s2+max(P^.cost);
d:=d+P^.ddelay+P^.waytime;
P:=P^.last; {Переход к следующему рейсу в маршруте}
inc(r);
Until P=nil;
if s1<=cost then begin {Если соответствует цена}
P:=A;
Repeat
new(Q); {Сборка цепочки рейсов маршрута}
Q^:=P^;
Q^.last:=Panswer^.path;
Panswer^.path:=Q;
P:=P^.last; {Переход к следующему рейсу в маршруте}
Until p=nil;
Panswer^.mincost:=s1; Panswer^.maxcost:=s2; {Сохранение сумарных цен и времени}
Panswer^.waytime:=d; Panswer^.reboard:=r; {и числа пересадок в элементе маршрута}
W:=LAnswer;
While (W^.next<>nil) and ((W^.next)^.waytime<d) do W:=W^.next; {Поиск места в соответствии времени пути}
While (W^.next<>nil) and ((W^.next)^.reboard<r) and ((W^.next)^.waytime=d) do W:=W^.next; {Поиск места по кол-ву пересадок}
Panswer^.next:=W^.next; {Добавление маршрута в найденное место}
W^.next:=Panswer;
end
end;
{Возвращает ссылку на информацию об I-ой станции следования}
Function CityInPath(A:Pway; I:citycode):WayP;
var P:Pway;
Begin
P:=A;
While I>4 do begin I:=I-4; P:=P^.next end; {Поиск четверки в которой данная станция}
CityInPath:=@P^.Way[I]; {Результат}
end;
const ReBoadingDelay=120; {Минимальное время пересадки}
{Возвращает время до следещего после указанного времени time отоправление от станции}
{номер N рейса A}
Function DepartureDelay(A:PFlight; N:CityCode; time:week ):word;
var S:word; I:1..4; P:PWay; Q:DayTable;
begin
P:=A^.path;
S:=0;
While N>4 do begin
N:=N-4;
For I:=1 to 4 do S:=S+P^.Way[I].delay+P^.Way[I].reboard; {подсчет времени пути по полным четверкам}
P:=P^.next;
end;
For I:=1 to N do S:=S+P^.Way[I].delay+P^.Way[I].reboard; {Подсчет по неполной четверке}
time:=(10080+time-(S mod 10080)) mod 10080; {Время отправления этого рейса от начальной станции}
Q:=A^.Table;
while (Q<>nil) and (Q^.time<time+ReboadingDelay) do Q:=Q^.next; {Поиск ближайшего времени на текущей неделе}
If Q<>nil then Departuredelay:=Q^.time-time else {Если на текущей неделе не найден}
DepartureDelay:=10080-time+(A^.Table)^.time; {Поиск ближайщего времени на следующей неделе}
end;
{Поиск всех возможных маршрутов, удовлетворяющих Pattern}
Procedure Search (FlightList:Pflight; const Pattern:Blank; Path:Link);
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.
Выбор и обоснование набора тестовВ качестве транспортной системы бала взята система, состоящая из 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 - 250Tropic 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 - 195Tropic 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 - 1052. Тест с «урезанием бюджета»Начальный город ... 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 - 195Tropic 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 - 1053. Уменьшение числа пересадок Начальный город ... 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 - 1054. Нереальные условияНачальный город ... Tropic PortКонечный город ... BeatifulДата отправление:Дата ... 8.5.2008 ПтВремя ... 0:0Максимальное время пути (сутки):3Максимальная стоимость ... 200Максимальное число пересадок ... 1Тип перевозки (авиа,ж.д.,авто,водн.) ...Допустимые классы 123456 ...При данных условиях добраться нельзяАнализ результатовВремя пути зависит от дня оправления.По причине ожидания рейса можно с меньшим числом пересадок добраться позже, чем с большимДороже - не значит быстрееДля нормальной транспортной системы нужно как можно больше больших транспортных узловПриложение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.