Смекни!
smekni.com

Сравнительный анализ алгоритмов построения выпуклой оболочки на плоскости (стр. 3 из 5)

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

Рис. 7: Зависимость время выполнения при расположении точек на окружности.

Как видно в данном случае алгоритм Грэхема оказался самым эффективным. Быстрый метод в этом случае не выбрасывает на каждом шаге точек, но так как делит их примерно на равные части, то получается, что он работает примерно время O(N log N), что вполне приемлемо. Что касается динамического построения, то в процессе добавления точек в дерево попадают все вершины, а так как при работе с AWL деревом в моей реализации используются сложные операции с указателями то и процедура получилась медленной.

Рис. 8: Нежелательный случай расположения точек для быстрого алгоритма.

Из алгоритма быстрого построения следует, что в некоторых случая на каком-то шаге может оказаться, что не была удалена ни одна вершина, и все точки оказались по одну сторону от bh и eh (рис. 8). Если такое случается очень редко, то это не отразится на времени выполнения значительно, а если такое происходит на каждом шаге, то это приводит к оценке O(N2). Для моей реализации этого алгоритма можно взять график ex и точку, расположенную на оси ординат над точкой O.

Рис. 9: Время работы быстрой оболочки O(N2).

Выводы

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

Теперь можно подвести итоги. В большинстве случаев самыми быстрыми являются алгоритмы Грэхема и быстрый алгоритм. С учетом того, что они просты для реализации, они вполне приемлемы для многих задач.

Но быстрый метод имеет существенный недостаток. Если нас интересует поведение алгоритма в худшем случае, он неприемлем.

Алгоритм типа “разделяй и властвуй” не показал очень быстрых результатов и не является очень простым в реализации, но он в худшем случае все равно имеет оптимальную оценку. Так же он может быть очень эффективно распараллелен.

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

Заключение

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


Приложение Unit1.pas


unit Unit1;

interface

uses

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

ExtCtrls, StdCtrls, Spin;

const timew=10/24/60/60;

type

tp=extended;

pr=^rr;

rr=record

x,y:tp;

n:pr;

end;

TForm1 = class(TForm)

Panel1: TPanel;

ResetButton: TButton;

PaintBox1: TPaintBox;

RandomButton: TButton;

Label2: TLabel;

Label1: TLabel;

Label3: TLabel;

QRandom: TSpinEdit;

Range: TSpinEdit;

GrahamButton: TButton;

TimeL: TLabel;

QButton: TButton;

DiveRule: TButton;

Circle: TButton;

Button1: TButton;

Button2: TButton;

Button3: TButton;

procedure PaintBox1Paint(Sender: TObject);

procedure RandomButtonClick(Sender: TObject);

procedure ResetButtonClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure GrahamButtonClick(Sender: TObject);

procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure QButtonClick(Sender: TObject);

procedure DiveRuleClick(Sender: TObject);

