Algorytm Demoucrone'a

0

Czy ktos sie orientuje jak napisać ten algorytm?Nie znam się kompletnie na programowaniu a dostałem zadanie napisac program który będzie używał algorytmu Demoucrona do wyszukania drogi minimalnej w grafie.Jako dane dostalem macierz z wartościami dróg pomiędzy różnymi wierzchołkami i mam z tego obliczyc droge minimalnai koszt minimalny .
Bylbym bardzo wdzieczny za jakakolwiek pomoc.
Pozdrawiam

0

To chyba minąłeś się z powołaniem, bo teorię grafów wykłada się raczej na kierunkach typowo informatycznych i to zwykle nie na pierwszym roku :)

Tutaj masz opis w pseudokodzie:

http://www.cs.uvic.ca/~ruskey/Theses/WoodcockMScThesis.pdf

Strona 27 z 51.

0

To znowu ja powracam z tym problemem.Napisalem kod jednak nie dziala.Moglby mi ktos powiedziec co jest zle

var
  Form1: TForm1;
  LWierzch:integer;
  TabWejsciowa,TabWyjsciowa:array of array of integer;
  Ile_rownych:integer=0;
  param_k:integer=1;

const
  niesk:integer=100000;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Utwrz1Click(Sender: TObject);
begin
Form2.ShowModal;
end;
//*************************************************************
procedure TForm1.Zamknij1Click(Sender: TObject);
begin
Application.Terminate;
end;
//*************************************************************
procedure TForm1.WczytajPlik;
var
Plik:TextFile;
i,j:integer;
znak:String;
begin
AssignFile(Plik,'GRAF.txt');
Reset(Plik);
ReadLn(Plik,LWierzch);
SG2.RowCount:=LWierzch+1;
SG2.ColCount:=LWierzch+1;
  For j:=1 to SG2.ColCount-1 do
  For i:=1 to SG2.RowCount-1 do
  begin
    SG2.Cells[0,j]:=inttoStr(j);
    SG2.Cells[i,0]:=inttostr(i);
    ReadLn(Plik,znak);
    if znak<>'*' then
    SG2.Cells[i,j]:=znak
    else
    SG2.Cells[i,j]:=IntToStr(niesk);
  end;
  CloseFile(Plik);
  Label1.Caption:=inttostr(LWierzch);
 end;
//*************************************************************
procedure TForm1.Utworz_Tab_Wejsc;
var
i,j:integer;
begin
SetLength(TabWejsciowa,LWierzch,LWierzch);
for i:=0 to LWierzch-1 do
for j:=0 to LWierzch-1 do
begin
  TabWejsciowa[i,j]:=StrToInt(SG2.Cells[j+1,i+1]);
end;
end;

//*************************************************************

procedure TForm1.Wczytaj1Click(Sender: TObject);
begin
WczytajPlik;
Utworz_Tab_Wejsc;
Utworz_Tab_Wyjsc;
end;
//*************************************************************
procedure TForm1.Utworz_Tab_Wyjsc;
var
i,j:integer;
begin
  SetLength(TabWyjsciowa,LWierzch,LWierzch);
    for i:=0 to LWierzch-1 do
      for j:=0 to LWierzch-1 do
        begin
          TabWyjsciowa[i,j]:=0;
        end
end;
//*************************************************************
function Min_Tablic(k:integer):integer;
var
i,j,sum,el:integer;
lmin:integer;
begin
Min_Tablic:=0;
  for i:=0 to LWierzch-1 do
    for j:=0 to LWierzch-1 do
      begin
        sum:= TabWejsciowa[i,k]+TabWejsciowa[k,j];   <b>TU WYSKAKUJE BLAD</b>
        el:=TabWejsciowa[i,j];
        lmin:=min(sum,el);
        Min_Tablic:=lmin;
      end;
end;
//*************************************************************
procedure Utw_Tab_k;
var
i,j:integer;
begin
  for i:=0 to LWierzch-1 do
    for j:=0 to LWierzch-1 do
     begin
        TabWejsciowa[i,j]:=TabWyjsciowa[i,j];
     end;

end;
//*************************************************************
function Stop:boolean;
var
i,j,licznik:integer;
begin
  result:=False;
  licznik:=0;
  for i:=0 to LWierzch-1 do
    for j:=0 to LWierzch-1 do
      begin
       if TabWyjsciowa[i,j]<>TabWejsciowa[i,j] then Break
        else inc(licznik);

      end;

  if (licznik=LWierzch*LWierzch) then result:=True;
end;
//*************************************************************
procedure TForm1.Button1Click(Sender: TObject);
var
i,j,l:integer;
begin
l:=1;
repeat
Label4.Caption:=IntToStr(l);
for i:=0 to LWierzch-1 do
for j:=0 to LWierzch-1 do
begin
  TabWyjsciowa[i,j]:=Min_Tablic(param_k);
end;
Utw_Tab_k;
inc(param_k);
until
Stop=True;
end;

wydaje mi sie ze blad jest zwiazany z param_k ktory powinien sie zwiekszac o 1 przy kazdym tworzeniu nowej macierzy.Pomozcie PROSZE bo musze to na przyszly czwartek zrobic

1 użytkowników online, w tym zalogowanych: 0, gości: 1