Аппроксимация выпуклой оболочки / SOURCE / CONVEX

unit convex;

interface
uses Main, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
ExtCtrls, StdCtrls,Math,List,MYDet,WinTypes,Sort;
procedure CHPaint(f:AList;var g:ListP);
procedure RealPaint(f:AList;var g:ListP);
procedure SCHPaint(f:AList; var g:ListP); {рисуем}
procedure FromWaht;
procedure XSort;
procedure Sort;
procedure ChConstr(var p:ListP);
procedure ChConstrAndrDown(var p:ListP);
procedure ChConstrAndrUp(var p:ListP);

implementation
{************************************************}
{************************************************}
procedure Sort; {SORT-для метода Грехэма}
var i,j,coef,k,l,s,h:integer;
b,c,tostep:boolean;
v1,v2:real ;
begin
MyList := ListP.Create;
New(ARecord);
ARecord^.x := a[0].x;
ARecord^.y := a[0].y;
ARecord^.number := a[0].number;

New(ARecord1);
ARecord1^.x := a[1].x;
ARecord1^.y := a[1].y;
ARecord1^.number := a[1].number;
coef:=ARecord1^.x*Arecord^.y-ARecord1^.y*Arecord^.x;
{Обработка исключительных ситуаций}
if coef>0 then
begin
MyList.Add(ARecord1);
MyList.Add(ARecord);
end
else if coef<0 then
begin MyList.Add(ARecord);
MyList.Add(ARecord1);
end
else if coef=0 then
begin
{1.} if (ARecord1.y=0) and (ARecord.y=0)then
if ARecord1.x>ARecord.x then begin
MyList.Add(ARecord);
MyList.Add(ARecord1);
end
else
begin
MyList.Add(ARecord1);
MyList.Add(ARecord);
end;
{2.} if (ARecord1.x=0) and (ARecord.x=0)then
if ARecord1.y>ARecord.y then begin
MyList.Add(ARecord1);
MyList.Add(ARecord);
end
else
begin
MyList.Add(ARecord);
MyList.Add(ARecord1);
end;

{3.} if Arecord1^.y<>0 then v1:=Arecord1^.x/Arecord1^.y;
if Arecord^.y<>0 then v2:=Arecord^.x/Arecord^.y;
if (v1=v2)and (Arecord1^.x<>0)and(Arecord1^.x<>0)and
(Arecord^.x<>0) and(Arecord^.y<>0) then
if ARecord1.x>ARecord.x then begin
MyList.Add(ARecord);
MyList.Add(ARecord1);
end
else
begin
MyList.Add(ARecord1);
MyList.Add(ARecord);
end;
end;
a[0]:=a[count-1];
a[1]:=a[count-2];
count:=count-2;
for i:=0 to (count-1) do
begin
b:=false;
g:=false;
for j:=0 to (MyList.Count-1) do
begin ARecord:=MyList.Items[j];
coef:=a[i].x*Arecord^.y-a[i].y*Arecord^.x;