procedure CircleClick(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

cn,sn:pr;

mx,my:tp;

strr:string;

x0,y0:integer;

time:double;

tt:pr;

kkk:integer;

implementation

{$R *.DFM}

procedure Writ(x,y:tp);

var t:pr;

begin

new(t);

t^.x:=x;

t^.y:=y;

t^.n:=sn;

sn:=t;

end;

procedure TForm1.PaintBox1Paint(Sender: TObject);

var t:pr;

rect:TRect;

x,y:integer;

begin

with PaintBox1 do

begin

Canvas.Brush.Color :=clBtnFace;

rect.Left:=0;

rect.Top:=0;

rect.Bottom:=Height;

rect.Right:=Width;

Canvas.FillRect(rect);

Canvas.Pen.Color :=clGray;

x0:=Width div 2;

y0:=Height div 2;

Canvas.MoveTo(x0,y0);

Canvas.LineTo(x0,0);

Canvas.MoveTo(x0,y0);

Canvas.LineTo(x0,Height);

Canvas.MoveTo(x0,y0);

Canvas.LineTo(0,y0);

Canvas.MoveTo(x0,y0);

Canvas.LineTo(Width,y0);

Canvas.Pen.Color :=clGreen;

if sn<>nil then

begin

t:=sn;

x:=x0+Trunc(t^.x*mx);

y:=y0+Trunc(t^.y*my);

Canvas.MoveTo(x,y);

while t<>nil do

begin

x:=x0+Trunc(t^.x*mx);

y:=y0+Trunc(t^.y*my);

Canvas.LineTo(x,y);

t:=t^.n;

end;

x:=x0+Trunc(sn^.x*mx);

y:=y0+Trunc(sn^.y*my);

Canvas.LineTo(x,y);

end;

Canvas.Pen.Color :=clBlue;

t:=cn;

while t<>nil do

begin

x:=x0+Trunc(t^.x*mx);

y:=y0+Trunc(t^.y*my);

Canvas.Ellipse(x-1,y-1,x+1,y+1);

t:=t^.n;

end;

end;

end;

procedure TForm1.RandomButtonClick(Sender: TObject);

var

i:integer;

t:pr;

begin

randomize();

while cn<>nil do

begin

t:=cn^.n;

dispose(cn);

cn:=t;

end;

while sn<>nil do

begin

t:=sn^.n;

dispose(sn);

sn:=t;

end;

mx:=0;

my:=0;

for i:=1 to QRandom.Value do

begin

new(t);

t^.n:=cn;

cn:=t;

t^.x:=random(2*Range.Value+1)-Range.Value;

t^.y:=random(2*Range.Value+1)-Range.Value;

if mx<abs(t^.x) then mx:=abs(t^.x);

if my<abs(t^.y) then my:=abs(t^.y);

end;

if mx<>0 then mx:=0.8*(Width div 2)/mx;

if my<>0 then my:=0.8*(Height div 2)/my;

PaintBox1.Refresh;

end;

procedure TForm1.ResetButtonClick(Sender: TObject);

var

t:pr;

begin

while cn<>nil do

begin

t:=cn^.n;

dispose(cn);

cn:=t;

end;

while sn<>nil do

begin

t:=sn^.n;

dispose(sn);

sn:=t;

end;

mx:=1;

my:=1;

PaintBox1.Refresh;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

cn:=nil;

sn:=nil;

mx:=1;

my:=1;

with PaintBox1 do

begin

x0:=Width div 2;

y0:=Height div 2;

end;

end;

procedure TForm1.GrahamButtonClick(Sender: TObject);

label repl;

type

prec=^rec;

rec=record

x,y:tp;

next,prev:prec;

end;

var st,t,s,l,r,p:prec;

procedure inss(var st:prec;t,d:prec);

begin

if st=nil then

begin

st:=t;

d^.next:=t;

st^.prev:=d;

end else

begin

st^.prev^.next:=t;

d^.next:=st;

t^.prev:=st^.prev;

st^.prev:=d;

end;

end;

procedure ins(var st,t:prec);

begin

if st=nil then

begin

st:=t;

st^.next:=t;

st^.prev:=t;

end else

begin

t^.next:=st;

t^.prev:=st^.prev;

st^.prev^.next:=t;

st^.prev:=t;

end;

end;

procedure cut(var st,t:prec);

begin

if st^.next=st then st:=nil else

begin

if t=st

then st:=t^.next;

t^.next^.prev:=t^.prev;

t^.prev^.next:=t^.next;

end;

end;

procedure sort(var b:prec;e:prec);

var p,q:prec;

x:tp;

begin

if b=e then exit;

if b^.next=e then

begin

if (b^.x>e^.x) or ((b^.x=e^.x)and(b^.y>e^.y)) then

begin

x:=b^.x;

b^.x:=e^.x;

e^.x:=x;

x:=b^.y;

b^.y:=e^.y;

e^.y:=x;

end;

exit;

end;

p:=b;

q:=e;

while (p<>q)and(p^.next<>q) do

begin

p:=p^.next;

q:=q^.prev;

end;

if p=q then q:=q.next;

p^.next:=b;

b^.prev:=p;

q^.prev:=e;

e^.next:=q;

sort(b,p);

sort(q,e);

p:=b;

b:=nil;

while (p<>nil)and(q<>nil) do

begin

if (p^.x>q^.x)or((p^.x=q^.x)and(p^.y>q^.y)) then

begin

e:=q;

cut(q,e);

ins(b,e);

end else

begin

e:=p;

cut(p,e);

ins(b,e);

end;

end;

if p<>nil then

begin

e:=p;

inss(b,e,e^.prev);

end;

if q<>nil then

begin

e:=q;

inss(b,e,e^.prev);

end;

end;

procedure sort2(var b:prec;e:prec);

var p,q:prec;

x:tp;

begin

if b=e then exit;

if b^.next=e then

begin

if (b^.x<e^.x) or ((b^.x=e^.x)and(b^.y<e^.y)) then

begin

x:=b^.x;

b^.x:=e^.x;

e^.x:=x;

x:=b^.y;

b^.y:=e^.y;

e^.y:=x;

end;

exit;

end;

p:=b;

q:=e;

while (p<>q)and(p^.next<>q) do

begin

p:=p^.next;

q:=q^.prev;

end;

if p=q then q:=q.next;

p^.next:=b;

b^.prev:=p;

q^.prev:=e;

e^.next:=q;

sort2(b,p);

sort2(q,e);

p:=b;

b:=nil;

while (p<>nil)and(q<>nil) do

begin

if (p^.x<q^.x)or((p^.x=q^.x)and(p^.y<q^.y)) then

begin

e:=q;

cut(q,e);

ins(b,e);

end else

begin

e:=p;

cut(p,e);

ins(b,e);

end;

end;

if p<>nil then

begin

e:=p;

inss(b,e,e^.prev);

end;

if q<>nil then

begin

e:=q;

inss(b,e,e^.prev);

end;

end;

procedure grah(var st:prec);

var r,t,g:prec;

f:integer;

begin

if st^.next=st^.prev then exit;

r:=st;

t:=st;

f:=0;

while (f<=0) or (t<>r) do

begin

if (t^.next^.x-t^.prev^.x)*(t^.y-t^.prev^.y)>=(t^.x-t^.prev^.x)*(t^.next^.y-t^.prev^.y) then

begin

if t=r then

begin

dec(f);

r:=t^.next;

end;

t:=t^.prev;

g:=t^.next;

cut(st,g);

dispose(g);

end else

begin

t:=t^.next;

if t=r then inc(f);

end;

end;

end;

begin

time:=now;

kkk:=0;

repeat

while sn<>nil do

begin

tt:=sn^.n;

dispose(sn);

sn:=tt;

end;

st:=nil;

s:=nil;

tt:=cn;

if tt=nil then exit;

while tt<>nil do

begin

new(t);

t^.x:=tt^.x;

t^.y:=tt^.y;

tt:=tt^.n;

ins(st,t);

end;

if st=nil then exit;

l:=st;

r:=st;

t:=st;

repeat

if (r^.x<t^.x) or ((r^.y<t^.y)and(r^.x=t^.x)) then r:=t;

if (l^.x>t^.x) or ((l^.y>t^.y)and(l^.x=t^.x)) then l:=t;

t:=t^.next;

until t=st;

if l^.x=r^.x then

begin

str((now-time)*24*60*60:0:2,strr);

TimeL.Caption:=strr+'s';

writ(l^.x,l^.y);

if not((r^.x=l^.x)and(r^.y=l^.y)) then writ(r^.x,r^.y);

t:=l;

while l<>nil do

begin

t:=l;

cut(l,t);

dispose(t);

end;

exit;

end;

t:=l;

t:=st;

repeat

repl:

if st=nil then break;

p:=t;

t:=t^.next;

if (p^.x-l^.x)*(r^.y-l^.y)<=(p^.y-l^.y)*(r^.x-l^.x) then

begin

cut(st,p);

ins(s,p);

goto repl;

end;

until t=st;

sort2(s,s^.prev);

if st <> nil then

begin

sort(st,st^.prev);

t:=st^.prev;

st^.prev^.next:=s;

st^.prev:=s^.prev;

s^.prev^.next:=st;

s^.prev:=t;

st:=st^.prev;

grah(s);

end;

t:=s;

repeat

writ(t^.x,t^.y);

t:=t^.next;

until t=s;

while s<>nil do

begin

t:=s;

cut(s,t);

dispose(t);

end;

inc(kkk);

until now-time>timew;

str((now-time)/kkk*24*60*60:0:6,strr);

TimeL.Caption:=strr+'s';

PaintBox1.Refresh;

end;

{ end graham}

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

Shift: TShiftState; X, Y: Integer);

var

t:pr;

begin

new(t);

t^.x:=(x-x0)/mx;

t^.y:=(y-y0)/my;

t^.n:=cn;

cn:=t;

Canvas.Pen.Color :=clBlue;

Canvas.Ellipse(x-1,y-1,x+1,y+1);

end;

{-------------------------------------}

procedure TForm1.QButtonClick(Sender: TObject);

type prec=^rec;

rec=record

x,y:tp;

p,n:prec;

end;

list=record

b,e:prec;

end;

var t,bb,ee:prec;

ll,gr,ls:list;

procedure cut(var l:list;t:prec);