Архив1 / docx53 / Отчет(2010)

Условие задачи:

Минимальное остовное дерево. Алгоритм Прима

Код:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, ExtCtrls, ToolWin, ComCtrls, ActnMan, ActnColorMaps,

ImgList, XPMan, StdCtrls, Grids;

type

TForm1 = class(TForm)

Image1: TImage;

ToolBar1: TToolBar;

ToolButton1: TToolButton;

ImageList1: TImageList;

ToolButton2: TToolButton;

StatusBar1: TStatusBar;

ToolButton3: TToolButton;

ToolButton4: TToolButton;

Panel1: TPanel;

StringGrid1: TStringGrid;

ToolButton5: TToolButton;

ToolButton6: TToolButton;

procedure ToolButton1Click(Sender: TObject);

procedure ToolButton2Click(Sender: TObject);

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ToolButton3Click(Sender: TObject);

procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ToolButton4Click(Sender: TObject);

procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);

procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;

const Value: String);

procedure ToolButton5Click(Sender: TObject);

procedure ToolButton6Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

rec = record

posx,posy : Integer;

end;

TVertex = Array of rec;

TMatrix = Array of array of integer;

const Radius = 30;

Diametr = 2*Radius;

var

Form1 : TForm1;

Vertex : TVertex;

Drawing : boolean = False;

FlagP : boolean = False;

FlagP2 : boolean = false;

nomP : integer;

A : TMatrix;

s : string; //Для остова

implementation

uses Math;

{$R *.dfm}

procedure DrawLine(Canvas: TCanvas; X1,Y1,X2,Y2, Text: Integer);

var

Angle: Extended;

b1x,b1y,b2x,b2y,L : integer;

begin

Angle:=ArcTan2(Y1-Y2,X2-X1);

b1x := X1+Round(Radius*Cos(Angle) );

b1y := Y1-Round(Radius*Sin(Angle) );

b2x := X2-Round(Radius*Cos(Angle) );

b2y := Y2+Round(Radius*Sin(Angle) );

L := Round( Sqrt(sqr(x1-x2) + sqr(y1-y2)) );

L := L div 2;

with Canvas do begin

MoveTo(b1x,b1y );

LineTo(b2x,b2y );

Brush.Color := clWhite;

TextOut(X1+ Round(L*cos(Angle) ), y1 - Round(L * Sin(Angle)), IntToStr(Text) );

end;

end;

procedure Prime(b : TMatrix; Var s : string);

Var SM,SP : set of 1..100;

min,i,j,l,t,L2 : integer;

begin

min := maxInt;

L2 := Length(b)-1;

SM := [1..L2];

SP := [];

l := 0;

t := 0;

S := '';

for i := 1 to L2-1 do

for j := i+1 to L2 do

if (a[i,j] < min) and (a[i,j] <> 0) then begin

min := a[i,j];

l := i;

t := j;

end;

SP := [l,t];

SM := SM - [l,t];

s := s+IntToStr(l) +'-'+IntToStr(t)+';';

While SM<>[] do begin

min := maxInt;

l := 0;

t := 0;

for i := 1 to L2 do

if not(i in SP) then

for j := 1 to L2 do

if (j in SP) and (a[i,j] < min) and (a[i,j] <>0) then begin

min := a[i,j];

l := i;

t := j;

end;

SP := SP + [l];

SM := SM - [l];

s := s+IntToStr(l) +'-'+ IntToStr(t)+';';

end;

end;

Procedure ClearHolst(Im : TImage);

begin

With Im.Canvas do begin

pen.Color := clBlack;

pen.Width := 1;

pen.Mode := pmCopy;

Brush.Color := clWhite;

Rectangle(0,0,Im.Width,im.Height);

end;

end;

procedure DrawEllipse(x,y : integer; Im : TImage; Color : TColor);

begin

with Im.Canvas do begin

pen.Color := clBlack;

pen.Width := 1;

if pen.Mode <> pmCopy then pen.Mode := pmCopy;

Brush.Color := Color;

Ellipse(x-Radius,y-Radius,x+Radius,y+Radius);

end;

end;

procedure DrawCarcas(s : string; Im : TImage);

var buf : String;

i,x1,x2 : integer;

begin

