procedure TDerevo.Add; begin mat[i,j]:= r; mat[j,i]:= r; end;
procedure TForm1.Button1Click(Sender: TObject); begin stt:= stt+1; StringGrid1.RowCount:= st*(st-1); if (strtoint(Edit2.Text)<=st)and(strtoint(Edit3.Text)<=st)and(strtoint(Edit2.Text)<>strtoint(Edit3.Text)) then begin d.Add(strtoint(Edit2.Text),strtoint(Edit3.Text),strtofloat(Edit1.Text)); Image1.Canvas.MoveTo(mat2[strtoint(Edit2.Text),1],mat2[strtoint(Edit2.Text),2]); Image1.Canvas.LineTo(mat2[strtoint(Edit3.Text),1],mat2[strtoint(Edit3.Text),2]); StringGrid1.Cells[1,stt]:= Edit2.Text; StringGrid1.Cells[2,stt]:= Edit3.Text; StringGrid1.Cells[3,stt]:= Edit1.Text; end; end;
procedure TForm1.poisk(j: integer); var i,k: integer; boo: boolean; begin for i:= 1 to st do begin if (d.mat[j,i]=-1*(sch-1)) and (sch<>1) then begin for k:= 1 to st*st do begin if mark[k]=0 then begin boo:= false; mark[k]:= j; mark[k+1]:=i; break; end; if (mark[k]=i) then begin boo:= true; break; end; end; d.mat[j,i]:=0; if boo= false then poisk(i); end; if (d.mat[j,i]<>0)and(d.mat[j,i]>0) then if (b=0) or (b>d.mat[j,i]) then begin b:= d.mat[j,i]; i1:= i; j1:= j; {if (d.mat[j,i]<>-1*(sch-1)) or (sch=1) then break;} end; end; end;
procedure TForm1.al_boruvki; var i,k,j: integer; begin for i:= 1 to st*st do mark[i]:=0; k:=0; t:=1; i1:=0; j1:=0; b:=0; sch:=1; while true do begin for j:= 1 to st do begin for k:=1 to st*st do begin if (mark[k]=j)or((k=st*st)and(j=st)) then break; if mark[k]=0 then begin poisk(j); if d.mat[i1,j1]<>-1*sch then e:=e+d.mat[j1,i1]; d.mat[j1,i1]:= -1*sch; b:= 0; if (sch=1)and(j=1) then begin mat1[1,1]:=j1; mat1[1,2]:=i1; mat1[1,3]:=sch; end else begin for i:=1 to st*st do if mat1[i,1]<>0 then if ((mat1[i,1]=j1)and(mat1[i,2]=i1))or((mat1[i,1]=i1)and(mat1[i,2]=j1))then sch:= -1*sch else else break; mat1[i,1]:=j1; mat1[i,2]:=i1; mat1[i,3]:=abs(sch); if sch>0 then inc(t) else sch:= -1*sch; end; break; end; end; end; for i:= 1 to st do for j:= 1 to st do if d.mat[i,j]=-1*sch then if d.mat[j,i]<>-1*sch then d.mat[j,i]:=-1*sch; inc(sch); if t=st-1 then break; end; end;
Procedure TForm1.vivod_2; var i1,j1: integer; begin if sch1=0 then begin sch:= 1; sch1:=1; sr:=mat1[sch,3]; end; {while mat1[sch,3]=sr do} begin if sr=mat1[sch,3] then begin while mat1[sch,3]=sr do begin i1:=mat2[mat1[sch,1],1]-(mat2[mat1[sch,1],1]-mat2[mat1[sch,2],1])div 4; j1:=mat2[mat1[sch,1],2]-(mat2[mat1[sch,1],2]-mat2[mat1[sch,2],2])div 4; Image1.Canvas.Pen.Color:= clRed; Image1.Canvas.MoveTo(mat2[mat1[sch,1],1],mat2[mat1[sch,1],2]); Image1.Canvas.LineTo(i1,j1); inc(sch); end; end else begin {KeyPress(char(13));} {readkey;} while sr=mat1[sch1,3] do begin Image1.Canvas.Pen.Color:= clRed; Image1.Canvas.MoveTo(mat2[mat1[sch1,1],1],mat2[mat1[sch1,1],2]); Image1.Canvas.LineTo(mat2[mat1[sch1,2],1],mat2[mat1[sch1,2],2]); inc(sch1); end; sr:=mat1[sch,3]; {inc(sch);} {readkey;} {continue; } end; {inc(sch);} end; {if mat1[sch,3]=0 then begin sch:= sch-1; sch1:= sch; sr:= mat1[sch,3]; While sr=mat1[sch1,3] do begin Image1.Canvas.Pen.Color:= clRed; Image1.Canvas.MoveTo(mat2[mat1[sch1,1],1],mat2[mat1[sch1,1],2]); Image1.Canvas.LineTo(mat2[mat1[sch1,2],1],mat2[mat1[sch1,2],2]); dec(sch1); end; end; } end;
procedure TForm1.Button2Click(Sender: TObject); var i: integer; j: real; begin al_boruvki; Edit4.Text:= floattostr(e); end;
procedure TForm1.Button3Click(Sender: TObject); begin vivod_2; end;
procedure TForm1.FormCreate(Sender: TObject); begin stt:= 0; st:= 0; end;
end.
Как происходит поиск - на картинке, вся программа в архиве