Поиск кратчайшего пути

Обычно задача поиска пути на графе формулируется следующим образом: найти наилучший маршрут. Под наилучшим маршрутом, как правило, понимают кратчайший. Найти кратчайший маршрут можно выбором из всех найденных. Однако совсем не обязательно искать все маршруты.

Можно поступить иначе: во время выбора очередной точки проверить, не превысит ли длина формируемого маршрута длину уже найденного пути, если эта точка будет включена в маршрут; если превысит, то эту точку следует пропустить и выбрать другую.

Таким образом, после того как будет найден первый маршрут, программа будет вести поиск только по тем ветвям графа, которые могут улучшить найденное решение, отсекая пути, делающие формируемый маршрут длиннее уже найденного.

В листинге 12.6 приведена процедура, которая использует процедуру step, выполняющую выбор очередной точки маршрута таким образом, что обеспечивается поиск пути минимальной длины.

Листинг 12.6. Поиск кратчайшего пути

procedure TForm1.Button1Click(Sender: TObject);

const

N=10;{ кол-во вершин графа} var

map:array[1..N,1..N]of integer;

// Карта.map[i,j] не 0,если

// точки i и j соединены

road:array[1..N]of integer;

// Дорога — номера точек карты

incl:array[1..N]of boolean; // incl[1]равен TRUE,если точка

// с номером i включена в road

start, finish:integer;

// Начальная и конечная точки

found:boolean; len:integer; // длина найденного (минимального)

// маршрута } c_len:integer; // длина текущего (формируемого)

// маршрута i,j:integer;

// выбор очередной точки

procedure step(s,f,p:integer);

var

с:integer; { Номер точки, в которую делаем очередной шаг }

i:integer; begin

if s=f then begin

len:=c_len;{ сохраним длину найденного маршрута }

{ вывод найденного маршрута }

for i:=1 to p-1 do

Label1.caption:=Label1.caption+' '+IntToStr(road[i]);

Label1.caption:=Label1.caption

+', длина:'+IntToStr(len)+#13;

end

else

{ выбираем очередную точку }

for c:=l to N do { проверяем все вершины }

if(map[s,c]<> 0)and(NOT incite])

and((len=0)or(c_len+map[s,c]< len)) then begin

// точка соединена с текущей, но не включена в

// маршрут

roadtp]:=c;{ добавим вершину в путь }

incl[c]:=TRUE;{ пометим вершину как включенную }

c_len:=c_len+map[s,с];

step(c,f,p+l);

incite]:=FALSE; roadtp]:=0;

c_len:=c_len-map[s,с];

end;

end;

{ конец процедуры step }

begin

Labell.caption:='';

{ инициализация массивов }

for i: =1 to N do road [ i ] : =0;

for i:=l to N do incl[i]:=FALSE;

{ ввод описания карты из SrtingGrid.Cells}

for i:=l to N do

for j:=1 to N do

if StringGridl.Cells[i, j] <> "

then mapti,j]:=StrToInt(StringGridl.Cells[i,j])

else mapti,j]:=0;

len:=0; // длина найденного (минимального) маршрута с

len:=0,- // длина текущего (формируемого) маршрута

start:=StrToInt(Edit1.text);

finish:=StrToInt(Edit2.text);

road[1]:=start;{ внесем точку в маршрут }

incl[start]:=TRUE;{ пометим ее как включенную }

step(start,finish,2);{ищем вторую точку маршрута }

// проверим, найден ли хотя бы один путь

if not found

then Label1.caption:='Указанные точки не соединены!';

end;

Диалоговое окно программы поиска кратчайшего пути и процедура обработки события OnActivate ничем не отличаются от диалогового окна и соответствующей процедуры OnActivate программы поиска всех возможных маршрутов, рассмотренной в предыдущем разделе.

 


Знаете ли Вы, что, как не тужатся релятивисты, CMB (космическое микроволновое излучение) - прямое доказательство существования эфира, системы абсолютного отсчета в космосе, и, следовательно, опровержение Пуанкаре-эйнштейновского релятивизма, утверждающего, что все ИСО равноправны, а эфира нет. Это фоновое излучение пространства имеет свою абсолютную систему отсчета, а значит никакого релятивизма быть не может. Подробнее читайте в FAQ по эфирной физике.

НОВОСТИ ФОРУМА

Форум Рыцари теории эфира


Рыцари теории эфира
 10.11.2021 - 12:37: ПЕРСОНАЛИИ - Personalias -> WHO IS WHO - КТО ЕСТЬ КТО - Карим_Хайдаров.
10.11.2021 - 12:36: СОВЕСТЬ - Conscience -> РАСЧЕЛОВЕЧИВАНИЕ ЧЕЛОВЕКА. КОМУ ЭТО НАДО? - Карим_Хайдаров.
10.11.2021 - 12:36: ВОСПИТАНИЕ, ПРОСВЕЩЕНИЕ, ОБРАЗОВАНИЕ - Upbringing, Inlightening, Education -> Просвещение от д.м.н. Александра Алексеевича Редько - Карим_Хайдаров.
10.11.2021 - 12:35: ЭКОЛОГИЯ - Ecology -> Биологическая безопасность населения - Карим_Хайдаров.
10.11.2021 - 12:34: ВОЙНА, ПОЛИТИКА И НАУКА - War, Politics and Science -> Проблема государственного терроризма - Карим_Хайдаров.
10.11.2021 - 12:34: ВОЙНА, ПОЛИТИКА И НАУКА - War, Politics and Science -> ПРАВОСУДИЯ.НЕТ - Карим_Хайдаров.
10.11.2021 - 12:34: ВОСПИТАНИЕ, ПРОСВЕЩЕНИЕ, ОБРАЗОВАНИЕ - Upbringing, Inlightening, Education -> Просвещение от Вадима Глогера, США - Карим_Хайдаров.
10.11.2021 - 09:18: НОВЫЕ ТЕХНОЛОГИИ - New Technologies -> Волновая генетика Петра Гаряева, 5G-контроль и управление - Карим_Хайдаров.
10.11.2021 - 09:18: ЭКОЛОГИЯ - Ecology -> ЭКОЛОГИЯ ДЛЯ ВСЕХ - Карим_Хайдаров.
10.11.2021 - 09:16: ЭКОЛОГИЯ - Ecology -> ПРОБЛЕМЫ МЕДИЦИНЫ - Карим_Хайдаров.
10.11.2021 - 09:15: ВОСПИТАНИЕ, ПРОСВЕЩЕНИЕ, ОБРАЗОВАНИЕ - Upbringing, Inlightening, Education -> Просвещение от Екатерины Коваленко - Карим_Хайдаров.
10.11.2021 - 09:13: ВОСПИТАНИЕ, ПРОСВЕЩЕНИЕ, ОБРАЗОВАНИЕ - Upbringing, Inlightening, Education -> Просвещение от Вильгельма Варкентина - Карим_Хайдаров.
Bourabai Research - Технологии XXI века Bourabai Research Institution