ClearHolst(Im);

With Im.Canvas do begin

TextOut(5,5,'Остов');

i := 0;

Repeat

inc(i);

buf := Copy(s,1,Pos(';',s) - 1);

Delete(S,1,Pos(';',S));

x1 := StrToInt( Copy(buf,1,Pos('-',buf)-1 ) ) - 1;

x2 := StrToInt( Copy(buf,Pos('-',buf)+ 1,Length(buf) ) ) - 1;

DrawEllipse(Vertex[x1].posx,Vertex[x1].posy, Im,clYellow);

DrawEllipse(Vertex[x2].posx,Vertex[x2].posy, Im,clYellow);

Im.Canvas.TextOut(Vertex[x1].posx,Vertex[x1].posy, IntToStr(x1 + 1) );

Im.Canvas.TextOut(Vertex[x2].posx,Vertex[x2].posy, IntToStr(x2 + 1) );

DrawLine(Im.Canvas,Vertex[x1].posx,Vertex[x1].posy, Vertex[x2].posx,Vertex[x2].posy , i);

until s = '';

end;

end;

procedure InitVertex(Var V : TVertex; n,MaxX,MaxY : integer);

var i : integer;

begin

SetLength(V,n);

Randomize;

for i := 0 to n - 1 do begin

V[i].posx := Radius + Random(maxX - Diametr);

V[i].posy := Radius + Random(maxY - Diametr);

end;

end;

procedure DrawVertex(V : TVertex;A : TMatrix ;Im : TImage);

var i,L,j : integer;

begin

ClearHolst(Im);

Im.Canvas.TextOut(5,5,'Граф');

L := length(V) - 1;

for i := 0 to L do begin

if V[i].posx = 0 then Continue;

DrawEllipse(V[i].posx,V[i].posy,Im,clSkyBlue);

Im.Canvas.TextOut(V[i].posx,V[i].posy,IntToStr(i+1));

end;

L := Length(A) - 1;

with Im.Canvas do

for i := 1 to L-1 do

for j := i to L do begin

if a[i,j] = 0 then Continue;

DrawLine(Im.Canvas,V[i-1].posx,V[i-1].posy, V[j-1].posx,V[j-1].posy,a[i,j]);

end;

end;

procedure DeleteInVertex(count : integer;var v : TVertex);

begin

V[count].posx := -500;

V[count].posy := -500;

end;

Function FindInVertexReturn(x,y : integer; V : TVertex;Var II : integer): boolean;

var n,i,Rast : integer;

begin

Result := false;

if v = nil then exit;

n := Length(V) - 1;

for i:= 0 to n do begin

Rast := Trunc( Sqrt(sqr(V[i].posx-x)+sqr(V[i].posy-y)) );

if Rast < Radius then begin

result := true;

II := i;

break;

end;

end;

end;

procedure InitStringGrid(Sg : TStringGrid; n : integer);

var i,j : integer;

begin

with SG do begin

ColCount := n + 1;

RowCount := n + 1;

cells[0,0] := 'X';

ColWidths[0] := 30;

for i := 1 to n do begin

cells[i,0] := 'X' + IntToStr(i);

cells[0,i] := 'X' + IntToStr(i);

ColWidths[i] := 30;

end;

For i := 1 to RowCount -1 do

for j := 1 to ColCount -1 do cells[i,j] := '0';

end;

end;

procedure AddToMatrix(Sg: TStringGrid;Var a : TMatrix);

var i,j,k : integer;

begin

k := 0;

with Sg do

for i := 1 to RowCount - 1 do

for j := 1 to ColCount - 1 do begin

if a[i,j] <> 0 then inc(k);

a[i,j] := StrToInt(cells[j,i] );

end;

Form1.StatusBar1.Panels[2].Text := 'Кол-во ребер = '+IntToStr(k div 2);

end;

procedure TForm1.ToolButton1Click(Sender: TObject);

var

value : string;

n : integer;

flag : boolean;

begin

flag := false;

repeat

if not InputQuery('Графы', 'Укажите количество вершин', value) then exit;

if (TryStrToInt(value,n)) and (n > 1) and (n < 100) then flag := true

else ShowMessage('Введите целое число и число больше 1 и меньше 100');

until flag;

