conqueranddive.~pas

利用分治的算法实现平面最近点问题

unit ConquerandDive;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,math, ExtCtrls, SUIForm, SUIButton, SUIEdit, ComCtrls;

type
    TForm1 = class(TForm)
    Timer1: TTimer;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Label2: TLabel;
    Label4: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    RichEdit1: TRichEdit;
    Edit3: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

  public
   procedure DrawThepicture;
    { Public declarations }
  private
  end;

const

e=1;
PointRight=400;
PointTop=100;
PointBottom=400;
PointLeft=100;
MaxPointsCount=10;
var
  Form1: TForm1;
  count:integer;
  Num:integer;

  PointSize:integer;
 // b:PChar;
implementation

{$R *.DFM}

//求两点P1,P2之间的距离
function Distance(P1,P2:TPoint):real;
begin
result:=sqrt((P1.x-P2.x)*(P1.x-P2.x)+(P1.y-P2.y)*(P1.y-P2.y));
end;
//比较两个数的大小；
function   Compare(a,b:Integer):integer;
begin
result:= a-b;
end;

function Nearest_Dotted_Pairs(var PointSet:array of TPoint;var u,v:integer):real;
var
X,Y:array of integer;

procedure Swap(var a,b:integer);  {交换a,b}
var
tmp:integer;
begin
tmp:=a;
a:=b;
b:=tmp;
end;

procedure  QSort(var a: array of Integer; const lo0, hi0: Integer);
var
  lo, hi, mid, t : Integer;
begin
  lo := lo0;
  hi := hi0;
  Application.ProcessMessages;

  if (lo < hi) then begin
    mid := (lo + hi) div 2;

    while (lo < hi) do begin
      while ((lo<hi) and (Compare(a[lo], a[mid]) < 0)) do inc(lo);

      while ((lo<hi) and (Compare(a[hi], a[mid]) > 0)) do dec(hi);

      if (lo < hi) then begin
        t := a[lo];
        a[lo] := a[hi];
        a[hi] := t;
      end;
    end;

    if (hi < lo) then begin
      t := hi;
      hi := lo;
      lo := t;
    end;

    QSort(a, lo0, lo);
    if (lo = lo0) then t := lo+1 else t := lo;
    QSort(a, t, hi0);
  end;
end;
procedure Init_ConquerandDive;   {初始化}
var
i,j,Xk,Yk:integer;
begin
setlength(X,Length(PointSet));
setlength(Y,Length(PointSet));
for i:=0 to high(PointSet) do  {初始化数组}
// high is equal the sizeof(array)/sizof(alenment);
 begin
  X[i]:=i;
  Y[i]:=i;
 end;
 QSort(X,0,high(PointSet));
 QSort(Y,0,high(PointSet));
end;
{函数NDP找出X[a..b]中的最近点对u,v（u,v指示点在PointSet中的下标），返回最近点对的距离；
 数组Y将X中的点按照y坐标递增排序；X始终保持按照x坐标递增排序}

function ConquerandDive(a,b:integer;var u,v:integer;var Y:array of integer):real;
var
Yl,Yr:array of integer;
d1,d2,d3:real;
i,j,t,ul,vl,ur,vr:integer;
begin
if b-a=1 then {如果X[a..b]中只有2个点，这两个点就是最近点对}
 begin
  result:=distance(PointSet[X[a]],PointSet[X[b]]);
  u:=X[a];
  v:=X[b];
  exit;
 end;
if b-a=2 then  {如果X[a..b]中只有3个点，就直接求出两两之间的距离，找到最近点对}
 begin
  d1:=distance(PointSet[X[a]],PointSet[X[a+1]]);
  d2:=distance(PointSet[X[a]],PointSet[X[a+2]]);
  d3:=distance(PointSet[X[a+1]],PointSet[X[a+2]]);
  if (d1<=d2)and(d1<=d3) then   {d1最小}
    begin
     u:=X[a];
     v:=X[a+1];
     result:=d1;
    end
   else
    if (d2<=d1)and(d2<=d3) then  {d2最小}
    begin
     u:=X[a];
     v:=X[a+2];
     result:=d2;
    end
    else      {d3最小}
    begin
     u:=X[a+1];
     v:=X[a+2];
     result:=d3;
    end;
   exit;
 end;
{对X[a..b]进行划分，划分为X[a..t]和X[t+1..b]，使两部分尽量平均}
t:=(a+b)div 2;
SetLength(Yl,0);
SetLength(Yr,0);
{将Y分割成Yl和Yr，使得Yl里的点属于X[a..t],Yr里的点属于X[t+1..b],并且按照y坐标递增排序}
for i:=0 to high(Y) do
 if PointSet[Y[i]].x<=PointSet[X[t]].x then  {说明点Y[i]属于X[a..t]}
      begin
       SetLength(Yl,Length(Yl)+1);
       Yl[High(Yl)]:=Y[i];
      end
 else begin
       SetLength(Yr,Length(Yr)+1);
       Yr[High(Yr)]:=Y[i];
      end;
{递归求出X[a..t]和X[t+1..b]中的最近点对}
d1:=ConquerandDive(a,t,ul,vl,Yl);
d2:=ConquerandDive(t+1,b,ur,vr,Yr);
{使d1成为左右两个区间内最近点对的距离，ul,vl为最近点对}
if d2<d1 then
 begin
   d1:=d2;
   ul:=ur;
   vl:=vr;
 end;
{将Y中以分界线l=PointSet[X[t]].x为中线，宽度为2*d1的带状区域内的点存储在Yl中}
setlength(Yl,0);
for i:=0 to high(Y) do
 if abs(PointSet[Y[i]].x-PointSet[X[t]].x)<=2*d1 then
  begin
   SetLength(Yl,Length(Yl)+1);
   Yl[High(Yl)]:=Y[i];
  end;
{对于Yl中的每一个点Yl[i]，计算Yl中其它点到它的距离，找出比d1小的值；
 根据抽屉原理知最多只要计算Yl[i]之后的7个点就可以了}
