Программа
PROGRAM MapMan;
USES CRT,Graph; { Подключение модуля графики и консоли }
TYPE
CoordType=record X,Y:real end; { Тип - Координаты города }
{ Тип - Список городов с расстояниями до них: }
CommunicationType=^NextTown; { Ссылка на город }
NextTown=record { Город в списке связей города из карты }
TownNumber:word; { Номер города }
Distance:real; { Расстояние до этого города }
Next:CommunicationType { Ссылка на следующий город }
end;
{ Тип - Карта: }
MapType=^TownType; { Ссылка на город }
TownType=record { Город в карте }
TownNumber:word; { Номер города в карте }
Coord:CoordType; { Координаты города }
Communications:CommunicationType; { Список звязей с городами }
Next:MapType { Ссылка на следующий город }
end;
{ Список пройденных городов: }
PathType=^TownTypeInPath; { Ссылка на путь }
TownTypeInPath=record { Пройденные города }
TownNumber:word; { Город }
Next:PathType { Следующий город }
end;
VAR Map:MapType; { Карта }
TownNumber1,TownNumber2:word; { Номера городов для определения кратчайшего пути }
Path:PathType; { Путь }
PathFlag:boolean; { Флаг "Путь Найден" }
Exit:boolean; { Флаг "Выход" }
Answer:char; { Ответ на запрос о методе создания карты }
FUNCTION GetTownReference(TownNumber:byte;Map:MapType):MapType;
Begin { Функция получения ссылки на город по номеру города }
GetTownReference:=nil; { Начальное определение значения функции }
while Map<>nil { Цикл просмотра карты }
do if Map^.TownNumber=TownNumber
then begin { Если текущая ссылка указывает на искомый город }
GetTownReference:=Map; { то - определение значения функции }
Map:=nil { переопределение условия выхода из цикла }
end
else Map:=Map^.Next { иначе - переопределение ссылки на следующий город }
End;
PROCEDURE CreationMap(var Map:MapType;RandomFlag:boolean);
{ Процедура создания карты }
Var i,j,k:byte; { Счетчики }
TownQuantity:byte; { Количество городов }
QuantityCommunication:byte; { Количество связей города с другими городами }
Buf:MapType; { Ссылка на создаваемый город }
FirstTown,SecondTown:MapType; { Ссылки на связываемые города }
CommunicationBuf:CommunicationType;
{ Буферная ссылка на связь города с другими городами }
Begin
Map:=nil; { Начальное определение состояния карты }
if RandomFlag
{ Выбор метода создания карты <Случайный набор/Набор определяемый пользователем> }
then begin
Randomize; { Инициализация генератора случайных чисел }
TownQuantity:=8{ "Ввод" количества городов }
end
else begin
ClrScr; { Очистка экрана }
{ Ввод количества городов: }
Write('Введите количество городов ');
ReadLn(TownQuantity)
end;
for i:=1 to TownQuantity do { Цикл инициализации городов }
begin { Определение города }
New(Buf); { Создание переменной }
Buf^.TownNumber:=i; { Идентификация города }
if RandomFlag
{ Выбор метода создания карты <Случайный набор/Набор определяемый пользователем> }
then begin
{ Инициализация координат города: }
Buf^.Coord.X:=Random*100-50;
Buf^.Coord.Y:=Random*100-50;
end
else begin
{ Вывод приглашений и ввод координат города: }
Write('Введите X координату ',i,'-го города ');
ReadLn(Buf^.Coord.X);
Write('Введите Y координату ',i,'-го города ');
ReadLn(Buf^.Coord.Y)
end;
Buf^.Communications:=nil; { Начальное определение связей с городами }
Buf^.Next:=Map; { Связывание созданой части карты с создаваемым городом }
Map:=Buf { Переопределение ссылки на карту на последний введенный город в карте }
end;
for i:=1 to TownQuantity do { Цикл инициализации связей между городами }
begin
if RandomFlag
{ Выбор метода создания карты <Случайный набор/Набор определяемый пользователем> }
then QuantityCommunication:=TownQuantity div 2 { Определение количесва связей }
else begin
{ Ввод количесва связей }
Write('Введите количество связей ',i,'-го города с другими городами ');
ReadLn(QuantityCommunication)
end;
{ Инициализация связей города: }
if RandomFlag
{ Выбор метода создания карты <Случайный набор/Набор определяемый пользователем> }
then begin
if i<>TownQuantity { Блокирование инициализации связей последнего
города при автоматическом формировании карты }
then for j:=i+1 to TownQuantity do
{ Цикл инициализации звязей между городом и последующими городами }
if (Random<QuantityCommunication/(TownQuantity-j+1)) then
{ Случайное распределение связей между городами }
begin
Dec(QuantityCommunication);
{ Переопределение количества связей }
{ Получение ссылок на связываемые города: }
FirstTown:=GetTownReference(i,Map);
SecondTown:=GetTownReference(j,Map);
New(CommunicationBuf); { Создание переменной }
CommunicationBuf^.TownNumber:=j; { Определение города }
CommunicationBuf^.Distance:= { Вычисление расстояния }
Sqrt(Sqr(FirstTown^.Coord.X-SecondTown^.Coord.X)
+Sqr(FirstTown^.Coord.Y-SecondTown^.Coord.Y));
CommunicationBuf^.Next:=FirstTown^.Communications;
{ Сохранение ссылки на список связанных городов }
FirstTown^.Communications:=CommunicationBuf;
{ Переопределение ссылки на список связанных городов }
New(CommunicationBuf); { Создание переменной }
CommunicationBuf^.TownNumber:=i; { Определение города }
CommunicationBuf^.Distance:= { Вычисление расстояния }
Sqrt(Sqr(FirstTown^.Coord.X-SecondTown^.Coord.X)
+Sqr(FirstTown^.Coord.Y-SecondTown^.Coord.Y));
CommunicationBuf^.Next:=SecondTown^.Communications;
{ Сохранение ссылки на список связанных городов }
SecondTown^.Communications:=CommunicationBuf;
{ Переопределение ссылки на список связанных городов }
end
end
else for j:=1 to QuantityCommunication do
{ Цикл инициализации звязей между городом и другими городами }
begin
{ Ввод номера города с которым связывается текущий город: }
Write('Введите номер города с которым связан ',i,' город ');
ReadLn(k);
{ Получение ссылок на связываемые города: }
FirstTown:=GetTownReference(i,Map);
SecondTown:=GetTownReference(k,Map);
New(CommunicationBuf); { Создание переменной }
CommunicationBuf^.TownNumber:=k; { Определение города }
{ Ввод расстояния между связываемыми городами: }
Write('Введите расстояние от ',i,'-го города до ',k,'-го ');
ReadLn(CommunicationBuf^.Distance);
CommunicationBuf^.Next:=FirstTown^.Communications;
{ Сохранение ссылки на список связанных городов }
FirstTown^.Communications:=CommunicationBuf;
{ Переопределение ссылки на список связанных городов }
New(CommunicationBuf); { Создание переменной }
CommunicationBuf^.TownNumber:=i; { Определение города }
CommunicationBuf^.Distance:=FirstTown^.Communications^.Distance;
{ Определение расстояния }
CommunicationBuf^.Next:=SecondTown^.Communications;
{ Сохранение ссылки на список связанных городов }
SecondTown^.Communications:=CommunicationBuf;
{ Переопределение ссылки на список связанных городов }
end
end;
End;
PROCEDURE GetTownCoord(var Coord:CoordType;Number:byte;Map:MapType);
Begin { Процедура получения координат города по номеру }
Map:=GetTownReference(Number,Map); { Получение ссылки на город }
Coord:=Map^.Coord { Определение значения функции }
End;
PROCEDURE WriteGraph(X,Y:integer;St:string);
Begin { Процедура вывода строки с центрированием }
OutTextXY(X-TextWidth(St) div 2,Y-TextHeight(St) div 2,St) { Вывод строки }
End;
PROCEDURE OutStringInRectangle(X,Y:integer;St:string);
{ Процедура вывода строки в прямоугольнике }
Var W,H:word; { Полуширина и полувысота текста St }
Begin
W:=TextWidth(St) div 2; { Вычисление полувысоты строки }
H:=TextHeight(St) div 2; { Вычисление полуширины строки }
Bar(X-W-3,Y-H-3,X+W+2,Y+H+2); { Вывод прямоугольника }
Rectangle(X-W-3,Y-H-3,X+W+2,Y+H+2); { Вывод прямоугольника }
OutTextXY(X-W,Y-H,St) { Вывод строки }
End;
FUNCTION GetString(Num:real;RealFlag:boolean):string;
{ Функция преобразования числа в строку }
Var Buf:string; { Буферная строка }
Begin
{ Преобразование числа: }
if RealFlag then Str(Num:0:2,Buf)
else Str(Num:1:0,Buf);
GetString:=Buf { Определение значения функции }
End;
FUNCTION CommunicationBelongPath(Number1,Number2:byte;Path:PathType;
PathFlag:boolean):boolean;
{ Функция определения принадлежности отрезка к пути }
Var Exit:boolean; { Флаг выхода }
Begin
if PathFlag { Если путь найден }
then begin { то }
Exit:=False; { Сброс флага "Выход" }
while not Exit { Цикл просмотра списка }
do if Path<>nil { если путь существует }
then begin { то - сравнение города с двумя заданными }
if (Path^.TownNumber=Number1)or(Path^.TownNumber=Number2)
{ определение выхода при условии принадлежности города к искомым }
then Exit:=True;
Path:=Path^.Next { Переопределение ссылки на путь }
end
else Exit:=True; { Подъем флага "Выход" }
if Path<>nil { Если после просмотра списка существует город }
then CommunicationBelongPath:=(Path^.TownNumber=Number1)or(Path^.TownNumber=Number2)
{ то - определение функции по принадлежности города одному из искомых }
else CommunicationBelongPath:=False
{ иначе - отрезок между данными городами не принадлежит пути }
end
else CommunicationBelongPath:=False
{ иначе - отрезок между данными городами не принадлежит пути }
End;
PROCEDURE ShowMap(Map:MapType;var Path:PathType;PathFlag:boolean;
StartTown,FinishTown:byte;FrontPage:boolean);
{ Процедура вывода карты }
Const PathToDriver=''; { Путь к графическому драйверу }
Var GraphDriver:integer; { Графический драйвер }
GraphMode:integer; { Графический режим }
Town1:MapType; { Ссылка на город }
Communication:CommunicationType; { Ссылка на список связей города }
XMin,YMin,XMax,YMax,ScaleX,ScaleY:real;
{ Минимальны и максимальные координаты городов, масштабы }
CoordTown1,CoordTown2:CoordType;
R:integer; { Радиус окружности обозначающей город }
X1,X2,Y1,Y2:integer; { Вспомогательные переменные }
Step:PathType; { Ссылка на город для включения в Path городов
StartTown, FinishTown }
Begin
GraphDriver:=Detect; { Автоматическое оперделение драйвера }
GraphMode:=0; { Задание графического режима }
InitGraph(GraphDriver,GraphMode,PathToDriver); { Инициалиэация графики }
Town1:=Map; { Определение ссылки на город }
if Town1<>nil { Начальная инициализация координат }
then begin
XMin:=Town1^.Coord.X;
YMin:=Town1^.Coord.Y;
XMax:=XMin;
YMax:=YMin;
Town1:=Town1^.Next
end;
while Town1<>nil do
{ Цикл просмотра городов для определения масштаба карты и смещения }
begin
{ Переопределение Max и Min координат при выходе координат текущего города
за пределы: }
if XMin>Town1^.Coord.X then XMin:=Town1^.Coord.X;
if YMin>Town1^.Coord.Y then YMin:=Town1^.Coord.Y;
if XMax<Town1^.Coord.X then XMax:=Town1^.Coord.X;
if YMax<Town1^.Coord.Y then YMax:=Town1^.Coord.Y;
Town1:=Town1^.Next { Переопределение ссылки на город }
end;
{ Расчет масштабов: }
if XMin<>XMax then ScaleX:=GetMaxX*0.8/(XMax-XMin)
else ScaleX:=1;
if YMin<>YMax then ScaleY:=GetMaxY*0.8/(YMax-YMin)
else ScaleY:=1;
{ Включение начального и конечного городов в путь }
New(Step); { Создание новой переменной }
Step^.TownNumber:=StartTown;
Step^.Next:=Path; { Присоединение пути }
Path:=Step; { Переопределение ссылки на путь }
while Step^.Next<>nil do Step:=Step^.Next;{ Проход по пути до последнего элемента }
New(Step^.Next); { Создание новой переменной }
Step^.Next^.TownNumber:=FinishTown;
Step^.Next^.Next:=nil; { Оформление конца списка }
Town1:=Map; { Определение ссылки на город по первому городу в карте }
SetFillStyle(SolidFill,Black);{ Определение заполнения фигур однородным черным }
while Town1<>nil do { Цикл прорисовки связей между городами }
begin
CoordTown1:=Town1^.Coord; { Получение координат первого города в связи }
Communication:=Town1^.Communications; { Получение ссылки на список связей текущего города }
while Communication<>nil do { Цикл прорисовки связей }
begin
{ Прорисовка связей текущего города с последующими городами }
if Communication^.TownNumber<Town1^.TownNumber then
begin
GetTownCoord(CoordTown2,Communication^.TownNumber,Town1^.Next);
{ Получение координат второго города }
{ Пересчет фактических координат города в координаты экрана }
X1:=Round((CoordTown1.X-XMin)*ScaleX+0.1*GetMaxX);
Y1:=Round((CoordTown1.Y-YMin)*ScaleY+0.1*GetMaxY);
X2:=Round((CoordTown2.X-XMin)*ScaleX+0.1*GetMaxX);
Y2:=Round((CoordTown2.Y-YMin)*ScaleY+0.1*GetMaxY);
if CommunicationBelongPath(Town1^.TownNumber,
Communication^.TownNumber,Path,PathFlag)
{ Если связь принадлежит пути }
then begin { то - прорисовка пунктирной толстой линии }
SetLineStyle(DashedLn,0,ThickWidth); { Установка типа линии }
Line(X1,Y1,X2,Y2); { прорисовка линии }
SetLineStyle(SolidLn,0,NormWidth) { Установка типа линии }
end
else Line(X1,Y1,X2,Y2); { иначе прорисовка сплошной тонкой линии }
OutStringInRectangle((X1+X2) div 2,(Y1+Y2) div 2,
GetString(Communication^.Distance,True))
{ Вывод длины связи }
end;
Communication:=Communication^.Next { Переход на следующую связь }
end;
Town1:=Town1^.Next { Переход на следующий город }
end;
Town1:=Map; { Определение ссылки на первый город в карте }
R:=Round(0.03*GetMaxX); { Определение радиуса окружности города }
while Town1<>nil do { Цикл прорисовки городов }
begin
{ Вычисление экранных координат города }
X1:=Round((Town1^.Coord.X-XMin)*ScaleX+0.1*GetMaxX);
Y1:=Round((Town1^.Coord.Y-YMin)*ScaleY+0.1*GetMaxY);
SetColor(Black); { Установка черного цвета }
PieSlice(X1,Y1,0,360,R); { Прорисовка круга }
SetColor(White); { Установка белого цвета }
Circle(X1,Y1,R); { Прорисовка окружности }
WriteGraph(X1,Y1,GetString(Town1^.TownNumber,False)); { Вывод номера города }
Town1:=Town1^.Next { Переход на следующий город }
end;
OutStringInRectangle(GetMaxX div 2,GetMaxY-8,'Press <ENTER>');
{ Вывод приглашения нажать Enter }
if FrontPage then { Если процедура работает как заставка то }
begin
SetColor(Yellow); { Выбор желтого цвета }
SetTextStyle(DefaultFont,HorizDir,20); { Выбор типа шрифта }
OutTextXY((GetMaxX-TextWidth('MAP')) div 2,(GetMaxY-TextHeight('MAP')) div 2,'MAP');
{ Вывод надписи }
SetColor(White); { Установка белого цвета }
end;
ReadLn; { Ожидание нажатия Enter }
CloseGraph { Закрытие графического режима }
End;
FUNCTION CheckTownInPath(TownNumber:byte;TownList:PathType):boolean;
Begin { Функция проверки принадлежности города пути }
CheckTownInPath:=False; { начальное определение функции }
while TownList<>nil { Цикл просотра списка городов }
do if TownList^.TownNumber=TownNumber { Если текущий город равен искомому }
then begin { то }
CheckTownInPath:=True; { Определение функции }
TownList:=nil { Определение условия входа }
end
else TownList:=TownList^.Next { Переход к следующему городу }
End;
FUNCTION GetLengthStep(Town1,Town2:byte;Map:MapType):real;
{ Функция определения расстояния между городами }
Var Communication:CommunicationType; { Ссылка на связи }
TownReference:MapType; { Ссылка на город }
Begin
TownReference:=GetTownReference(Town1,Map); { Определение ссылки на город }
Communication:=TownReference^.Communications; { определение ссылки на связи }
while Communication^.TownNumber<>Town2
{ Цикл просмотра связи до нахождения искомого города }
do Communication:=Communication^.Next; { Переход на следующий город }
GetLengthStep:=Communication^.Distance { Определение функции }
End;
FUNCTION GetLengthPath(Town1:byte;Path:PathType;Town2:byte;Map:MapType):real;
{ Функция вычисления длины пути }
Var Len:real; { Длина }
Begin
Len:=0; { Сброс значения длины }
while Path<>nil do { Цикл просмотра пути и набора длины }
begin
Len:=Len+GetLengthStep(Town1,Path^.TownNumber,Map); { подсчет длины }
{ Переход к следующей связи: }
Town1:=Path^.TownNumber;
Path:=Path^.Next
end;
Len:=Len+GetLengthStep(Town1,Town2,Map); { подсчет длины }
GetLengthPath:=Len { определение функции }
End;
PROCEDURE DisposerPath(var L:PathType); { Процедура удаления списка }
Begin
if L<>nil
then begin { Если переменная существует, то }
DisposerPath(L^.NEXT); { удаление хвоста списка }
Dispose(L) { удаление переменной }
end;
L:=nil { Переопределение ссылки }
End;
PROCEDURE GetShortPath(TownNumber1,TownNumber2:byte;Map:MapType;var Path:PathType;
TownList:PathType;var Flag:boolean);
{ Функция поиска кратчайшего пути }
Var Communication:CommunicationType; { Список связей }
Town1:MapType; { Ссылка на город }
TownInPath:PathType; { Ссылка на город принадлежащий пути }
NewPath:PathType; { Новый найденный путь }
NewPathFlag:boolean; { Флаг "Новый Путь Найден" }
Begin
Town1:=GetTownReference(TownNumber1,Map); { Определение ссылки на город }
Communication:=Town1^.Communications; { Определение ссылки на связи }
Path:=nil; { Сброс ссылки на путь }
Flag:=False; { Сброс флага "Путь Найден" }
New(TownInPath); { Создание новой переменной }
TownInPath^.TownNumber:=TownNumber1; { Определение списка пройденных городов }
TownInPath^.Next:=TownList; { Присоединение хвоста очереди }
TownList:=TownInPath; { Переопределение списка пройденных городов }
while Communication<>nil do { Цикл просмотра связей }
begin
if not CheckTownInPath(Communication^.TownNumber,TownList) then
{ Если текуший город не принадлежит пройденному пути, то }
begin
if Communication^.TownNumber=TownNumber2 { Если текущий город равен конечному городу }
then begin { то }
NewPathFlag:=True; { Подъем флага "Путь Найден" }
NewPath:=nil { Сброс ссылки на новй путь }
end
else begin { Иначе }
GetShortPath(Communication^.TownNumber,TownNumber2,
Map,NewPath,TownList,NewPathFlag);
{ Поиск кратчайшего пути от текущего города в списке связей }
if NewPathFlag then
begin { Если путь найден то - оформление нового пути: }
New(TownInPath); { Создание новой переменной }
TownInPath^.TownNumber:=Communication^.TownNumber;
{ Определение ссылки на город }
TownInPath^.Next:=NewPath; { Присоединение найденного пути к городу }
NewPath:=TownInPath { Переопределение ссылки на путь }
end
end;
if NewPathFlag then { Если новый путь найден то }
if not Flag { Если предыдущего пути нет }
then begin { то оформление нового пути как найденного кратчайшего }
Flag:=NewPathFlag;
Path:=NewPath
end
else if GetLengthPath(TownNumber1,NewPath,TownNumber2,Map)
<GetLengthPath(TownNumber1,Path,TownNumber2,Map)
{ иначе - сравнение длин путей }
then begin
DisposerPath(Path); { Удаление предыдущего пути }
Path:=NewPath { Определение нового пути как кратчайшего }
end
else DisposerPath(NewPath) { удаление найденного пути }
end;
Communication:=Communication^.Next { Переход к следующей связи }
end;
Dispose(TownList) { Уничтожение переменной по первым городом в пути }
End;
PROCEDURE DisposerList(var L:CommunicationType); { Процедура удаления списка }
Begin
if L<>nil
then begin { Если переменная существует, то }
DisposerList(L^.NEXT); { удаление хвоста списка }
Dispose(L) { удаление переменной }
end;
L:=nil { Переопределение ссылки }
End;
PROCEDURE DisposerMap(var Map:MapType); { Процедура удаления карты }
Begin
if Map<>nil { Если переменная существует, то }
then begin
DisposerMap(Map^.Next); { удаление хвоста списка }
DisposerList(Map^.Communications); { удаление списка связей }
Dispose(Map); { удаление переменной }
Map:=nil { переопределение ссылки }
end
End;
FUNCTION Menu:byte; { Функция вывода меню и получения ответа }
Const QuantityMenuPoint=4; { Количество пунктов меню }
ExitPoint=QuantityMenuPoint; { Пункт меню "Выход" }
MaxLengthMenuPoint=27; { Максимальная длина пункта меню }
MenuList:array[1..QuantityMenuPoint] of string[MaxLengthMenuPoint] =
('[1] Создание карты ',
'[2] Просмотр карты ',
'[3] Поиск кратчайшего пути ',
'[4] ВЫХОД ');
Var MenuMeter:integer; { Счетчик }
Point:integer; { Выбранный пункт меню }
Begin
ClrScr; { Очистка экрана }
for MenuMeter:=1 to QuantityMenuPoint do WriteLn(MenuList[MenuMeter]);
{ Цикл прорисовки меню }
repeat { Цикл чтения клавиатуры }
Point:=Ord(ReadKey); { Чтение клавиатуры }
if Point<>27 { Если нажатая клавиша не Esc, }
then Point:=Point-Ord('0') { то - вычисление введенного пункта меню }
else Point:=ExitPoint { иначе - переопределение пункта под "Выход" }
until (0<Point) and (Point<=QuantityMenuPoint);
{ Выход из цикла при пролучении корректного ответа }
{ Определение значения функции: }
if Point=ExitPoint then Menu:=255
else Menu:=Point
End;
BEGIN
Path:=nil;
PathFlag:=False; { Сброс флага "Путь" }
TownNumber1:=0;
TownNumber2:=0;
CreationMap(Map,True); { Создание карты }
ShowMap(Map,Path,False,TownNumber1,TownNumber2,True); { Вывод карты }
Exit:=FALSE; { Сброс флага "Выход" }
repeat
case Menu of { Выбор действия по ответу на меню }
1:begin
ClrScr; { Очистка экрана }
Write('Создать карту автоматически? [Y/N]');
Answer:=ReadKey;
DisposerMap(Map); { Удаление карты }
DisposerPath(Path); { Удаление пути }
PathFlag:=False; { Сброс флага "Путь" }
CreationMap(Map,UpCase(Answer)='Y'); { Создание карты }
ShowMap(Map,Path,PathFlag,TownNumber1,TownNumber2,False);
{ Вывод карты }
end;
2:ShowMap(Map,Path,False,0,0,False);
3:begin
ClrScr; { Очистка экрана }
DisposerPath(Path); { Удаление пути }
{ Ввод номеров городов для определения пути: }
Write('Введите номер первого города ');
ReadLn(TownNumber1);
Write('Введите номер второго города ');
ReadLn(TownNumber2);
GetShortPath(TownNumber1,TownNumber2,Map,Path,nil,PathFlag);
{ Получение кратчайшего пути }
ShowMap(Map,Path,PathFlag,TownNumber1,TownNumber2,False)
end;
255:Exit:=TRUE { Подъем флага "Выход" }
end
until Exit;
DisposerMap(Map); { Удаление карты }
DisposerPath(Path) { Удаление пути }
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию