Logo Море(!) аналитической информации!
IT-консалтинг Software Engineering Программирование СУБД Безопасность Internet Сети Операционные системы Hardware
Архив форумов ЦИТФорума
Море(!) вопросов - Море(!) ответов
 
 FAQFAQ   ПоискПоиск   ПользователиПользователи   ГруппыГруппы   РегистрацияРегистрация 
 ПрофильПрофиль   Войти и проверить личные сообщенияВойти и проверить личные сообщения   ВходВход 
Как правильно задавать вопросы

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

 
Перейти:  
Этот форум закрыт, вы не можете писать новые сообщения и редактировать старые.   Эта тема закрыта, вы не можете писать ответы и редактировать сообщения.    Список форумов Архив форумов ЦИТФорума -> Математика
Предыдущая тема :: Следующая тема  
Автор Сообщение
ulala



Зарегистрирован: 18.12.2009
Сообщения: 2

СообщениеДобавлено: Сб Дек 19 2009 20:17    Заголовок сообщения: 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.


Смена знака с < на > не помогает.
Кто чем может...
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
Показать сообщения:   
Этот форум закрыт, вы не можете писать новые сообщения и редактировать старые.   Эта тема закрыта, вы не можете писать ответы и редактировать сообщения.    Список форумов Архив форумов ЦИТФорума -> Математика Часовой пояс: GMT + 4
Страница 1 из 1

 
Перейти:  
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах


Powered by phpBB © 2001, 2002 phpBB Group
Русская поддержка phpBB

 

IT-консалтинг Software Engineering Программирование СУБД Безопасность Internet Сети Операционные системы Hardware

Информация для рекламодателей PR-акции, размещение рекламы — adv@citforum.ru,
тел. +7 495 6608306, ICQ 232284597
Пресс-релизы — pr@citforum.ru
Послать комментарий
Информация для авторов
This Web server launched on February 24, 1997
Copyright © 1997-2000 CIT, © 2001-2006 CIT Forum
Внимание! Любой из материалов, опубликованных на этом сервере, не может быть воспроизведен в какой бы то ни было форме и какими бы то ни было средствами без письменного разрешения владельцев авторских прав. Подробнее...