Програма обчислює найкоротший шлях між заданими

{$A+,B-,D+,E+,F-,G-,I+,L+,N-

,O-,P-,Q-,R-,S+,T-,V+,X+}

{$M 16384,0,655360}

Program deikstra;{Програма обчислює найкоротший шлях між заданими

Як s та t) вершинами зв'язного графа формує його як

Послідовність номерів вершин (цілі числа). Ця програма є

Програма навчального призначення i не є оптимальною за багатьма

ознаками. Вимоги до графа наступні:

- це має бути не орграф (задано ребра),

- це не мультиграф (декілька ребер одного типу неприпустимі),

- пропуск номерів вершин в нумерації неприпустимий,

- ребра-петлі неприпустимі,

Зв'язність обов'язкова (реакція програми на протилежне не

Перевірена). Програма частково перевіряє придатність введених

Даних до обробки, проводить індексацію вершин, починаючи з

Кінця шляху (індексація це надання ваги вершинам, де вага

означає найменшу довжину шляху від вершини до кінця шляху)

Потім програма торує шлях з початкової вершини, крокуючі

В напрямку зменшення індексів; при наявності однакових

Ндексів (і шляхів) буде обрано перший з переліку.

Для індексації вершин спочатку проведене розбиття множини вершин

На підмножини - яруси за ознакою однакової мінімальної кількості

Кроків ребрами від кінця шляху до вершини. Потім пересуванням по

Ярусах та перебиранням вершин в межах ярусів уточнюються індекси

Вершин. Файл k8.in в першому рядку містить три цілих числа, де

Перше є номер вершини (не більше 100) початку шляху, друге

Відповідно номер вершини кінця шляху і третє - резерв (поки що

Вводиться, але не використовується). Наступні рядки (у невизначеній

Кількості-програма визначить) по три числа в рядку

Завершуються рядком 0 0 0, ознакою кінця вводу. Кожен рядок

містить:

- номер першої вершини ребра,

- номер другої вершини ребра,

Довжину ребра.

Автором алгоритму з індексацією вершин вважають американ-

Cького програміста Дейкстру.

}

Var

s,t,i,j,m,n,x,d,b,k,p,z,y,x1,x2,wp: integer;

R:array [1..120,1..3] of integer;{перша та друга вершини ребра

та довжина ребра}

w,v:array[1..100] of integer; {індекс вершини w та номер ярусу v}

st:array[1..20] of integer; {вершини найкоротшого шляху}

label b1,b2,b3,b4,b5,b6;

Begin

assign(input,'k8.in');

reset(input);

assign(output,'k8.out');

rewrite(output);

readln(s,t,b); {номери вершин початку, кінця шляху та резервне число}

i:=1 ; {початок вводу описів ребер}

b1:{2}begin {це ввід кортежів-ребер графа та довжин ребер}

readln(r[i,1],r[i,2],r[i,3]); {writeln('r',r[i,1],' ',r[i,2],' ',

r[i,3],'i:=',i);}

{2}end; if r[i,1]=0 then goto b2 else{3}begin i:=i+1;goto b1{3}end;

b2: n:=i-1;writeln('нова задача'); writeln('введено ребер n=',n);

{очищення v} for i:=1 to 100 do v[i]:=0;

{пошук максимального номера вершини}

{проставляємо одиниці в v за номерами вершин}

for i:=1 to n do{4}begin v[r[i,1]]:=1;v[r[i,2]]:=1 {4}end;

{визначаємо макс номер вершини-обчислюємо найбільший номер одиниці в v}

for i:=1 to 100 do if (v[100-i]=1) and (v[100-i+1]=0) then d:=100-i;

Writeln(' кількість вершин d=',d); {підраховуємо кількість одиниць в v

і при відсутності між ними нулів знаємо, що немає пропусків номерів вершин}

x:=0;

for i:=1 to d do if v[i]=0 then x:=x+1; {writeln('x=',x);}

if x=0 then writeln(' ') else begin writeln(' є пропуск номерів вершин ');

goto b6 end;

{задаємо початкове завищене значення індексів та ярусів вершин}

P:=0; for i:=1 to n do p:=p+r[i,3]; for i:=1 to d do {5}begin

W[i]:=p; v[i]:=p

{5}end;

{writeln('сума довжин всіх ребер p=',p);}

{задаємо індекс вершини кінця шляху та ярус її} w[t]:=0;m:=0;v[t]:=0;

{ m - поточний ярус}

Дія 1 - шукаємо та мітимо вершини наступного ярусу - для цього перебираємо

Вершини поточного ярусу і для кожної знаходимо суміжні немічені і мітимо

їх наступним ярусом - зараз буде блок з простим визначенням індексів}

for z:=1 to 1 do begin m:=z-1;

For i:=1 to d do begin

If v[i]=m then for j:=1 to n do begin

If(r[j,1]=i) and (v[r[j,2]]>m) then begin

v[r[j,2]]:=m+1;w[r[j,2]]:=r[j,3] end;

If(r[j,2]=i) and (v[r[j,1]]>m) then begin

v[r[j,1]]:=m+1;w[r[j,1]]:=r[j,3] end;

end;

end;

end;