{обработка исключительных ситуаций}
if coef=0 then begin
{1.Точки на одной прямой,не на осях}
if a[i].y<>0 then v1:=a[i].x/a[i].y;
if Arecord^.y<>0 then v2:=Arecord^.x/Arecord^.y;
if (v1=v2)and (a[i].x<>0)and (a[i].y<>0)and
(Arecord^.x<>0)and(Arecord^.y<>0) then
begin
if a[i].x>Arecord^.x then
begin
MyList.Delete(j);
New(ARecord);
ARecord^.x := a[i].x;
ARecord^.y := a[i].y;
ARecord^.number := a[i].number;
MyList.Insert(j,Arecord);
end;
end;
{2.Точки на оси x}
if (a[i].y=0) and (Arecord^.y=0) then
begin
if (a[i].x>Arecord^.x) then begin
MyList.Delete(j);
New(ARecord);
ARecord^.x := a[i].x;
ARecord^.y := a[i].y;
ARecord^.number := a[i].number;
MyList.Insert(j,Arecord);
end;
end;
{3.Точки на оси y}
if (a[i].x=0) and (Arecord^.x=0) then
begin
if (a[i].y>Arecord^.y) then begin
MyList.Delete(j);
New(ARecord);
ARecord^.x := a[i].x;
ARecord^.y := a[i].y;
ARecord^.number := a[i].number;
MyList.Insert(j,Arecord);
end;
end;
b:=true;
break;
end;
{конец}
if coef<0 then
begin
if j<>MyList.Count-1 then
ARecord:=MyList.Items[j+1] else break;
coef:=a[i].x*Arecord^.y-a[i].y*Arecord^.x;
{обработка исключительных ситуаций}
if coef=0 then begin
{1.Точки на одной прямой,не на осях}
v1:=a[i].x/a[i].y;
v2:=Arecord^.x/Arecord^.y;
if (v1=v2)and (a[i].x<>0)and (a[i].y<>0)and
(Arecord^.x<>0)and(Arecord^.y<>0) then
begin
if a[i].x>Arecord^.x then
begin
MyList.Delete(j+1);
New(ARecord);
ARecord^.x := a[i].x;
ARecord^.y := a[i].y;
ARecord^.number := a[i].number;
MyList.Insert(j+1,Arecord);
end;
end;
{2.Точки на оси x}
if (a[i].y=0) and (Arecord^.y=0) then
begin
if (a[i].x>Arecord^.x) then begin
MyList.Delete(j+1);
New(ARecord);
ARecord^.x := a[i].x;
ARecord^.y := a[i].y;
ARecord^.number := a[i].number;
MyList.Insert(j+1,Arecord);
end;
end;
{3.Точки на оси y}
if (a[i].x=0) and (Arecord^.x=0) then
begin
if (a[i].y>Arecord^.y) then begin
MyList.Delete(j+1);
New(ARecord);
ARecord^.x := a[i].x;
ARecord^.y := a[i].y;
ARecord^.number := a[i].number;
MyList.Insert(j+1,Arecord);
end;
end;
b:=true;
break;
end;
{конец}
if coef>0 then
begin
New(ARecord);
ARecord^.x := a[i].x;
ARecord^.y := a[i].y;
ARecord^.number := a[i].number;
MyList.Insert(j+1,ARecord);
b:=true;
break;
end ;
end else begin
New(ARecord);
ARecord^.x := a[i].x;
ARecord^.y := a[i].y;
ARecord^.number := a[i].number;
MyList.Insert(0,ARecord);
b:=true;
break end;
end;
if ((b=false) and (j=MyList.Count-1)) then
begin New(ARecord);
ARecord^.x := a[i].x;
ARecord^.y := a[i].y;
ARecord^.number := a[i].number;
MyList.Add(ARecord);
end;
end;
end;
{************************************************}
{************************************************}
procedure FromWaht; {откуда сортируем точки}
var i,j,h,k,l,m:integer; xcent,ycent: string;
opr:boolean;
begin l:=1000000;
for i:=0 to (count-2) do
begin
k:=Min(a[i].y,a[i+1].y);
l:=min(l,k);
end;
{поиск точки,минимальной по x и y}
m:=10000000;
for i:=0 to (count-1) do
begin
if a[i].y=l then begin
if a[i].x<m then m:=a[i].x;
end;
end;
for i:=0 to (count-1) do
begin
if (a[i].y=l) and (a[i].x=m) then begin
Tp[1].x:=a[i].x;
Tp[1].y:=a[i].y;
Tp[1].number := a[i].number;
a[i]:=a[count-1];
count:=count-1;
end;
end;

