IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

> Задача о минимальном остове на базе остовного леса, ? так
cooler
сообщение 28.12.2008 12:38
Сообщение #1


Бывалый
***

Группа: Пользователи
Сообщений: 178
Пол: Мужской

Репутация: -  0  +


Есть задача, можно ли сказать что она именно на базе остовного леса?
Она по алгоритму Крускала, а вот насчет леса...

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Grids;

type

   TDerevo = object
   mat: array[1..100] of array[1..100] of real;
   procedure Add(i,j: integer; r: real);
   end;

  TForm1 = class(TForm)
	Image1: TImage;
	Edit1: TEdit;
	Button1: TButton;
	Button2: TButton;
	Edit2: TEdit;
	Edit3: TEdit;
	Label1: TLabel;
	Label2: TLabel;
	Label3: TLabel;
	Button3: TButton;
	Edit4: TEdit;
	Label4: TLabel;
	StringGrid1: TStringGrid;
	procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
	  Shift: TShiftState; X, Y: Integer);
	procedure Button1Click(Sender: TObject);
	procedure Button2Click(Sender: TObject);
	procedure Button3Click(Sender: TObject);
	procedure FormCreate(Sender: TObject);
  private
	{ Private declarations }
  public
	{ Public declarations }
	d: TDerevo;
	st: integer;
	stt: integer;
	mat2: array[1..100] of array[1..2] of integer;
	i1,j1,sch,t: integer;
	b: real;
	e: real;
	sr,sch1: byte;
	mark: array[1..100] of integer;
	mat1: array[1..100] of array[1..3] of integer;
	procedure poisk(j: integer);
	procedure al_boruvki;
	procedure vivod_2;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Image1.Canvas.Ellipse(x-5,y-5,x+5,y+5);
st:= st+1;
Image1.Canvas.TextOut(x-20,y-10,inttostr(st));
mat2[st,1]:= x;
mat2[st,2]:= y;
end;

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.




Как происходит поиск - на картинке, вся программа в архиве


Эскизы прикрепленных изображений
Прикрепленное изображение

Прикрепленные файлы
Прикрепленный файл  _______.rar ( 198.55 килобайт ) Кол-во скачиваний: 149
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 28.07.2025 2:21
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"