{for i:=1 to d do write(' i=',i,'v=',v[i],'w=',w[i]); writeln(' ');}

{тепер блок з обчисленням індексів шляхом додавання довжини ребра до індексу попередньої вершини}

{шукаємо вершини ярусу m та надаємо їм індекси не обов'язково мінимальні}

for z:=2 to 10 do begin m:=z-1;

For i:=1 to d do begin

If v[i]=m then for j:=1 to n do begin

If(r[j,1]=i) and (v[r[j,2]]>m) then begin

V[r[j,2]]:=m+1; if w[r[j,2]]>w[i]+r[j,3] then

w[r[j,2]]:=w[i]+r[j,3] end;

If(r[j,2]=i) and (v[r[j,1]]>m) then begin

V[r[j,1]]:=m+1; if w[r[j,1]]>w[i]+r[j,3] then

w[r[j,1]]:=w[i]+r[j,3] end;

end;

end;

end;

{for i:=1 to d do write(' ai=',i,{'v=',v[i],}{'w=',w[i]); writeln(' ');}

{тепер блок коригування залежності індексів від порядку переліку, блок}

{без змін номерів ярусів і з протилежним порядком вибору номеру пари}

for z:=2 to 10 do begin m:=z-1;

For i:=d downto 1 do begin

If v[i]=m then for j:=1 to n do begin

If(r[j,1]=i) and (v[r[j,2]]>m) then begin

If w[r[j,2]]>w[i]+r[j,3] then

w[r[j,2]]:=w[i]+r[j,3] end;

If(r[j,2]=i) and (v[r[j,1]]>m) then begin

If w[r[j,1]]>w[i]+r[j,3] then

w[r[j,1]]:=w[i]+r[j,3] end;

end;

end;

end;

{for i:=1 to d do write(' bi=',i,'v=',v[i],'w=',w[i]); writeln(' ');}

{тепер блок коригування індексів в межах одного кожного ярусу}

for z:=2 to 10 do begin m:=z-1;

For i:=1 to d do begin

If v[i]=m then for j:=1 to n do begin

If(r[j,1]=i) and (v[r[j,2]]=m) then begin

If w[r[j,2]]>w[i]+r[j,3] then

w[r[j,2]]:=w[i]+r[j,3] end;

If(r[j,2]=i) and (v[r[j,1]]=m) then begin

If w[r[j,1]]>w[i]+r[j,3] then

w[r[j,1]]:=w[i]+r[j,3] end;

end;

end;

end;

{for i:=1 to d do write(' ci=',i,{'v=',v[i],'w=',w[i]); writeln(' ');}

{тепер блок коригування ще раз в протилежному порядку в межах одного ярусу}

for z:=2 to 10 do begin m:=z-1;

For i:=d downto 1 do begin

If v[i]=m then for j:=i to n do begin

if(r[j,1]=i) and (v[r[j,2]]=m) then begin {writeln('(',r[j,1],',',r[j,2],') ');}

If w[r[j,2]]>w[i]+r[j,3] then

w[r[j,2]]:=w[i]+r[j,3] end;

If(r[j,2]=i) and (v[r[j,1]]=m) then begin

If w[r[j,1]]>w[i]+r[j,3] then

w[r[j,1]]:=w[i]+r[j,3] end;

end;

end;

end;

{for i:=1 to d do write(' di=',i,{'v=',v[i],}{'w=',w[i]); writeln(' ');}

{блок завершального коригування після виправлень}

for z:=2 to 10 do begin m:=z-1;

For i:=d downto 1 do begin

If v[i]=m then for j:=1 to n do begin

If(r[j,1]=i) and (v[r[j,2]]>m) then begin

If w[r[j,2]]>w[i]+r[j,3] then

w[r[j,2]]:=w[i]+r[j,3] end;

If(r[j,2]=i) and (v[r[j,1]]>m) then begin

If w[r[j,1]]>w[i]+r[j,3] then

w[r[j,1]]:=w[i]+r[j,3] end;

end;

end;

end;

{for i:=1 to d do write(' еi=',i,{'v=',v[i],}{'w=',w[i]); writeln(' ');}

{кінець індексації вершин графа}

{далі побудова послідовності вершин найкоротшого шляху}

K:=1;st[k]:=s;wp:=w[s];z:=s;{встановлено

k- поточний порядковий номер вершини в масиві вершин шляху,

Номер початкової вершини шляху занесено у масив st, індекс вершини

занесено у змінну wp}

B3: {перебираємо вершини суміжні з поточною вершиною і шукаємо серед них

вершину з мінімальним індексом}

For j:=1 to n do

If (r[j,1]=st[k]) and (wp>w[r[j,2]]) then begin

z:=r[j,2]; wp:=w[z]

end;

{знайдено мінімальний індекс з використанням перших елементів кортежів}

For j:=1 to n do

If (r[j,2]=st[k]) and (wp>w[r[j,1]]) then begin

z:=r[j,2]; wp:=w[z]

end;

Знайдено остаточний мінімальний індекс і відповідно вершину для чергового

k:=k+1;st[k]:=z; if z=t then goto b4 else goto b3;{далі вивід} writeln('послідовність вершин найкоротшого шляху:'); i:=1;

End.