Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на языке Pascal

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 2.943 RSS
←   Июнь 2010   →
 1
 2
 3
 4
04.06.2010
00:04:42
21:29:10
 5
 6
 7
 8
08.06.2010
00:18:54
23:04:16
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30


За последние 60 дней ни разу не выходила


Сайт рассылки: http://prog.rusfaq.ru/pascal
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

2.943 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на языке Pascal


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

lamed
Статус: Профессионал
Рейтинг: 2769
∙ повысить рейтинг » 		Boriss
Статус: Академик
Рейтинг: 2466
∙ повысить рейтинг » 		star9491
Статус: Профессионал
Рейтинг: 2322
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И ПО / Программирование / Pascal (Паскаль)

Номер выпуска:1113
Дата выхода:25.06.2010, 04:00
Администратор рассылки:Boriss, Академик
Подписчиков / экспертов:201 / 182
Вопросов / ответов:1 / 1

Вопрос № 179151: Здравствуйте, уважаемые эксперты. Нужна помощь в написании алгоритм Форда – Беллмана нахождения минимального пути. Заранее спасибо....

Вопрос № 179151:

Здравствуйте, уважаемые эксперты.
Нужна помощь в написании алгоритм Форда – Беллмана нахождения минимального пути.
Заранее спасибо.

Отправлен: 20.06.2010, 03:30
Вопрос задал: aller719, Посетитель
Всего ответов: 1
Страница вопроса »

Отвечает F®ost, Модератор :
Здравствуйте, aller719.
Алгоритм Форда-Беллмана:

Код:
program q179151;
var a:array[1..20,1..20] of word; {матрица смежности}
c,pred,fl,d:array[1..20] of word;{c - массив кратчайших расстояний; pred - массив
предыдущих вершин; fl - массив флагов; d - массив для записи пути}
i,j,k,n,first,last:byte;
f:text;{переменная для открытия in.txt}
 
{процедура обхода графа вглубь для поиска всех путей}
 
Procedure Dfs(x:word); {в качестве параметра передаём текущую вершину}
var i:byte; {локальная переменная}
begin
 if x=last then {если конечная вершина, то вводим путь}
  begin
   write(first,' ');
   for i:=1 to j do {выводим путь}
    wri
 te(d[i],' ');
    writeln;
    exit;{выходим из процедуры}
  end;
 fl[x]:=1; {помечаем что были в вершине}
 for i:=1 to n do {если не были в вершине и существует дуга в неё}
  if (fl[i]=0)and(a[x,i]<>32767) then
   begin
    inc(j);
    d[j]:=i; {записываем в путь вершину}
    dfs(i); 
    dec(j);
   end;
 fl[x]:=0; {помечаем что вершина свободна}
end;
 
{основная программа}
 
begin
     assign(f,'in.txt'); {открываем файл для чтения}

    reset(f);
     readln(f, n); {считываем количество вершин}
     for i:=1 to n do
          for j:=1 to n do
          read(f,a[i,j]); {считываем матрицу смежности}
     writeln('Mатрица:');
     for i:=1 to n do  {выводим матрицу на экран}
          for j:=1 to n do
           if j=n then writeln(a[i,j])
           else write(a[i,j],' ');
     for i:=1 to n do {заменяем нули бесконечностью}
          for j:=1 t
 o n do
          if a[i,j]=0 then a[i,j]:=32767;
     writeln('Введите 1 вершину: ');
     readln(first);
     writeln('Введите 2 вершину');
     readln(last);
     close(f); {закрываем файл in.txt}
     for j:=1 to n do
     begin
           c[j]:=a[first,j]; {записываем начальные значения}
           if a[first,j]<32767 then
           pred[j]:=first; {если существует дуга то записываем предыдущую вершину}
     end;
     for i:=3 to n do
      
  for j:=1 to n do
             if j<>first then
             for k:=1 to n do  {если не бесконечность и путь более выгодный}
                 if (c[k]<32767) and (c[k]+a[k,j]<c[j]) then
                  begin
                   c[j]:=c[k]+a[k,j]; {записываем новое значение}
                   pred[j]:=k; {записываем pred вершину}
                  end;
     if c[last]=32767 then writeln('Нет путей') 
     else {если бесконеч
 ность то нет пути}
      begin
          writeln;
          writeln('Кратчайший путь:');
          write(first,' ');
          i:=last;
          k:=1;
          while i<>first do {в обратном порядке обходим путь}
           begin
               d[k]:=i; {записываем путь в массив}
               k:=k+1;
               i:=pred[i];
           end;
          for i:=k-1 downto 1 do {выводим кратчайший путь}
          write(d[i],' ');
  
       writeln;
          writeln('Все пути:');
          j:=0;
          Dfs(first); {вызываем процедуру поиска всех путей}
      end;
     readln;
     readln;
end.

-----
От вопроса к ответу, от проблемы к решению

Ответ отправил: F®ost, Модератор
Ответ отправлен: 20.06.2010, 08:59
Номер ответа: 262184
Беларусь, Минск
Тел.: 375292792018
Организация: Минский Промтранспроект
Адрес: ул. В.Хоружей, 13, г. Минск, Беларусь
Адрес сайта: Минский Промтранспроект

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это!
Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 262184 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:

    • Оценить выпуск »
    Нам очень важно Ваше мнение об этом выпуске рассылки!

    Задать вопрос экспертам этой рассылки »

    Скажите "спасибо" эксперту, который помог Вам!

    Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    на короткий номер 1151 (Россия)
    Номер ответа и конкретный текст СМС указан внизу каждого ответа.

    Полный список номеров »

    * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи. (полный список тарифов)
    ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.

    © 2001-2010, Портал RFpro.ru, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Автор: Калашников О.А. | Программирование: Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2010.6.16 от 26.05.2010
    В избранное