StatusBar1.Panels[1].Text := 'Кол-во вершин = '+ IntToStr(n);

StatusBar1.Panels[2].Text := 'Кол-во ребер = 0';

InitVertex(Vertex,n, Image1.Width,Image1.Height);

InitStringGrid(StringGrid1,n);

SetLength(A,n+1,n+1);

DrawVertex(Vertex,A,Image1);

Drawing := true;

ToolButton3.Enabled := true;

ToolButton4.Enabled := true;

ToolButton5.Enabled := true;

end;

procedure TForm1.ToolButton2Click(Sender: TObject);

begin

FlagP := ToolButton2.Down;

StatusBar1.Panels[0].Text := '';

end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if not Drawing then exit;

If not FlagP then exit;

if not FindInVertexReturn(x,y,Vertex,nomP) then exit;

FlagP2 := true;

StatusBar1.Panels[0].Text := 'Вершина '+IntToStr(nomP + 1) + ' выбрана';

end;

procedure TForm1.ToolButton3Click(Sender: TObject);

begin

Drawing := ToolButton3.Down;

ToolButton2.Enabled := Drawing;

ToolButton5.Enabled := not Drawing;

if Drawing then begin

ToolButton4.Down := false;

Panel1.Visible := false;

end;

end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

if not Drawing then exit;

if FlagP then begin

DrawVertex(Vertex,A,Image1);

if FlagP2 then begin

DrawEllipse(x,y,Image1,clLime);

DeleteInVertex(nomP,Vertex);

Vertex[nomP].posx := x;

Vertex[nomP].posy := y;

end

else begin

if FindInVertexReturn(x,y,Vertex,nomP) then begin

StatusBar1.Panels[0].Text := 'Выделенная вершина '+IntToStr(nomP + 1);

DrawEllipse(Vertex[nomP].posx,Vertex[nomP].posy,Image1,ClRed);

end

else StatusBar1.Panels[0].Text := '';

end;

end;

end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if not Drawing then exit;

if FlagP then begin

if not FlagP2 then exit;

FlagP2 := false;

Vertex[nomP].posx := x;

Vertex[nomP].posy := y;

end;

end;

procedure TForm1.ToolButton4Click(Sender: TObject);

begin

Panel1.Visible := ToolButton4.Down;

if ToolButton3.Down then begin

ToolButton3.Down := false;

Drawing := ToolButton3.Down;

end;

if ToolButton2.Down then begin

ToolButton2.Down := false;

FlagP := false;

ToolButton5.Enabled := true;

end;

end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,

ARow: Integer; var CanSelect: Boolean);

begin

with StringGrid1 do begin

if(ARow = ACol) or (ARow > ACol) then begin

Options := Options-[goEditing];

end

else Options := Options+[goEditing];

end;

end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

const

clPaleRed = TColor($CCCCFF);

clPaleGreen = TColor($CCFFCC);

begin

with StringGrid1 do begin

if(ARow = ACol) and (ARow > 0) then begin

Canvas.Brush.color := clPaleRed;

canvas.fillRect(Rect);

canvas.TextOut(Rect.Left+2,Rect.Top+2,Cells[ACol,ARow]);

end;

if (aRow > ACol) and (aCol > 0) then begin

Canvas.Brush.color := clPaleGreen;

canvas.fillRect(Rect);

canvas.TextOut(Rect.Left+2,Rect.Top+2,Cells[ACol,ARow]);

end;

end;

end;

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);

begin

case key of

'0'..'9',#8 : ;

else key := Chr(0);

end;

end;

procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol,

ARow: Integer; const Value: String);

begin

if Value = '' then exit;

StringGrid1.Cells[ARow,ACol] := StringGrid1.cells[ACol,ARow];

AddToMatrix(StringGrid1,A);

DrawVertex(Vertex,A,Image1);

end;

procedure TForm1.ToolButton5Click(Sender: TObject);

begin

Prime(A,S);

DrawCarcas(s,Image1);

ToolButton6.Enabled := true;

end;

procedure TForm1.ToolButton6Click(Sender: TObject);

begin

If ToolButton6.Down then DrawVertex(Vertex,A,Image1)

else DrawCarcas(S,Image1);

end;

end.

Результат:

Блок схема: