Студопедия Главная Случайная страница Задать вопрос

Разделы: Автомобили Астрономия Биология География Дом и сад Другие языки Другое Информатика История Культура Литература Логика Математика Медицина Металлургия Механика Образование Охрана труда Педагогика Политика Право Психология Религия Риторика Социология Спорт Строительство Технология Туризм Физика Философия Финансы Химия Черчение Экология Экономика Электроника

Поиск минимальной суммы длин отрезков




 

Данная задача является классическим примером динамического программирования. Полный перебор, как легко доказать, требует экспоненциального времени, что для алгоритма не есть хорошо, применение же динамического программирования упрощает эту задачу и как далее будет видно сложность этого алгоритма есть O(x^3).

Изобразим работу алгоритма графически:

 

 

Рис. 1

 

 

Код процедуры, реализующей данный алгоритм:

 

procedure FindLines;

Var

i,j,start: integer;

P,P2,PMin,Pz: PPnt;

Min,Sum: double;

begin

for start:= 0 to pList.Count-1 do

begin

Sum:=0;

tmpList.Clear;

 

for i:= 0 to pList.Count-1 do

begin

Pz := pList.Items[i];

New(P);

P^.X :=Pz.X ;

P^.Y :=Pz.Y;

P^.rColor :=Pz.rColor;

P^.Linked := Pz.Linked;

P^.Num := Pz.Num;

tmpList.Add(P);

end;

 

for i:= start to tmpList.Count-2 do

begin

P := tmpList.Items[i];

if not P^.Linked then

begin

Min := MaxInt;

for j := 0 to tmpList.Count - 1 do

if i<>j then

begin

P2 := tmpList.Items[j];

if (not P2^.Linked) and (P2^.rColor <> P^.rColor) then

begin

if sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y)) < Min then

begin

Min := sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y));

PMin := P2;

end;

end;

end;

Sum:=Sum+Min;

P^.Linked := True;

PMin^.Linked := True;

PMin^.Num := P^.Num;

end;

end;

 

for i := 0 to start-1 do

begin

P := tmpList.Items[i];

if not P^.Linked then

begin

Min := MaxInt;

for j := 0 to tmpList.Count - 1 do

if i<>j then

begin

P2 := tmpList.Items[j];

if (not P2^.Linked) and (P2^.rColor <> P^.rColor) then

begin

if sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y)) < Min then

begin

Min := sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y));

PMin := P2;

end;

end;

end;

 

Sum:=Sum+Min;

P^.Linked := True;

PMin^.Linked := True;

PMin^.Num := P^.Num;

end;

end;

 

if start=0 then

begin

minsum:=sum;

oList.Clear;

for i:= 0 to tmpList.Count-1 do

begin

Pz := tmpList.Items[i];

New(P);

P^.X :=Pz.X ;

P^.Y :=Pz.Y;

P^.rColor :=Pz.rColor;

P^.Linked := Pz.Linked;

P^.Num := Pz.Num;

oList.Add(P);

end;

end

else if sum<minsum then

begin

minsum:=sum;

oList.Clear;

 

for i:= 0 to tmpList.Count-1 do

begin

Pz := tmpList.Items[i];

New(P);

P^.X :=Pz.X ;

P^.Y :=Pz.Y;

P^.rColor :=Pz.rColor;

P^.Linked := Pz.Linked;

P^.Num := Pz.Num;

oList.Add(P);

end;

end;

end;

 

pList.Clear;

for i:= 0 to oList.Count-1 do

begin

Pz := oList.Items[i];

New(P);

P^.X :=Pz.X ;

P^.Y :=Pz.Y;

P^.rColor :=Pz.rColor;

P^.Linked := Pz.Linked;

P^.Num := Pz.Num;

pList.Add(P);

end;

 

Form1.Label3.Caption := 'Минимальная сумма отрезков: ' + FloatToStr(minSum);

end;

 

