Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

TurboPascal: всего лишь сменить min на max, но всё не так-то просто...

54K
19 декабря 2009 года
ulala
4 / / 18.12.2009
Доброго времени суток
Задание:
1. Определить длину максимального пути для графа, заданного матрицей расстояний.
2. Найти вершины, лежащие на этом пути.
В интернете нашла код, переделала его под себя, но он ищет вершины лежащие на минимальном пути, да и работает через раз (зацикливается).
Вот

Код:
program MDP;
uses crt;
type
mas=array [1..50] of integer;
var
 G,F1,F2,F3,F4,F5,F6,F7,F8,F9: set of byte;
R,M,S,B: array [1..20]  of array [1..20] of integer;
Mit: array [0..50,1..50] of integer;
Y,p,p1: array [1..10] of integer;
zv: array [1..2] of mas;
i,j,k,n,C,V,is,st,i1,max: integer;
begin
 clrscr;
 G:=[1,2,3,4,5,6,7,8,9];
 F1:=[2,3,4];
 F2:=[3,6];
 F3:=[4,5];
 F4:=[5,7];
 F5:=[6,8];
 F6:=[9];
 F7:=[8,9];
 F8:=[9];
 F9:=[];

 for i:=1 to 9 do
for j:=1 to 9 do begin
 if j in F1 then R[1,j]:=1
  else R[1,j]:=0;
 if j in F2 then R[2,j]:=1
  else R[2,j]:=0;
 if j in F3 then R[3,j]:=1
  else R[3,j]:=0;
 if j in F4 then R[4,j]:=1
  else R[4,j]:=0;
 if j in F5 then R[5,j]:=1
  else R[5,j]:=0;
 if j in F6 then R[6,j]:=1
  else R[6,j]:=0;
  if j in F7 then R[7,j]:=1
  else R[7,j]:=0;
 if j in F8 then R[8,j]:=1
  else R[8,j]:=0;
   if j in F9 then R[9,j]:=1
  else R[9,j]:=0;
end;
 writeln('matrica smeznosti R->');
 for i :=1 to 9 do begin
 for j:=1 to 9 do
  write(R[i,j],' ');
  writeln;
 end;

 for i:=1 to 9 do
for j:=1 to 9 do begin
if R[i,j]=1 then  begin
write('Vvedite ves dugi-> ');
readln(V);
S[i,j]:=V;
end;
end;
writeln('matrica rasstoyanii L ->');
 for i :=1 to 9 do begin
 for j:=1 to 9 do
  write(S[i,j],' ');
  writeln;
 end;

for j:=1 to 9 do
B[j,1]:=0;
for i:=2 to 9 do
for j:=1 to 9 do
B[j,i]:=-100;

j:=1;
repeat j:=j+1;
k:=0;
for i:=1 to 9 do
if S[i,j]>0 then begin
k:=k+1;
Y[k]:=B[j-1,i]+S[i,j];
end;
C:=-100; {minus beskone4nost}
for n:=1 to k do
if Y[n]>C then C:=Y[n];

for i:=j to 9 do
B[i,j]:=C;
until j=9;

 writeln('opredelenie dliny maksimalnogo puti->');

 for j:=1 to 9 do begin
 for i:=1 to 9 do
  write(B[j,i],'   ');
  writeln;
  end;
   writeln;

{vershini lezashie na max puti}
 Writeln('Vvedite istok ');
  Write('S= ');
  Readln(is);
  Writeln('Vvedite stok ');
  Write('T= ');
  Readln(st);
  for i:=0 to 9 do
   for j:=1 to 9 do
    MIt[i,j]:=100;
  i:=1;
  p:=is;
  Mit[0,is]:=0;
  Zv[1,is]:=1;
  Zv[2,is]:=0;
  Repeat
   For i1:=1 to 9 do
    MIt[i,i1]:=MIt[i-1,i1];
    For i1:=1 to 9 do
    If S[p,i1]<>0
    Then If MIt[i-1,i1]<Mit[i,p]+S[p,i1]
     Then Mit[i,i1]:=Mit[i-1,i1]
     Else Mit[i,i1]:=Mit[i,p]+S[p,i1];
   max:=100;
   For i1:=1 to 9 do
     If Zv[1,i1]<>1
    Then If Mit[i,i1]<max
     Then begin
           max:=Mit[i,i1];
           k:=i1;
          end;
   Zv[1,k]:=1;
   Zv[2,k]:=max;
   i:=i+1;
   p:=k;
  Until k=st;
  j:=1;
  p1[j]:=st;
  i1:=st;
  Repeat
   i:=9-1;
   While mit[i,i1]=Mit[i-1,i1] do
     i:=i-1;
   j:=j+1;
   p1[j]:=p;
   i1:=p
  Until p=is;
  Write('Put: (',p1[j]);
  For i1:=j-1 downto 1 do
   Write(', ',p1[i1]);
  WriteLn(')');
readln;
End.


Смена знака с < на > не помогает.
Кто чем может...
1.9K
19 декабря 2009 года
andriano
474 / / 10.01.2008
Если кроме расстояний ничего не задано (напрмер, направлений ребер) задача в той постановке, что приведена, не решается, т.к. существуют циклические решения бесконечной длины.
Может, требуется найти в графе вершину самую удаленную от данной?
54K
19 декабря 2009 года
ulala
4 / / 18.12.2009
Нее... именно найти вершины лежащие на максимальном пути...:(
1.9K
19 декабря 2009 года
andriano
474 / / 10.01.2008
Ну нету в ненаправленном графе максимального пути. Какой бы мы ни взяли, всегда можно придумать еще длиннее.
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог