Текст программы на языке Pascal

Текст программы на языке Pascal. uses Crt, Date, Graph Const MaxCity100 MClass6 Type CityCode1 maxcity Внутрений код города Week0 10079 Тип время в минутак с 000 понедельника DayTableIDayTable Таблица отправлений от начальной станции IDayTablerecord TimeWeek NextDayTable end WayKind1 4 Тип пути аэро, море, ж.д, авто WayClass1 MClass Класс или тип перевозки CitiesarrayCityCode of Названия и координаты городов record namestring20 x, yword end mcostarraywayclass of longint Таблица стоимости по классам Wayrecord CityCitycode Delay,ReboardWord Costmcost end WayPway PWayWay1 Информация о городах следования рейса Way1record Wayarray 1 4 of way nextPWay end wclassarray WayClass of boolean PFlightFlight Flightrecord Информация о рейсе companystring20 numberstring10 totalstationCityCode tableDayTable pathPWay kindWayKind classWClass nextPFlight end Blankrecord Шаблон для поиска пути delayWeek BCity,ECityCityCode Kindarray WayKind of boolean ReBoadingCityCode WayTimeInteger CostLongint ClassWClass end LinkCityList Цепочка рейсов для проезда от начала до конца CityListrecord Информация о проезде между двумя пунктами одним рейсом DDelayWord waytimeword costmcost Bcity,TargetCityCode FlightPFlight LastLink end AnswerListIAnswer Список всех возможных маршрутов следования IAnswerrecord pathlink reboardcitycode mincost, maxcostlongint waytimeword nextAnswerList end var LanswerAnswerList глобальная переменная - начало списка маршрутов Добавления нового найденного маршрута Procedure AnswerALinkcostlongint var P,QLink d, s1,s2word W,PAnsweranswerlist rcitycode function minamcostlongint Минимальная стоимость по классам var iinteger mlongint begin m10 for i1 to Mclass do if m ai and ai 0 then mai minm end function maxamcostlongint Максимальная стоимость по классам var iinteger mlongint begin ma1 for i2 to Mclass do if m ai then mai maxm end begin newPAnswer Panswer.pathnil PA s10 s20 верхняя и нижняя границы цены r1 количество пересадок d0 время пути Repeat s1s1minP.cost Подсчет суммы параметров по рейсам в маршруте s2s2maxP.cost ddP.ddelayP.waytime PP.last Переход к следующему рейсу в маршруте incr Until Pnil if s1 cost then begin Если соответствует цена PA Repeat newQ Сборка цепочки рейсов маршрута QP Q.lastPanswer.path Panswer.pathQ PP.last Переход к следующему рейсу в маршруте Until pnil Panswer.mincosts1 Panswer.maxcosts2 Сохранение сумарных цен и времени Panswer.waytimed Panswer.reboardr и числа пересадок в элементе маршрута WLAnswer While W.next nil and W.next.waytime d do WW.next Поиск места в соответствии времени пути While W.next nil and W.next.reboard r and W.next.waytimed do WW.next Поиск места по кол-ву пересадок Panswer.nextW.next Добавление маршрута в найденное место W.nextPanswer end end Возвращает ссылку на информацию об I-ой станции следования Function CityInPathAPway IcitycodeWayP var PPway Begin PA While I 4 do begin II-4 PP.next end Поиск четверки в которой данная станция CityInPathP.WayI Результат end const ReBoadingDelay120 Минимальное время пересадки Возвращает время до следещего после указанного времени time отоправление от станции номер N рейса A Function DepartureDelayAPFlight NCityCode timeweek word var Sword I1 4 PPWay QDayTable begin PA.path S0 While N 4 do begin NN-4 For I1 to 4 do SSP.WayI.delayP.WayI.reboard подсчет времени пути по полным четверкам PP.next end For I1 to N do SSP.WayI.delayP.WayI.reboard Подсчет по неполной четверке time10080time-S mod 10080 mod 10080 Время отправления этого рейса от начальной станции QA.Table while Q nil and Q.time timeReboadingDelay do QQ.next Поиск ближайшего времени на текущей неделе If Q nil then DeparturedelayQ.time-time else Если на текущей неделе не найден DepartureDelay10080-timeA.Table.time Поиск ближайщего времени на следующей неделе end Поиск всех возможных маршрутов, удовлетворяющих Pattern Procedure Search FlightListPflight const PatternBlank PathLink Var PPflight I,JCityCode D,DDelayWord KWayClass B1,B2Boolean NPatternBlank NPathLink cLongint Проверка допустимости маршрута проверка дублирования города Function Posible PLink LCityCodeBoolean Var bboolean icitycode Qpway Begin btrue While P nil and b do begin Просмотр всех предидущих пересадок QP.flight.path i1 while Q.wayi.city P.bcity do begin Поиск города отправления ii mod 41 if i1 then QQ.next end repeat bQ.wayi.city L Проверка города на дублирование ii mod 41 if i1 then QQ.next until Q.wayi.cityP.target or not b переход к следующему пока не город назначения pp.last end Posibleb End begin NewNPath NPath.lastPath PFlightList While P nil do begin Просмотр всех рейсов if Pathnil or P Path. Flight and Pattern. KindP.Kind then не повторяется рейс и сответствует тип перевозки begin I1 Поиск среди городов следования начальный пункт While I P.TotalStation-1 and CityInPathP.path, I.city Pattern. BCity do inc I If CityInPathP.path, I.cityPattern. BCity then begin Если начальный найден NPatternPattern Подготовка нового шаблона и новой пересадки if Npattern.reboading 1 then decNpattern.reboading Npath.flightP For K1 to Mclass do Npath.costk0 Npath.bcitypattern.bcity Npath. DdelayDepartureDelayP,I,Pattern.de lay Npath.waytime0 JI Repeat просмотр следующих городов IncJ Внесение исправлений в шаблон и элемент маршрута о цене и времени For K1 to MClass do If Pattern. ClassK and P.classK then Npath.costkNpath.costkCityInPathP.path,J .CostK Npath.waytimeNpath.waytimeCityInPathP.pa th,J.delay Npath.targetCityInPathP.path,J.City NPattern.