Данный алгоритм содержит несколько циклов: один глобальный цикл и два вложенных, которые в свою очередь включают в себя ещё по одному вложенному циклу. Параметром для внешнего глобального цикла является переменная start, которая делит данный список как бы на два сегмента. Потом внутренние циклы последовательно перебирают переменные в первом и втором сегментах. Данные переменные берутся в предположении, что они являются началом отрезка, а концы отрезков перебираются ещё одним циклом по всему списку. В итоге складывается картина того, что начала отрезков берутся в разных сегментах, размеры которых меняются в процессе прогона глобального цикла, а концы – из всего списка. Данный способ перебора элементов позволяет перебрать все отрезки, выбрать из них минимальные и найти их минимальные суммы. Суммирование в предварительную минимальную сумму для каждого набора отрезков происходит, если расстояние от данной точки (начала отрезка) до перебираемой точки (конца отрезка) меньше, чем расстояния от данной точки до всех остальных. В итоге мы получаем суммы длин наборов отрезков, из которых запоминаем в свою очередь минимальную сумму.

Ниже приведена общая блок-схема алгоритма:

 

 

 


 

4.Резюме.

4.1. Выводы.

В результате выполнения курсового проекта была создана программа решения задачи о красных и синих точках, которая вполне нормально работает, и сильных отклонений нет.

К достоинствам программы можно отнести:

- простой интерфейс без излишних сложностей;

- процесс работы программы визуализируется;

К недостаткам можно отнести следующее:

- невозможность более детального анализа алгоритма;

4.2. Возможные модернизации.

1. Доработать программу и дать возможность пользователю более детального анализа алгоритма.

 

 

5. Литература.

1. Т. Кормен, Ч. Лейзерсон, Р. Ривест «Алгоритмы: построение и анализ».

2. В.В. Фаронов «Delphi – программирование на языке высокого уровня».

3. Ю.С. Избачков, В.Н. Петров «Информационные системы», второе издание


6. Приложение

6.1. Текст программы.

unit Unit1;

 

interface

 

uses

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

Dialogs, ComCtrls, Menus, ToolWin, ExtCtrls, StdCtrls, ImgList, Grids,

ValEdit, ShellAPI;

 

type

TForm1 = class(TForm)

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

Panel1: TPanel;

ToolBar1: TToolBar;

ToolButton1: TToolButton;

ToolButton2: TToolButton;

Image1: TImage;

Button1: TButton;

Button2: TButton;

ImageList1: TImageList;

ToolButton3: TToolButton;

N3: TMenuItem;

N4: TMenuItem;

ScrollBox1: TScrollBox;

Image2: TImage;

GroupBox1: TGroupBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Button3: TButton;

StringGrid1: TStringGrid;

Panel2: TPanel;

procedure ToolButton1Click(Sender: TObject);

procedure ToolButton3Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ToolButton2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure N3Click(Sender: TObject);

 

 

private

{ Private declarations }

public

{ Public declarations }

end;

 

PPnt = ^TPnt;

TPnt = record

X,Y: integer;

rColor: byte;

num: integer;

Linked: boolean;

end;

 

 

var

Form1: TForm1;

rColor: byte;

 

pList, tmpList, oList, rList: TList;

tCount, redCount, blueCount: integer;

cWidth, cHeight: integer;

minSum: double;

start_sh: integer;

i_1, j_1, i_2, j_2: integer;

 

i,j, start: integer;

P,P2,PMin,Pz: PPnt;

Min,Sum: double;

x,y: integer;

fl:Boolean;

i_col,ip1,ip2:integer;

 

implementation

 

{$R *.dfm}

 

procedure ClearGrid;

Var rRect: TRect;

begin

rRect.Left := cWidth + 1;

rRect.Right := Form1.Image2.Width;

rRect.Top := 0;

rRect.Bottom := Form1.Image2.Height;

 

Form1.Image2.Canvas.Brush.Color := clWhite;

Form1.Image2.Canvas.FillRect(rREct);

end;

 

 

procedure FindLines;

Var

i,j,start: integer;

P,P2,PMin,Pz: PPnt;

Min,Sum: double;

begin

for start:= 0 to pList.Count-1 do

begin

Sum:=0;