for i:=0 to high(Yl)-1 do
 for j:=i+1 to min(i+7,High(Yl)) do
  begin
   d2:=distance(PointSet[Yl[i]],PointSet[Yl[j]]);
   if d2<d1 then
    begin
     d1:=d2;
     ul:=Yl[i];
     vl:=Yl[j];
    end;
  end;
result:=d1;
u:=ul;
v:=vl;
end;


begin

Init_ConquerandDive; //初始化;
result:=ConquerandDive(0,high(X),u,v,Y);
end;

{==========================================================}

procedure GernateTestData(var PointSet:array of TPoint;count:integer);

var
i,j:integer;
begin

for i:=0 to count-1 do
  repeat
    //时期产生的点在举行范围之内；
    PointSet[i].x:=50+trunc(random(Pointright-PointLeft))+PointLeft;
    PointSet[i].y:=(trunc(random(Pointbottom-PointTop))+PointTop)-50;
    j:=0;
    //保证两点的距离大于10个像素；
    while (j<=i-1)and( (abs(PointSet[j].x-PointSet[i].x)>e)or(abs(PointSet[j].y-PointSet[i].y)>e))
     do inc(j);
  until j=i;
end;

procedure TForm1.DrawThepicture;

var
PointSet:array of TPoint;
len,i,j:integer;
u,v:integer;
nearest:real;
begin
count:=1;
j:=Num;
//canvas.Rectangle(PointLeft-5,PointTop-5,Pointright+5,Pointbottom+5);
//randomize;
//repeat
//count:= trunc(random(MaxPointsCount));
//until count>3;
for i:=1 to j do
begin
 count:=count*2;

end;

setlength(PointSet,count);
GernateTestData(PointSet,count);
//产生完随即数后；画圆；
for i:=0 to count-1 do canvas.Ellipse(PointSet[i].x-PointSize,PointSet[i].y-PointSize,PointSet[i].x+PointSize,PointSet[i].y+PointSize);

nearest:=Nearest_Dotted_Pairs(PointSet,u,v);
canvas.Pen.Color:=clGreen;
canvas.Pen.width:=4;
canvas.moveTo(PointSet[u].x,PointSet[u].y);
canvas.lineto(PointSet[v].x,PointSet[v].y);
canvas.Pen.width:=1;
canvas.Pen.Color:=clBlack;
Edit2.Text:=Floattostr(nearest);
Edit2.Show;
end;



procedure TForm1.Button1Click(Sender: TObject);
var   str:string;
begin
repaint;

//Edit1.GetTextBuf(b,sizeof(Edit1.GetTextLen()));

if(Edit1.Text='')
then
begin
ShowMessage('请输入一个1-10的数');
Exit;
end;

PointSize:=strtoint(Edit3.Text);
str:=Edit1.Text;
Num:=strtoint(str);
ShowMessage(format('%d',[Num]));
DrawThepicture;

end;
//画坐标，使用定时器；
procedure TForm1.Timer1Timer(Sender: TObject);
begin

canvas.Pen.Color:=clBlack;
canvas.Brush.Color:=clBlack;
canvas.MoveTo(PointLeft,Pointbottom);
canvas.Ellipse(PointLeft-10,Pointbottom,PointLeft,Pointbottom+10);
canvas.Brush.Color:=clWhite;
canvas.Textout(PointLeft+30,Pointbottom,'1');
canvas.TextOut(PointLeft+400,pointbottom,'10');
canvas.TextOut(PointLeft-5,Pointbottom-30,'1');
canvas.TextOut(PointLeft-13,Pointbottom-380,'10');  //
canvas.Pen.Color:=clred;
canvas.Brush.Color:=clBlack;
canvas.MoveTo(PointLeft,Pointbottom);
canvas.LineTo(PointLeft+500,Pointbottom);
canvas.LineTo(PointLeft+490,PointBottom-10);
canvas.MoveTo(PointLeft+500,Pointbottom);
canvas.LineTo(PointLeft+490,PointBottom+10);
canvas.MoveTo(PointLeft,Pointbottom);
canvas.LineTo(PointLeft+500,Pointbottom);
canvas.LineTo(PointLeft+495,PointBottom-5);
canvas.MoveTo(PointLeft+500,Pointbottom);
canvas.LineTo(PointLeft+495,PointBottom+5);
canvas.MoveTo(PointLeft,Pointbottom);
canvas.LineTo(pointLeft,PointBottom-400);
canvas.LineTo(pointLeft-10,Pointbottom-390);
canvas.MoveTo(pointLeft,Pointbottom-400);
canvas.LineTo(pointLeft+10,Pointbottom-390);
RichEdit1.Text:='在第一个输入框输入数字后产生2^n个随机数,当输入个数大时,像素应该小后点击确定按钮观察结果';
//canvas.MoveTo();
end;

end.