for i:=0 to (count-1) do
begin
a[i].x:=a[i].x-Tp[1].x;
a[i].y:=a[i].y-Tp[1].y;
end;
end;
{************************************************}
{************************************************}
procedure CHPaint(f:AList; var g:ListP); {рисуем}
var k:integer;
l_x, l_y: real;
mx, my: integer;
begin
l_x:=MainForm.PaintBox1.Width/1000;
l_y:=MainForm.PaintBox1.Height/1000;
for k:=0 to g.Count-2 do
begin
Arecord:=g.Items[k];
mx:=round((ARecord^.x+f.x)*l_x); my:=round((ARecord^.y+f.y)*l_y);
CHDotsNum:=CHDotsNum+1;
CHDots[CHDotsNum].X:=ARecord^.x+f.x;
CHDots[CHDotsNum].Y:=ARecord^.y+f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.MoveTo(mx,my);
Arecord:=g.Items[k+1] ;
mx:=round((ARecord^.x+f.x)*l_x); my:=round((ARecord^.y+f.y)*l_y);
CHDotsNum:=CHDotsNum+1;
CHDots[CHDotsNum].X:=ARecord^.x+f.x;
CHDots[CHDotsNum].Y:=ARecord^.y+f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.LineTo(mx,my);
end;
if (MyList<>nil) then begin
Arecord:=g.Items[0];
mx:=round((ARecord^.x+f.x)*l_x); my:=round((ARecord^.y+f.y)*l_y);
CHDotsNum:=CHDotsNum+1;
CHDots[CHDotsNum].X:=ARecord^.x+f.x;
CHDots[CHDotsNum].Y:=ARecord^.y+f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.MoveTo(mx,my);
mx:=round(f.x*l_x); my:=round(f.y*l_y);
CHDotsNum:=CHDotsNum+1;
CHDots[CHDotsNum].X:=f.x;
CHDots[CHDotsNum].Y:=f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.LineTo(mx,my);

Arecord:=g.Items[g.Count-1] ;
mx:=round((ARecord^.x+f.x)*l_x); my:=round((ARecord^.y+f.y)*l_y);
CHDotsNum:=CHDotsNum+1;
CHDots[CHDotsNum].X:=ARecord^.x+f.x;
CHDots[CHDotsNum].Y:=ARecord^.y+f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.MoveTo(mx,my);
mx:=round(f.x*l_x); my:=round(f.y*l_y);
CHDotsNum:=CHDotsNum+1;
CHDots[CHDotsNum].X:=f.x;
CHDots[CHDotsNum].Y:=f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.LineTo(mx,my);

if c=true then
begin
new(ARecord);
ARecord^.x := Tp[1].x;
Arecord^.y:=Tp[1].y;
ARecord^.number := Tp[1].number;
//Form1.Memo1.Lines.Add(IntToStr(ARecord^.number)+' - '+IntToStr(ARecord^.x)+';'+IntToStr(ARecord^.y));
c:=false;
end;
end;
end;

{************************************************}

{************************************************}
procedure RealPaint(f:AList; var g:ListP); {рисуем}
var k:integer;
l_x, l_y: real;
mx, my: integer;
begin
l_x:=MainForm.PaintBox1.Width/1000;
l_y:=MainForm.PaintBox1.Height/1000;
for k:=0 to g.Count-2 do
begin
Arecord:=g.Items[k];
mx:=round((ARecord^.x+f.x)*l_x); my:=round((ARecord^.y+f.y)*l_y);
RealDotsNum:=RealDotsNum+1;
RealDots[RealDotsNum].X:=ARecord^.x+f.x;
RealDots[RealDotsNum].Y:=ARecord^.y+f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.MoveTo(mx,my);
Arecord:=g.Items[k+1] ;
mx:=round((ARecord^.x+f.x)*l_x); my:=round((ARecord^.y+f.y)*l_y);
RealDotsNum:=RealDotsNum+1;
RealDots[RealDotsNum].X:=ARecord^.x+f.x;
RealDots[RealDotsNum].Y:=ARecord^.y+f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.LineTo(mx,my);
end;
if (MyList<>nil) then begin
Arecord:=g.Items[0];
mx:=round((ARecord^.x+f.x)*l_x); my:=round((ARecord^.y+f.y)*l_y);
RealDotsNum:=RealDotsNum+1;
RealDots[RealDotsNum].X:=ARecord^.x+f.x;
RealDots[RealDotsNum].Y:=ARecord^.y+f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.MoveTo(mx,my);
mx:=round(f.x*l_x); my:=round(f.y*l_y);
RealDotsNum:=RealDotsNum+1;
RealDots[RealDotsNum].X:=f.x;
RealDots[RealDotsNum].Y:=f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.LineTo(mx,my);