tmpList.Clear;

 

for i:= 0 to pList.Count-1 do

begin

Pz := pList.Items[i];

New(P);

P^.X :=Pz.X ;

P^.Y :=Pz.Y;

P^.rColor :=Pz.rColor;

P^.Linked := Pz.Linked;

P^.Num := Pz.Num;

tmpList.Add(P);

end;

 

for i:= start to tmpList.Count-2 do

begin

P := tmpList.Items[i];

if not P^.Linked then

begin

Min := MaxInt;

for j := 0 to tmpList.Count - 1 do

if i<>j then

begin

P2 := tmpList.Items[j];

if (not P2^.Linked) and (P2^.rColor <> P^.rColor) then

begin

if sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y)) < Min then

begin

Min := sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y));

PMin := P2;

end;

end;

end;

 

Sum:=Sum+Min;

P^.Linked := True;

PMin^.Linked := True;

PMin^.Num := P^.Num;

end;

end;

 

for i := 0 to start-1 do

begin

P := tmpList.Items[i];

if not P^.Linked then

begin

Min := MaxInt;

for j := 0 to tmpList.Count - 1 do

if i<>j then

begin

P2 := tmpList.Items[j];

if (not P2^.Linked) and (P2^.rColor <> P^.rColor) then

begin

if sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y)) < Min then

begin

Min := sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y));

PMin := P2;

end;

end;

end;

 

Sum:=Sum+Min;

P^.Linked := True;

PMin^.Linked := True;

PMin^.Num := P^.Num;

end;

end;

 

if start=0 then

begin

minsum:=sum;

oList.Clear;

 

for i:= 0 to tmpList.Count-1 do

begin

Pz := tmpList.Items[i];

New(P);

P^.X :=Pz.X ;

P^.Y :=Pz.Y;

P^.rColor :=Pz.rColor;

P^.Linked := Pz.Linked;

P^.Num := Pz.Num;

oList.Add(P);

end;

end

else if sum<minsum then

begin

minsum:=sum;

oList.Clear;

 

for i:= 0 to tmpList.Count-1 do

begin

Pz := tmpList.Items[i];

New(P);

P^.X :=Pz.X ;

P^.Y :=Pz.Y;

P^.rColor :=Pz.rColor;

P^.Linked := Pz.Linked;

P^.Num := Pz.Num;

oList.Add(P);

end;

end;

end;

 

pList.Clear;

 

for i:= 0 to oList.Count-1 do

begin

Pz := oList.Items[i];

New(P);

P^.X :=Pz.X ;

P^.Y :=Pz.Y;

P^.rColor :=Pz.rColor;

P^.Linked := Pz.Linked;

P^.Num := Pz.Num;

pList.Add(P);

end;

 

Form1.Label3.Caption := 'Минимальная сумма отрезков: ' + FloatToStr(minSum);

 

end;

 

procedure DrawGrid(vList: TList);

Var i,j: integer;

rREct: TRect;

p: PPnt;

begin

for j:=1 to vList.Count do

begin

 

Form1.Image2.Canvas.Pen.Color := clBlack;

 

rRect.Left := cWidth * j;

rRect.Top := 0;

rRect.Right := cWidth * (j+1);

rRect.Bottom := cHeight;

 

 

Form1.Image2.Canvas.FillRect(rRect);

 

Form1.Image2.Canvas.Brush.Color := clInactiveCaption;

Form1.Image2.Canvas.FillRect(rRect);

Form1.Image2.Canvas.Font.Style := [fsBold];

Form1.Image2.Canvas.TextOut(j * cWidth + round(cWidth/2)-3, 1, IntToStr(j));

 

 

for i:=0 to 5 do

begin

Form1.Image2.Canvas.MoveTo(cWidth*j, i*cHeight);

Form1.Image2.Canvas.LineTo(cWidth*(j + 1), i*cHeight);

end;

 

for i:= j to j + 1 do

begin

Form1.Image2.Canvas.MoveTo(i*cWidth,0);

Form1.Image2.Canvas.LineTo(i*cWidth,cHeight*5 + 1);

