Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.12.2009, 19:08   #1
ulala
Пользователь
 
Аватар для ulala
 
Регистрация: 18.09.2009
Сообщений: 62
Стрелка TurboPascal: всего лишь сменить min на max, но всё не так-то просто...

Доброго времени суток
Задание:
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[i]:=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[i],i1]<>0
    Then If MIt[i-1,i1]<Mit[i,p[i]]+S[p[i],i1]
	 Then Mit[i,i1]:=Mit[i-1,i1]
	 Else Mit[i,i1]:=Mit[i,p[i]]+S[p[i],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[i]:=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[i];
   i1:=p[i]
  Until p[i]=is;
  Write('Put: (',p1[j]);
  For i1:=j-1 downto 1 do
   Write(', ',p1[i1]);
  WriteLn(')');
readln;
End.
Смена знака с < на > не помогает.
Кто чем может...
Вложения
Тип файла: zip MMMMMMMM.zip (1.1 Кб, 6 просмотров)
Ну,как?.. Твоё коллективное сознание уловило Message или ты по-прежнему считаешь себя Избранным?..
ulala вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Задача на min и max KREGI Помощь студентам 14 14.01.2016 14:35
из Excel в OutLook (не всё так просто...) Koddo Microsoft Office Excel 8 19.01.2011 14:34
нужно всего лишь подправить! Татяна Паскаль, Turbo Pascal, PascalABC.NET 6 20.05.2009 21:17
Обработка события Updated не всего листа, а лишь одной ячейки neugadal Microsoft Office Excel 7 20.07.2008 18:18
Не всё так просто с кусором! TCursor и Aslan Общие вопросы Delphi 1 11.07.2007 18:31