{$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;
End.