end;

 

 

Form1.Image2.Canvas.Font.Style := [];

Form1.Image2.Canvas.Brush.Color := clWhite;

 

p := vList.Items[j-1];

 

Form1.Image2.Canvas.TextOut((j+1)*cWidth - round(cWidth/2) - 8, cHeight + 1, IntToStr(p^.X));

Form1.Image2.Canvas.TextOut((j+1)*cWidth - round(cWidth/2) - 8, 2*cHeight + 1, IntToStr(p^.Y));

 

 

Form1.Image2.Canvas.TextOut((j+1)*cWidth - round(cWidth/2) - 2, 3*cHeight + 1, IntToStr(p^.num));

 

 

if p^.rColor = 1 then

begin

rRect.Left := cWidth * j + 1;

rRect.Top := cHeight * 4 + 1;

rRect.Right := cWidth * (j+1);

rRect.Bottom := cHeight*5;

 

Form1.Image2.Canvas.Brush.Color := clRed;

Form1.Image2.Canvas.FillRect(rRect);

end;

 

if p^.rColor = 2 then

begin

rRect.Left := cWidth * j + 1;

rRect.Top := cHeight * 4 + 1;

rRect.Right := cWidth * (j+1);

rRect.Bottom := cHeight*5;

 

Form1.Image2.Canvas.Brush.Color := clBlue;

Form1.Image2.Canvas.FillRect(rRect);

end;

 

 

end;

 

end;

 

 

procedure DeletePoints(vList: TList);

Var p: PPnt;

begin

while vList.Count > 0 do

begin

P := vList.Items[0];

Dispose(P);

vList.Delete(0);

end;

 

tCount := 0;

RedCount := 0;

BlueCount := 0;

 

end;

 

procedure DrawPoints(vList: TList);

Var i,j: integer;

p, p2: PPnt;

begin

for i := 0 to vList.Count-1 do

begin

 

p:= vList.Items[i];

 

if p^.rColor = 1 then

Form1.Image1.Canvas.Brush.Color := clRed;

 

if p^.rColor = 2 then

Form1.Image1.Canvas.Brush.Color := clBlue;

 

Form1.Image1.Canvas.Pen.Color := clBlack;

Form1.Image1.Canvas.Ellipse(p^.X-4,p^.Y-4,p^.X+4,p^.Y+4);

Form1.Image1.Canvas.Brush.Color := clWhite;

Form1.Image1.Canvas.TextOut(p^.X-20, p^.Y-5, IntToStr(i+1));

 

for j:=i+1 to vList.Count - 1 do

begin

p2 := vList.Items[j];

if p^.num = p2^.num then

begin

Form1.Image1.Canvas.MoveTo(p^.X, p^.Y);

if p^.rColor = 1 then Form1.Image1.Canvas.Pen.Color := clRed;

if p^.rColor = 2 then Form1.Image1.Canvas.Pen.Color := clBlue;

Form1.Image1.Canvas.LineTo(round((P^.X+P2^.X)/2),round((P^.Y+P2^.Y)/2));

if p2^.rColor = 1 then Form1.Image1.Canvas.Pen.Color := clRed;

if p2^.rColor = 2 then Form1.Image1.Canvas.Pen.Color := clBlue;

Form1.Image1.Canvas.LineTo(P2^.X,P2^.Y);

end;

end;

end;

end;

 

procedure AddDrawPoint(vList: TList; X,Y: integer);

Var p: PPnt;

begin

Inc(tCount);

Form1.Image1.Canvas.Pen.Color := clBlack;

if rColor = 1 then

begin

 

Inc(RedCount);

 

Form1.Image1.Canvas.Brush.Color := clRed;

Form1.Image1.Canvas.Ellipse(X-4,Y-4,X+4,Y+4);

 

Form1.Image1.Canvas.Brush.Color := clWhite;

Form1.Image1.Canvas.TextOut(X-20, Y-5, IntToStr(tCount));

 

New(p);

p^.X := X;

p^.Y := Y;

p^.rColor := 1;

