является очень простым в реализации, но он в худшем случае все равно имеет

оптимальную оценку. Так же он может быть очень эффективно распараллелен.

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

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

связана с различными трудностями.

Заключение

В этой работе были показаны основные алгоритмы построения выпуклых оболочек

на плоскости. Так же были проведены сравнения на конкретных реализациях

алгоритмов и тестах. Все задачи, поставленные перед этой работой, на мой

взгляд, решены.

Приложение 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);

begin

if t^.p<>nil then t^.p^.n:=t^.n

else l.b:=t^.n;

if t^.n<>nil then t^.n^.p:=t^.p

else l.e:=t^.p;

end;

procedure clr(var l:list);

begin

l.b:=nil;

l.e:=nil;

end;

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

begin

t^.n:=nil;

if l.e<>nil then l.e^.n:=t;

t^.p:=l.e;

l.e:=t;

if l.b=nil then l.b:=t;

end;

procedure con(var l1,l2:list);

begin

if l2.b<>nil then l2.b^.p:=l1.e else exit;

if l1.b<>nil then l1.e^.n:=l2.b else

begin

l1:=l2;

exit;

end;

l1.e:=l2.e;

end;

procedure proc(var ls:list;b,e:prec);

var l1,l2:list;

r,t,m:prec;

begin

if ls.b=nil then exit;

t:=ls.b;

m:=t;

while t<>nil do

begin

if

(b^.x-m^.x)*(b^.y+m^.y)+(m^.x-e^.x)*(e^.y+m^.y)<(b^.x-t^.x)*(b^.y+t^.y)+(t^.x-e^.x)*(e^.y+t^.y)

then

m:=t;

t:=t^.n;

end;

cut(ls,m);

clr(l1);

t:=ls.b;

while t<>nil do

begin

r:=t^.n;

if (t^.x-b^.x)*(m^.y-b^.y)>(m^.x-b^.x)*(t^.y-b^.y) then

begin

cut(ls,t);

add(l1,t)

end;

t:=r;

end;

clr(l2);

t:=ls.b;

while t<>nil do

begin

r:=t^.n;

if (t^.x-e^.x)*(m^.y-e^.y)<(m^.x-e^.x)*(t^.y-e^.y) then

begin

cut(ls,t);

add(l2,t)

end;

t:=r;

end;

con(gr,ls);

Страницы: 1, 2, 3, 4