Witam.
Mam problem z algorytmem węgierskim. Z wynikowej macierzy nie da się rozwikłać wyniku...
Postępuje zgodnie z tym schematem:
http://www.wikihow.com/Use-the-Hungarian-Algorithm
Moja macierz to macierz o stałym rozmiarze 10 na 10.
oto kod:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
ComCtrls, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
bt_losowe_liczby: TButton;
bt_wczytaj_plik: TButton;
bt_uruchom: TButton;
otworz_plik: TOpenDialog;
tb_nazwa_pliku: TEdit;
macierz: TStringGrid;
procedure bt_losowe_liczbyClick(Sender: TObject);
procedure bt_uruchomClick(Sender: TObject);
procedure bt_wczytaj_plikClick(Sender: TObject);
procedure aktualizuj_macierz();
procedure krok_1_odejmij();
function wykresl_zera():integer;
procedure krok_3_wynik();
procedure krok_4_najm();
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
tab_org: array[1..10,1..10] of integer;
tab_oper: array[1..10,1..10] of integer;
tab_zer: array[1..10,1..10] of integer;
tab_skr: array[1..10,1..10] of integer;
krok:integer=0;
implementation
{$R *.lfm}
{ TForm1 }
//------------------------------------------------------aktualizacja macierzy
procedure Tform1.aktualizuj_macierz();
var
w,k:integer;
begin
//wpisywanie z tablicy wartosci do macierzy
for w:=1 to 10 do begin
for k:=1 to 10 do
macierz.Cells[w,k]:=Inttostr(tab_oper[k,w]);
end;
end;
//-----------------------------------------------------------------------------
//-------------------------------------------------------------Szukanie minimum
function szukaj_min(nr:integer;rodzaj:string):integer;
var
w,k,min:integer;
begin
//szukanie min dla wiersza
if (rodzaj='wiersz') then
begin
min:=tab_oper[nr,1];
for k:=2 to 10 do
if (tab_oper[nr,k]<min) then min:=tab_oper[nr,k];
Result:=min;
Exit;
end
//szukanie min dla kolumny
else begin
min:=tab_oper[1,nr];
for w:=2 to 10 do
if (tab_oper[w,nr]<min) then min:=tab_oper[w,nr];
Result:=min;
Exit;
end;
end;
//-----------------------------------------------------------------------------
//-------------------------------------------------------------Szukanie minimum
procedure Tform1.krok_4_najm();
var
w,k,min:integer;
begin
//szukanie najmniejszego nieskreslonego elemntu macieerzy
min:=200;
for w:=1 to 10 do begin
for k:=1 to 10 do
if (tab_oper[w,k]<min) and (tab_skr[w,k]=0) then min:=tab_oper[w,k];
end;
//dodawanie min do skreslonych elementow
for w:=1 to 10 do begin
for k:=1 to 10 do begin
if (tab_skr[w,k]=2) then tab_oper[w,k]:=tab_oper[w,k]+min;
end;
end;
//odejmowanie od kazdego nieskreslonego
for w:=1 to 10 do begin
for k:=1 to 10 do
if (tab_skr[w,k]=0) then tab_oper[w,k]:=tab_oper[w,k]-min;
end;
//aktualizacja tablicy zer
for w:=1 to 10 do begin
for k:=1 to 10 do
if (tab_oper[w,k]=0) then tab_zer[w,k]:=1 else tab_zer[w,k]:=0;
end;
ShowMessage('min to '+inttostr(min));
//aktualizacja macierzy
aktualizuj_macierz();
//aktualizacja kroku
krok:=1;
end;
//-----------------------------------------------------------------------------
function Tform1.wykresl_zera():integer;
var
tab_ile_zer:array[1..20] of integer;
w,k,i,max,max_poz,ls:integer;
begin
ls:=0;
//zerowanie tablicy
for i:=1 to 20 do
tab_ile_zer[i]:=0;
//zerowanie tablicy skreslen
for w:=1 to 10 do begin
for k:=1 to 10 do tab_skr[w,k]:=0;
end;
//sumowanie zer i zapis w tablicy
for w:=1 to 10 do begin
for k:=1 to 10 do begin
tab_ile_zer[w]:=tab_ile_zer[w]+tab_zer[w,k];
tab_ile_zer[k+10]:=tab_ile_zer[k+10]+tab_zer[w,k];
end;
end;
//wyswietlenie liczby zer
for i:=1 to 20 do begin
if (i<11) then macierz.Cells[0,i]:=IntToStr(tab_ile_zer[i])
else macierz.Cells[i-10,0]:=IntToStr(tab_ile_zer[i])
end;
//wykreslanie zer
while (max>0) do begin
//szukanie max
max:=tab_ile_zer[1];
max_poz:=1;
for i:=2 to 20 do begin
if (tab_ile_zer[i]>max) then begin
max:=tab_ile_zer[i];
max_poz:=i;
end;
end;
//akutalizacja
if (max_poz<11) and (max>0) then begin
//zerowanie liczby zer
tab_ile_zer[max_poz]:=0;
//wstawienie x do macierzy
macierz.Cells[0,max_poz]:='x';
Inc(ls);
//aktualizacja kolumn
for i:=1 to 10 do begin
//aktualizacja tablicy skreslen
tab_skr[max_poz,i]:=tab_skr[max_poz,i]+1;
if (tab_zer[max_poz,i]=1) and (tab_ile_zer[i+10]>0) then begin
tab_ile_zer[i+10]:=tab_ile_zer[i+10]-1;
macierz.Cells[i,0]:=IntToStr(tab_ile_zer[i+10]);
end;
end;
end else if (max>0) then begin
//zerowanie liczby zer
tab_ile_zer[max_poz]:=0;
//wstawienie x do macierzy
macierz.Cells[max_poz-10,0]:='x';
Inc(ls);
//aktualizacja wierszy
for i:=1 to 10 do begin
//aktualizacja tablicy skreslen
tab_skr[i,max_poz-10]:=tab_skr[i,max_poz-10]+1;
if (tab_zer[i,max_poz-10]=1) and (tab_ile_zer[i]>0) then begin
tab_ile_zer[i]:=tab_ile_zer[i]-1;
macierz.Cells[0,i]:=IntToStr(tab_ile_zer[i]);
end;
end;
end;
end;
ShowMessage('Wykreslenia: ' +inttostr(ls));
//aktualizacja kroku
if (ls=10) then krok:=2 else krok:=3;
end;
//----------------------------------------------------krok pierwszy odejmowanie
procedure Tform1.krok_3_wynik();
var
w,k:integer;
tab_wie:array[1..10] of integer;
begin
//zerowanie tablicy
for w:=1 to 10 do tab_wie[w]:=0;
//zliczanie liczby zer
for w:=1 to 10 do begin
for k:=1 to 10 do
tab_wie[w]:=tab_wie[w]+tab_zer[w,k];
end;
w:=1;
// while (w<=10) do begin
// if (tab_wie[w]=1) then begin
// end;
// end;
for w:=1 to 10 do begin
for k:=1 to 10 do
macierz.Cells[w,k]:=Inttostr(tab_zer[k,w]);
end;
//aktualizacja kroku
krok:=-1;
end;
//------------------------------------------------------------------------------
//----------------------------------------------------krok pierwszy odejmowanie
procedure Tform1.krok_1_odejmij();
var
w,k,min:integer;
begin
for w:=1 to 10 do begin
//szukanie min
min:=szukaj_min(w,'wiersz');
//odejmowanie min od kazdej wartosci w wierszu
for k:=1 to 10 do begin
tab_oper[w,k]:=tab_oper[w,k]-min;
if tab_oper[w,k]=0 then tab_zer[w,k]:=1 else tab_zer[w,k]:=0;
end;
end;
//odejmowanie dla kazdej wartosci w kolumnie
for k:=1 to 10 do begin
//szukanie min
min:=szukaj_min(k,'kolumna');
for w:=1 to 10 do begin
tab_oper[w,k]:=tab_oper[w,k]-min;
if tab_oper[w,k]=0 then tab_zer[w,k]:=1;
end;
end;
//aktualizacja macierzy
aktualizuj_macierz();
//aktualizacja kroku
krok:=1;
end;
//-----------------------------------------------------------------------------
//------------------------------------------------------------Losowanie wartosci
procedure TForm1.bt_losowe_liczbyClick(Sender: TObject);
var
liczba_los,j,i:integer;
begin
//generowanie liczb losowych macierza
for i:=0 to 10 do
begin
macierz.Cells[i,0]:='p '+IntToStr(i);
for j:=1 to 10 do
begin
if (i=0) then macierz.Cells[i,j]:='os '+IntToStr(j)
else
//wprowadzanie do tablicy i to kontrolki
begin
liczba_los:=Random(201);
tab_org[i][j]:=liczba_los;
tab_oper[i][j]:=liczba_los;
macierz.Cells[j,i]:=IntToStr(liczba_los);
end;
end;
end;
//zerowanie komorki 0,0
macierz.Cells[0,0]:='';
//wyswietlenie informacjie
bt_uruchom.Enabled:=True;
end;
procedure TForm1.bt_uruchomClick(Sender: TObject);
begin
while (krok<>-1) do begin
ShowMessage('Teraz wykonam krok nr. '+inttostr(krok+1));
case krok of
0:krok_1_odejmij();
1:wykresl_zera();
2:krok_3_wynik();
3:krok_4_najm();
end;
end;
end;
//---------------------------------------------------wczytaywanie danych z pliku
procedure TForm1.bt_wczytaj_plikClick(Sender: TObject);
var
i,j,z:integer;
plik:TextFile;
linia: string;
begin
j:=0;
//sprawdzanie czy wybrany zostal plik
if (otworz_plik.Execute) then
begin
//update textboxa
tb_nazwa_pliku.Text:=otworz_plik.FileName;
//skojarzenie pliku i otwarcie
AssignFile(plik,otworz_plik.FileName);
Reset(plik);
//odczyt linia po lini
while not eof(plik) do begin
Inc(j);
ReadLn(plik,linia);
i:=1;
for z:=1 to Length(linia) do
begin
if (linia[z]<>Chr(9)) then
macierz.Cells[i,j]:=macierz.Cells[i,j]+linia[z]
else
Inc(i);
end;
end;
//zamykanie pliku
CloseFile(plik);
//wczytywanie dancych do tablic
for i:=1 to 10 do begin
for j:=1 to 10 do begin
tab_oper[i,j]:=Strtoint(macierz.Cells[j,i])
end;
end;
bt_uruchom.Enabled:=True;
end;
end;
//------------------------------------------------------------------------------
end.
1.) wykreślanie robię na tej zasadzie że wprowadzam liczbę zer do tablicy i następnie skreślam te z największą ilością zer. Czy to jest poprawnie?
2.) Może macie jakiś gotowy kod w pascalu którym mogę się zainspirować.
Gdy liczba skreśleń jest równa 10 otrzymuje taką macierz.
0 0 0 0 0 0 0 1 0 1
0 1 0 0 0 0 0 0 1 0
1 0 0 0 0 0 0 1 0 0
0 0 1 0 0 0 0 0 0 0
0 0 0 1 0 0 0 0 0 0
0 0 0 0 1 0 0 0 0 1
1 0 0 0 1 0 0 0 0 0
0 0 0 0 1 0 0 0 0 0
0 0 0 0 0 0 1 0 0 0
0 0 0 1 0 1 0 0 0 0
W drugim wierszu występuje konfilkt i nie da się rozstrzygnąć przydziału. Sprawdzałem to 20 razy i dalej nic...