p^.Linked := false;

p^.num := tCount;

pList.Add(p);

end;

if rColor = 2 then

begin

Inc(BlueCount);

Form1.Image1.Canvas.Brush.Color := clBlue;

Form1.Image1.Canvas.Ellipse(X-4,Y-4,X+4,Y+4);

Form1.Image1.Canvas.Brush.Color := clWhite;

Form1.Image1.Canvas.TextOut(X-20, Y-5, IntToStr(tCount));

New(p);

p^.X := X;

p^.Y := Y;

p^.rColor := 2;

p^.Linked := false;

p^.num := tCount;

pList.Add(p);

end;

end;

 

procedure AddGridPoint(vList: TList);

Var rRect: TRect;

i: integer;

p: PPnt;

begin

 

if rColor = 0 then exit;

 

cWidth := 50;

cHeight := 15;

 

 

rRect.Left := cWidth * vList.Count;

rRect.Top := 0;

rRect.Right := cWidth * (vList.Count+1);

rRect.Bottom := cHeight;

 

 

Form1.Image2.Canvas.FillRect(rRect);

 

Form1.Image2.Canvas.Brush.Color := clInactiveCaption;

Form1.Image2.Canvas.FillRect(rRect);

Form1.Image2.Canvas.Font.Style := [fsBold];

Form1.Image2.Canvas.TextOut(vList.Count * cWidth + round(cWidth/2)-3, 1, IntToStr(vList.Count));

 

 

for i:=0 to 5 do

begin

Form1.Image2.Canvas.MoveTo(cWidth*vList.Count, i*cHeight);

Form1.Image2.Canvas.LineTo(cWidth*(vList.Count + 1), i*cHeight);

end;

 

for i:= pList.Count to pList.Count + 1 do

begin

Form1.Image2.Canvas.MoveTo(i*cWidth,0);

Form1.Image2.Canvas.LineTo(i*cWidth,cHeight*5 + 1);

end;

 

 

Form1.Image2.Canvas.Font.Style := [];

Form1.Image2.Canvas.Brush.Color := clWhite;

 

p := vList.Items[vList.Count-1];

 

Form1.Image2.Canvas.TextOut((vList.Count+1)*cWidth - round(cWidth/2) - 8, cHeight + 1, IntToStr(p^.X));

Form1.Image2.Canvas.TextOut((vList.Count+1)*cWidth - round(cWidth/2) - 8, 2*cHeight + 1, IntToStr(p^.Y));

 

//if p^.Linked

//then

Form1.Image2.Canvas.TextOut((vList.Count+1)*cWidth - round(cWidth/2) - 2, 3*cHeight + 1, IntToStr(p^.num));

//else

//Form1.Image2.Canvas.TextOut((vList.Count+1)*cWidth - round(cWidth/2) - 2, 3*cHeight + 1, '-');

 

if p^.rColor = 1 then

begin

rRect.Left := cWidth * vList.Count + 1;

rRect.Top := cHeight * 4 + 1;

rRect.Right := cWidth * (vList.Count+1);

rRect.Bottom := cHeight*5;

 

Form1.Image2.Canvas.Brush.Color := clRed;

Form1.Image2.Canvas.FillRect(rRect);

end;

 

if p^.rColor = 2 then

begin

rRect.Left := cWidth * vList.Count + 1;

rRect.Top := cHeight * 4 + 1;

rRect.Right := cWidth * (vList.Count+1);

rRect.Bottom := cHeight*5;

 

Form1.Image2.Canvas.Brush.Color := clBlue;

Form1.Image2.Canvas.FillRect(rRect);

end;

 

end;

 

procedure pointsDraw;

Var i: integer;

p: PPnt;

begin

 

Form1.Image1.Canvas.Brush.Color := clWhite;

Form1.Image1.Canvas.FillRect(Form1.Image1.Canvas.ClipRect);

Form1.Image1.Canvas.Rectangle(Form1.Image1.Canvas.ClipRect);

for i:=0 to pList.Count - 1 do

begin

p := pList.Items[i];

 

if p^.rColor = 1 then