Arecord:=g.Items[g.Count-1] ;
mx:=round((ARecord^.x+f.x)*l_x); my:=round((ARecord^.y+f.y)*l_y);
RealDotsNum:=RealDotsNum+1;
RealDots[RealDotsNum].X:=ARecord^.x+f.x;
RealDots[RealDotsNum].Y:=ARecord^.y+f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.MoveTo(mx,my);
mx:=round(f.x*l_x); my:=round(f.y*l_y);
RealDotsNum:=RealDotsNum+1;
RealDots[RealDotsNum].X:=f.x;
RealDots[RealDotsNum].Y:=f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.LineTo(mx,my);

if c=true then
begin
new(ARecord);
ARecord^.x := Tp[1].x;
Arecord^.y:=Tp[1].y;
ARecord^.number := Tp[1].number;
//Form1.Memo1.Lines.Add(IntToStr(ARecord^.number)+' - '+IntToStr(ARecord^.x)+';'+IntToStr(ARecord^.y));
c:=false;
end;
end;
end;

{************************************************}


{************************************************}
procedure SCHPaint(f:AList; var g:ListP); {рисуем}
var k:integer;
l_x, l_y: real;
mx, my: integer;
begin
l_x:=MainForm.PaintBox1.Width/1000;
l_y:=MainForm.PaintBox1.Height/1000;
for k:=0 to g.Count-2 do
begin
Arecord:=g.Items[k];
mx:=round((ARecord^.x+f.x)*l_x); my:=round((ARecord^.y+f.y)*l_y);
SCHDotsNum:=SCHDotsNum+1;
SCHDots[SCHDotsNum].X:=ARecord^.x+f.x;
SCHDots[SCHDotsNum].Y:=ARecord^.y+f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.MoveTo(mx,my);
Arecord:=g.Items[k+1] ;
mx:=round((ARecord^.x+f.x)*l_x); my:=round((ARecord^.y+f.y)*l_y);
SCHDotsNum:=SCHDotsNum+1;
SCHDots[SCHDotsNum].X:=ARecord^.x+f.x;
SCHDots[SCHDotsNum].Y:=ARecord^.y+f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.LineTo(mx,my);
end;
if (MyList<>nil) then begin
Arecord:=g.Items[0];
mx:=round((ARecord^.x+f.x)*l_x); my:=round((ARecord^.y+f.y)*l_y);
SCHDotsNum:=SCHDotsNum+1;
SCHDots[SCHDotsNum].X:=ARecord^.x+f.x;
SCHDots[SCHDotsNum].Y:=ARecord^.y+f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.MoveTo(mx,my);
mx:=round(f.x*l_x); my:=round(f.y*l_y);
SCHDotsNum:=SCHDotsNum+1;
SCHDots[SCHDotsNum].X:=f.x;
SCHDots[SCHDotsNum].Y:=f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.LineTo(mx,my);

Arecord:=g.Items[g.Count-1] ;
mx:=round((ARecord^.x+f.x)*l_x); my:=round((ARecord^.y+f.y)*l_y);
SCHDotsNum:=SCHDotsNum+1;
SCHDots[SCHDotsNum].X:=ARecord^.x+f.x;
SCHDots[SCHDotsNum].Y:=ARecord^.y+f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.MoveTo(mx,my);
mx:=round(f.x*l_x); my:=round(f.y*l_y);
SCHDotsNum:=SCHDotsNum+1;
SCHDots[SCHDotsNum].X:=f.x;
SCHDots[SCHDotsNum].Y:=f.y;
//If MainForm.vis_obolochka.Checked then MainForm.PaintBox1.Canvas.LineTo(mx,my);