BcityCityInPathP.path,J.City Npattern. WayTimePattern. WayTime-Npath.dd elay-Npath.waytime Npattern. Delaypattern. DelayNpath. DdelayN path.wayTime mod 10080 B1PosiblePath,CityInPathP.path,J.City and NPattern. WayTime 0 Проверка не превышены лимиты времени и стоимости и нет повтора пути B2CityInPathP.path,J.cityPattern. ECity приехали Если не приехали и лимиты не превышены то делаем рассмотроим маршруты от текущего до конечного городов if B1 and not B2 and Pattern.reboading 1 then SearchFlightList,Npattern,Npath Npath.waytimeNpath.waytimeCityInPathP.pa th,J.reboard Until not B1 or B2 or J P.totalStation Выходим, если есть нарушения или рейс закончился или прехали If B2 and B1 then AnswerNpath, pattern.cost Если приехали, добавить маршрут в список end найден начальный город end маршрут подходит по типу PP.next переход к следущему циклу end DisposeNPath end Загрузка исходных данных из файла Function Load APFlight FNameStringvar CitycitiesPFlight Var SourceText PPflight IWayClass J,MCCityCode Kbyte Cchar QPway G,LDayTable Dstring8 Begin AssignSource,FName ResetSource readlnSource,MC Количество городов Считывание название городов и координат на карте For J1 to MC do begin ReadLnsource,Cityj.name readlnsource, cityj.x, cityj.y end While Not EOFSource do begin NewP P.NextA AP Общая информация о рейсе ReadLnSource, P.company ReadLnSource, P.number ReadLnSource, P.kind Стоимость каждого из классов For I1 to MClass do begin ReadSource,C P.classiCX end ReadLnSource, P.TotalStation NewP.path QP.path информация о городах следования времени пути, стоянках For J1 to P.TotalSTation do begin KJ-1 mod 41 ReadSource,Q.WayK.City,Q.WayK.Delay,Q.Wa yK.Reboard For I1 to MClass do If P.classI then ReadSource,Q.WayK.costI else Q.WayK.costI0 If J mod 40 then begin If J P.TotalStation then begin NewQ.Next QQ.next end else Q.nextnil end ReadLnSource end NewP.Table GP.Table LG Информация о отправлении из начального пункта While Not EOLnSource do begin ReadSource,D G.TimeordD1-ord0-11440ordD3-ord010ordD4- ord060 ordD6-ord010ordD7-ord0 if L.time G.time then writeWrong data If not EOLnSource then begin NewG.next GG.next end else G.nextnil end ReadLnSource end LoadA end const line procedure graphoutconst citycities var grDriver Integer grMode Integer pcitycode begin grDriver Detect InitGraphgrDriver, grMode, setcolor12 outtextxy200,0,Карта транспортной схемы p1 while p maxcity and cityp.name do begin setcolor5 fillellipse4cityp.x,380-3cityp.y,2,2 setcolor11 outtextxy4cityp.x5,376-3cityp.y, cityp.na me incp end end var ListPFLight patternblank ststring panswerlist citycities adat Procedure Inputvar Patternblank var adat var icitycode ststring bdat wreal begin with pattern do begin GotoXY30,1 WriteLnВвод исходных данных writeline repeat writeНачальный город readlnst Bcity1 while BCity Maxcity and CityBCity.name st do incBCity until BCity MaxCity repeat writeКонечный город readlnst Ecity1 while ECity Maxcity and CityECity.name st do incECity until Ecity MaxCity repeat gotoxy1,5 WriteLnДата отправление DTInputa delaya. Dweek1440a.time WriteМаксимальное время пути сутки readlnw waytimeround1440w until waytime 0 writeМаксимальная стоимость ReadLncost writeМаксимальное число пересадок readlnreboading writeТип перевозки авиа, ж.д авто, водн. readlnst if st then for i1 to 4 do kinditrue else for i1 to 4 do kindistiY or stiy or stiX or stix writeДопустимые классы 123456 readlnst if st then for i1 to 4 do classitrue else for i1 to 4 do classistiY or stiy or stiX or stix end end procedure outrespAnswerlist adat var kword qlink bdat icitycode ypway cbyte begin k0 while P nil do begin inck writep.path.bcity QP.path ba while Q nil do begin writecityq.bcity.name Writeln, q.flight.company, q. Flight. Number, ,cityQ.Target.name newdatb,Q.ddelay, b writeОтправление writedatb newdatb,Q.waytime, b write Прибытие writedatb writeln QQ.last end newdata, p.waytime, b writeln цена ,P.mincost, p.maxcost readlnst if stp then begin graphoutcity qp.path c2 while q nil do begin i1 yq.flight.path while y.wayi.city q.bcity do begin ii mod 41 if i1 then yy.next end setcolorc moveto4cityq.bcity. x,380-3cityq.bcity.y repeat ii mod 41 if i1 then yy.next lineto4cityy.wayi.city.x,380-3cityy.wayi .city.y until y.wayi.cityq.target QQ.last incc end repeat until keypressed CloseGraph end PP.next end if k0 then writeПри данных условиях добраться нельзя else writelnВсего, k, маршшрутов end Begin ListLoadnil, trafic, city graphoutcity repeat until keypressed closegraph Inputpattern, a newlanswer lanswer.nextnil SearchList, pattern, nil outresLanswer.next, a end. 6.