begin

Form1.Image1.Canvas.Brush.Color := clRed;

Form1.Image1.Canvas.Ellipse(p^.X-4,p^.Y-4,p^.X+4,p^.Y+4);

end;

 

if p^.rColor = 2 then

begin

Form1.Image1.Canvas.Brush.Color := clBlue;

Form1.Image1.Canvas.Ellipse(p^.X-4,p^.Y-4,p^.X+4,p^.Y+4);

end;

 

 

end;

end;

 

 

procedure TForm1.ToolButton1Click(Sender: TObject);

begin

Screen.Cursor := crCross;

rColor := 1;

end;

 

procedure TForm1.ToolButton3Click(Sender: TObject);

var i:Integer;

begin

if (fl=false) then //кнопка нажата первый раз. включено ручное черчение

begin

sum:=0;

i_col:=0;

fl:=true;

Screen.Cursor := crCross;

rColor := 0;

Button2.Enabled:=false;

Button3.Enabled:=false;

start:=1;

StringGrid1.RowCount := 2; //отрисовка таблицы вывода результата

StringGrid1.ColCount := round(pList.Count/2)+2;

StringGrid1.Cells[StringGrid1.ColCount-1,0] := 'Сумма';

 

end

else //выход из режима черчения

begin //возврат связей в исходное состояние

for i:= 0 to pList.Count-1 do

PPnt(pList.Items[i])^.Linked:=false;

 

start := 0;

Screen.Cursor := crDefault;

fl:=false;

Button2.Enabled:=true;

Button3.Enabled:=true;

 

end;

 

end;

 

procedure TForm1.FormCreate(Sender: TObject);

Var

rRect: TRect;

i: integer;

begin //пераоночальное присваивание переменных

fl:=false;

start := 0;

i_1 := start_sh;

j_1 := 0;

i_2 := 0;

j_2 := 0;

tCount := 0;

redCount := 0;

blueCount := 0;

 

cWidth := 50;

cHeight := 15;

 

rRect.Left := 0;

rRect.Top := 0;

rRect.Right := Image1.Width;

rRect.Bottom := Image1.Height;

Image1.Canvas.FillRect(rRect);

Image1.Canvas.Rectangle(rREct);

 

 

rRect.Left := 0;

rRect.Top := 0;

rRect.Right := Image2.Width;

rRect.Bottom := Image2.Height;

Image2.Canvas.FillRect(rRect);

 

rRect.Right := cWidth;

rRect.Bottom := cHeight*5;

 

Image2.Canvas.Brush.Color := clInactiveCaption;

Image2.Canvas.FillRect(rRect);

Image2.Canvas.Font.Style := [fsBold];

 

for i:=0 to 5 do

begin

Image2.Canvas.MoveTo(0, i*cHeight);

Image2.Canvas.LineTo(cWidth, i*cHeight);

end;

 

for i:= 0 to 1 do

begin

Image2.Canvas.MoveTo(i*cWidth,0);

Image2.Canvas.LineTo(i*cWidth,cHeight*5 + 1);

end;

 

Image2.Canvas.TextOut(round(cWidth/2)-2, cHeight + 1, 'X');

Image2.Canvas.TextOut(round(cWidth/2)-2, 2*cHeight + 1, 'Y');

Image2.Canvas.TextOut(round(cWidth/2)-14, 3*cHeight + 1, 'Связь');

Image2.Canvas.TextOut(round(cWidth/2)-14, 4*cHeight + 1, 'Цвет');

 

 

rColor := 0;

 

pList := TList.Create;

tmpList := TList.Create;

oList := TList.Create;

rList := TList.Create;

 

end;

 

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

Shift: TShiftState; X, Y: Integer);

Var p: PPnt;

p1, p2: PPnt;

i:Integer;

minn,mint:Real;

begin

if fl then

begin

minn:=-1; //переменная расстояния между точками. -1 означает что еще не вычислялась

 

if (i_col=1)then //поиск второй точки, максимально близкой к месту нажатия

begin

for i:= 0 to pList.Count-1 do //перебор всех точек

