algorytm.org

Implementacja w Delphi/Pascal

Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Algorytm Forda-Bellmana - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 3
SłabyŚwietny
Nadesłany przez Michał Knasiecki, 09 sierpnia 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.
Pobierz pełne rozwiązanie.

Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.

ford_d/Unit1.pas:
//Program pobrany ze strony www.algorytm.org
//Algorytm Forda-Bellmana
//Opracowal Michal Knasiecki
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,math;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  plik:textfile;
  n:integer=0;//liczba wierzchołków w grafie
  D:array[1..100] of integer;//Wektor odległości od wierzchołka 1 do pozostałych
  A:array[1..100,1..100]of integer;//Macierz wag krawędzi
  TMP:integer;
const
  nieskonczonosc=100000;
  
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
s:string;
i,j:integer;
begin
if opendialog1.execute then
        begin
        assignfile(plik,opendialog1.filename);
        reset(plik);
        readln(plik,n);
        for j:=1 to n do
        for i:=1 to n do
                begin
                readln(plik,s);
                if s<>'*' then
                A[j,i]:=strtoint(s) else A[j,i]:=nieskonczonosc;
                end;
        closefile(plik);
        memo1.lines.add('Liczba wierzchołków: '+inttostr(n));
        end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i,j:integer;
k:integer;
begin
if n=0 then showmessage('Musisz wczytać graf z pliku!') else
        begin
//Przyjmujemy, że s=1, szukamy więc najkrótszych dróg od wierzchołka 1 do pozostałych
        for i:=1 to n do D[i]:=A[1,i];
        for k:=1 to n-2 do
                begin
                for i:=2 to n do //Pomijamy pierwszy wierzchołek, gdyż D(1)=0
                	for j:=1 to n do
				begin
				if (D[j]+A[j][i]>nieskonczonosc) then
		               	TMP:=nieskonczonosc else
                		TMP:=D[j]+A[j][i];
                		D[i]:=min(D[i],TMP);
				end;
                end;
        for i:=1 to n do
        if D[i]<nieskonczonosc then
        memo1.lines.add('D('+inttostr(i)+')='+inttostr(D[i]))else //wypisujemy wynik
        memo1.lines.add('D('+inttostr(i)+')='+'*')
        end;
end;

end.
Dodaj komentarz