Рейтинг@Mail.ru
Rambler's Top100




Не нашли нужную работу? Закажи реферат, курсовую, диплом на заказ

реферат на тему: Сравнительный анализ алгоритмов построения выпуклой оболочки на плоскости

скачать реферат

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 mx0 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^.xq)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^.xnil 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^.xt^.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

скачать реферат
1 2 3 4 5 6 7

Не нашли нужную работу? Закажи реферат, курсовую, диплом на заказ

Внимание! Студенческий отдых и мегатусовка после сессии!


Обратная связь.

IsraLux отзывы Израиль отзывы