begin

p:= pList.Items[i]; //данные i-й точки

if (p^.Linked=false)and(p^.rColor<>PPnt(pList.Items[ip1])^.rColor) //если точка не связана и противоположного цвета тогда

then

begin

mint:=sqrt(sqr(P^.X - X) + sqr(P^.Y - Y)); //вычисление расстояния

if(minn<0)then //первоночальное присваивание

begin

ip2:=i; //запомнить позиции точки из списка

minn:=mint

end;

if(mint<minn)then //поиск очередного минимума

begin

ip2:=i;

minn:=mint

end;

end;

end;

inc(i_col); //переход к друнгомк режиму обработки

PPnt(pList.Items[ip2])^.Linked:=true;

end;

 

if (i_col=0)then //поиск первой точки, максимально близкой к месту нажатия

begin

for i:= 0 to pList.Count-1 do //поиск первой точки

begin

p:= pList.Items[i];

if (p^.Linked=false)

then

begin

mint:=sqrt(sqr(P^.X - X) + sqr(P^.Y - Y));

if(minn<0)then //первоночальное присваивание

begin

ip1:=i;

minn:=mint

end;

if(mint<minn)then

begin

ip1:=i;

minn:=mint

end;

end;

end;

inc(i_col);

PPnt(pList.Items[ip1])^.Linked:=true;

end;

 

if (i_col=2) then //2 точки отобраны?

begin //отрисовка линии

p1 := pList.Items[ip1];

p2 := pList.Items[ip2];

sum:=sum+sqrt(sqr(P1^.X - P2^.X) + sqr(P1^.Y -P2^.Y));

Form1.Image1.Canvas.MoveTo(p1^.X, p1^.Y);

if p1^.rColor = 1 then Form1.Image1.Canvas.Pen.Color := clRed;

if p1^.rColor = 2 then Form1.Image1.Canvas.Pen.Color := clBlue;

Form1.Image1.Canvas.LineTo(round((P1^.X+P2^.X)/2),round((P1^.Y+P2^.Y)/2));

if p2^.rColor = 1 then Form1.Image1.Canvas.Pen.Color := clRed;

if p2^.rColor = 2 then Form1.Image1.Canvas.Pen.Color := clBlue;

Form1.Image1.Canvas.LineTo(P2^.X,P2^.Y);

//отображение цифр в таблице

StringGrid1.Cells[start,1] := IntToStr(P1^.num)+'-'+IntToStr(P2^.num);

StringGrid1.Cells[StringGrid1.ColCount-1,1] := IntToStr(round(Sum));

inc(start);

i_col:=0;

end;

end

else

begin

AddDrawPoint(pList, X,Y);

AddGridPoint(pList);

 

Label1.Caption := 'Красные точки: ' + IntToStr(redCount);

Label2.Caption := 'Синие точки: ' + ' ' + IntToStr(blueCount);

 

if redCount = blueCount then Button2.Enabled := true else Button2.Enabled := false;

end;

end;

 

procedure TForm1.ToolButton2Click(Sender: TObject);

begin

rColor := 2;

Screen.Cursor := crCross;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

Var i: integer;

p: PPnt;

 

begin

Start := 0;

start_sh := 0;

i_1 := Start_sh;

i_2 := 0;

j_1 := 0;

j_2 := 0;

DeletePoints(pList);

 

Image1.Canvas.Pen.Color := clBlack;

Image1.Canvas.Brush.Color := clWhite;

Image1.Canvas.Rectangle(Image1.Canvas.ClipRect);

 

ClearGrid;

 

end;

 

 

procedure TForm1.Button2Click(Sender: TObject);

Var rRect: TRect;

i: integer;

begin

FindLines;

DrawPoints(pList);

 

ClearGrid;

DrawGrid(pList);

 

end;

 

procedure TForm1.Button3Click(Sender: TObject);

Var rRect: TRect;

begin

 

if Start = pList.Count then //перебор точек по нажатию кнопки "Шаг" завершено

begin