if c=true then
begin
new(ARecord);
ARecord^.x := Tp[1].x;
Arecord^.y:=Tp[1].y;
ARecord^.number := Tp[1].number;
//Form1.Memo1.Lines.Add(IntToStr(ARecord^.number)+' - '+IntToStr(ARecord^.x)+';'+IntToStr(ARecord^.y));
c:=false;
end;
end;
end;


{************************************************}
procedure ChConstr(var p:ListP); {метод Грэхема}
var cur,i,k,l,j,h,ll:integer;
f:boolean;
begin
with p do
begin
f:=false;
while (cur<>p.count-2) do
begin
if (cur=p.count-1) then f:=true;
if det(points[cur],points[cur+1],points[cur+2])>0 then
begin
inc(cur);
end
else
begin
delete(cur+1);
dec(cur);
if cur<0 then cur:=0;
end;end;
end;
end;
{************************************************}
{************************************************}
procedure ChConstrAndrDown(var p:ListP); {метод Грэхема}
var cur,i,k,l,j,h,ll:integer;
f:boolean;
begin
cur:=0;
for h:=0 to p.Count-2 do
with p do
begin
f:=false;
while (cur<>p.count-2) do
begin
if (cur=p.count-1) then f:=true;
if det(pointsAndr[cur,AndrDownList],pointsAndr[cur+1,AndrDownList],pointsAndr[cur+2,AndrDownList])<0 then
begin
inc(cur);
end
else
begin
delete(cur+1);
dec(cur);
if cur<0 then cur:=0;
end;end;
end;
end;
{************************************************}
{************************************************}
procedure ChConstrAndrUp(var p:ListP); {метод Грэхема}
var cur,i,k,l,j,h,ll:integer;
f:boolean;
begin
cur:=0;
for h:=0 to p.Count-2 do
with p do
begin
f:=false;
while (cur<>p.count-2) do
begin
if (cur=p.count-1) then f:=true;
if det(pointsAndr[cur,AndrUpList],pointsAndr[cur+1,AndrUpList],pointsAndr[cur+2,AndrUpList])>0 then
begin
inc(cur);
end
else
begin
delete(cur+1);
dec(cur);
if cur<0 then cur:=0;
end;end;
end;
end;
{************************************************}
{************************************************}
procedure XSort;
var i,kx,ky:integer; c,k:real;
begin
AndrList:=ListP.Create;
for i:=0 to count-1 do
begin new(Elem);
Elem^.x:=a[i].x;
Elem^.y:=a[i].y;
Elem^.number:=a[i].number;
AndrList.Add(Elem);
end;
SortPoints(0,AndrList.count-1,AndrList);
Left:=AndrList.Items[0];
Right:=AndrList.Items[AndrList.count-1];
AndrDownList:=ListP.Create;
AndrUpList:=ListP.Create;
kx:= Right^.x-Left^.x;
ky:= Right^.y-Left^.y;
k:=ky/kx;
c:=Right^.y-Right^.x*k;
// Form1.PaintBox1.canvas.pen.color:= clBlack;
// Form1.PaintBox1.Canvas.MoveTo(Left^.x,Left^.y);
// Form1.PaintBox1.Canvas.LineTo(Right^.x,Right^.y);
for i:=1 to AndrList.count-2 do
begin Elem:=AndrList.Items[i];
if Elem^.y<Elem^.x*k+c then begin
AndrDownList.Add(Elem);
end
else begin
AndrUpList.Add(Elem);
end
end;
Elem:=AndrList.Items[0];
AndrDownList.Insert(0,Elem);
AndrUpList.Insert(0,Elem);
Elem:=AndrList.Items[count-1];
AndrDownList.Add(Elem);
AndrUpList.Add(Elem);
end;
{************************************************}
{************************************************}
end.