Label3.Caption := 'Минимальная сумма отрезков: ' + FloatToStr(minSum);

exit;

end;

 

Sum:=0;

tmpList.Clear;

 

 

for i:= 0 to pList.Count-1 do //передача всех точек во временный список

begin

Pz := pList.Items[i];

New(P);

P^.X :=Pz.X ;

P^.Y :=Pz.Y;

P^.rColor :=Pz.rColor;

P^.Linked := Pz.Linked;

P^.Num := Pz.Num;

tmpList.Add(P);

end;

 

for i:= start to tmpList.Count-2 do //

begin

P := tmpList.Items[i];

if not P^.Linked then

begin

Min := MaxInt;

 

for j := 0 to tmpList.Count - 1 do

if i<>j then

begin

P2 := tmpList.Items[j];

if (not P2^.Linked) and (P2^.rColor <> P^.rColor) then

begin

if sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y)) < Min then

begin

Min := sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y));

PMin := P2;

end;

end;

end;

 

Sum:=Sum+Min;

P^.Linked := True;

PMin^.Linked := True;

PMin^.Num := P^.Num;

 

 

end;

end;

 

for i := 0 to start-1 do

begin

P := tmpList.Items[i];

if not P^.Linked then

begin

Min := MaxInt;

for j := 0 to tmpList.Count - 1 do

if i<>j then

begin

P2 := tmpList.Items[j];

if (not P2^.Linked) and (P2^.rColor <> P^.rColor) then

begin

if sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y)) < Min then

begin

Min := sqrt(sqr(P^.X - P2^.X) + sqr(P^.Y - P2^.Y));

PMin := P2;

 

end;

end;

end;

 

Sum:=Sum+Min;

P^.Linked := True;

PMin^.Linked := True;

PMin^.Num := P^.Num;

 

 

end;

end;

 

if start=0 then

begin

minsum:=sum;

oList.Clear;

 

i_1 := 0;

 

for i:= 0 to tmpList.Count-1 do

begin

Pz := tmpList.Items[i];

New(P);

P^.X :=Pz.X ;

P^.Y :=Pz.Y;

P^.rColor :=Pz.rColor;

P^.Linked := Pz.Linked;

P^.Num := Pz.Num;

oList.Add(P);

end;

end

else if sum<minsum then

begin

minsum:=sum;

oList.Clear;

 

for i:= 0 to tmpList.Count-1 do

begin

Pz := tmpList.Items[i];

New(P);

P^.X :=Pz.X ;

P^.Y :=Pz.Y;

P^.rColor :=Pz.rColor;

P^.Linked := Pz.Linked;

P^.Num := Pz.Num;

oList.Add(P);

 

end;

end;

 

i_1 := 0;

StringGrid1.RowCount := start+2;

StringGrid1.ColCount := REdCount+2;

for i:= 0 to oList.Count-1 do

begin

p := oList.Items[i];

 

if P^.num <> i+1 then

begin

Inc(i_1);

StringGrid1.Cells[i_1,start+1]:= IntToStr(i+1) + '-' + IntToStr(p^.num);

StringGrid1.Cells[StringGrid1.ColCount-1,start+1] := FloatToStr(round(minSum));

StringGrid1.Cells[i_1,0]:= IntToStr(i_1);

StringGrid1.Cells[StringGrid1.ColCount-1,0] := 'Сумма';

 

end;

end;

 

StringGrid1.Cells[0,start+1]:= IntToStr(start+1);

 

DrawGrid(oList);

Image1.Canvas.FillRect(Image1.Canvas.ClipRect);

DrawPoints(oList);

 

 

inc(start);

end;

 

procedure TForm1.N4Click(Sender: TObject);

begin

ShellExecute(Handle, 'open','index.chm',nil , Nil, SW_ShowNormal);

end;

 

procedure TForm1.N3Click(Sender: TObject);

begin

Form1.Close;

end;

 

end.







Дата добавления: 2015-08-18; просмотров: 270. Нарушение авторских прав

Studopedia.info - Студопедия - 2014-2017 год . (0.073 сек.) русская версия | украинская версия