Solved

how to produce this tree?

Posted on 2002-04-05
12
280 Views
Last Modified: 2010-04-04
how to produce this tree?

                       [        x,y     ]
                   /      |       |      \
             [x,y-1]  [x,y+1]  [x-1,y]  [x+1,y]
          /  |  |  \  ...........................
[x,y-1-1] [x,y-1+1] [x-1,y-1] [x+1,y-1]  
 
my program is error.

type
MyPointArr=array[1..4] of TPoint;

function Tsimulate.MyProc(MyPoint:TPoint):MyPointArr;
var
  TempPoint:TPoint;
  TempArrStore:MyPointArr;
begin
  TempPoint.X:=MyPoint.X;
  TempPoint.Y:=MyPoint.Y-1;
  TempArrStore[1]:=TempPoint;

  TempPoint.X:=MyPoint.X;
  TempPoint.Y:=MyPoint.Y+1;
  TempArrStore[2]:=TempPoint;

  TempPoint.X:=MyPoint.X-1;
  TempPoint.Y:=MyPoint.Y;
  TempArrStore[3]:=TempPoint;

  TempPoint.X:=MyPoint.X+1;
  TempPoint.Y:=MyPoint.Y;
  TempArrStore[4]:=TempPoint;

  result:=TempArrStore;
end;

thanks!
0
Comment
Question by:jbas
  • 6
  • 6
12 Comments
 
LVL 10

Expert Comment

by:Jacco
ID: 6922576
Your question needs rephrasing.

It all depends on how many levels deep you want to go. Do you want to use a tree structure? How do you want to navigate your tree? Do you want recursion? The way you describe it you will have lots of duplicate points in your tree.

X, Y = X + 1 - 1, Y etc

Regards Jacco
0
 

Author Comment

by:jbas
ID: 6922591
thanks!
 i want to produce a "Vornoi diagrami"
how to do?(through any ways)
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6922734
Here is a unit I produced. It is translated from a java implementation. It is not ment for very large vornoi diagrams. I translated the HashTable they used to a stringlist. This is not very nice. The "GetSource" could be eliminated. This should get you started anyway.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Contnrs, StdCtrls;

type
  TVoronoiPoint = class
  public
    X: Integer;
    Y: Integer;
    Z: Integer;
    constructor Create(aX, aY: Integer);
  end;

  TVoronoiTriangle = class
    p1, p2, p3, PC: TVoronoiPoint;
    constructor Create(aP1, aP2, aP3: TVoronoiPoint);
    procedure Draw(aCanvas: TCanvas);
  end;

  TVoronoiEdge = class
    p1, p2: TVoronoiPoint;
    constructor Create(aP1, aP2: TVoronoiPoint);
    procedure Draw(aCanvas: TCanvas; aSource: string);
  end;

  TForm1 = class(TForm)
    pbxVoronoi: TPaintBox;
    Label1: TLabel;
    procedure pbxVoronoiPaint(Sender: TObject);
    procedure pbxVoronoiMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    fPoints: TObjectList;
    fTriangles: TObjectList;
    fEdges: TStringList;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TVoronoiPoint }

constructor TVoronoiPoint.Create(aX, aY: Integer);
begin
  X := aX;
  Y := aY;
  Z := Sqr(X) + Sqr(Y);
end;

{ TVoronoiTriangle }

constructor TVoronoiTriangle.Create(aP1, aP2, aP3: TVoronoiPoint);
var
  dx2, dy2, dr2, dx3, dy3, dr3, A: Integer;
  dx, dy: Extended;
begin
  p1 := aP1;
  p2 := aP2;
  p3 := aP3;
  dx2 := p2.x - p1.x;
  dy2 := p2.y - p1.y;
  dr2 := dx2 * dx2 + dy2 * dy2;
  dx3 := p3.x - p1.x;
  dy3 := p3.y - p1.y;
  dr3 := dx3 * dx3 + dy3 * dy3;
  A := 2 * (dx2 * dy3 - dx3 * dy2);
  dx := (dr2 * dy3 - dr3 * dy2) / A;
  dy := (dx2 * dr3 - dx3 * dr2) / A;
  PC := TVoronoiPoint.Create(Round(p1.x + dx), Round(p1.y + dy));
end;

{ TVoronoiEdge }

constructor TVoronoiEdge.Create(aP1, aP2: TVoronoiPoint);
begin
  P1 := aP1;
  P2 := aP2;
end;

procedure TVoronoiEdge.Draw(aCanvas: TCanvas; aSource: string);
var
  dx, dy: Extended;
  v: Extended;
  sp1, sp2: TVoronoiPoint;

  procedure GetSource;
  var
    liPos: Integer;
  begin
    liPos := Pos('*', aSource);
    sp1 := TVoronoiPoint(Pointer(StrToInt(Copy(aSource, 1, liPos-1))));
    sp2 := TVoronoiPoint(Pointer(StrToInt(Copy(aSource, liPos+1, 100))));
  end;

begin
  aCanvas.MoveTo(p1.X, p1.Y);
  if (p2<>nil) then
  begin
    aCanvas.LineTo(p2.X, p2.Y);
  end else begin
    GetSource;
    dx := -(sp2.y - sp1.y);
    dy := (sp2.x - sp1.x);
    v := 1000 / Sqrt(Sqr(dx) + Sqr(dy));
    dx := dx * v;
    dy := dy * v;
    aCanvas.LineTo(Round(p1.X + dx), Round(p1.Y + dy));
  end;
end;

procedure TForm1.pbxVoronoiPaint(Sender: TObject);
var
  pi, pj, pk, pm, tmp: TVoronoiPoint;
  xn, yn, zn: Extended;
  i, j, k, m, p, idx: Integer;
  lTriangle: TVoronoiTriangle;
  lEdge: TVoronoiEdge;
begin
  if fTriangles.Count = 0 then
  begin
    // paint the voronoi
    for i := 0 to fPoints.Count-1 do
    begin
      pi := TVoronoiPoint(fPoints[i]);
      for j := i + 1 to fPoints.Count-1 do
      begin
        pj := TVoronoiPoint(fPoints[j]);
        for k := i + 1 to fPoints.Count-1 do
        begin
          pk := TVoronoiPoint(fPoints[k]);
          zn := (pj.x - pi.x) * (pk.y - pi.y) - (pk.x - pi.x) * (pj.y - pi.y);
          if (j = k) or (zn > 0) then
            Continue;
          xn := (pj.y - pi.y) * (pk.z - pi.z) - (pk.y - pi.y) * (pj.z - pi.z);
          yn := (pk.x - pi.x) * (pj.z - pi.z) - (pj.x - pi.x) * (pk.z - pi.z);
          idx := -1;
          for m := 0 to fPoints.Count-1 do
          begin
            pm := TVoronoiPoint(fPoints[m]);
            if (m<>i) and (m<>j) and (m<>k) and
               (((pm.x - pi.x) * xn + (pm.y - pi.y) * yn + (pm.z - pi.z) * zn) > 0) then
            begin
              idx := m;
              Break;
            end;
          end;
          if idx = -1 then
          begin
            lTriangle := TVoronoiTriangle.Create(pi, pj, pk);
            fTriangles.Add(lTriangle);
            for p := 0 to 2 do
            begin
              idx := fEdges.IndexOf(IntToStr(Integer(pi))+'*'+IntToStr(Integer(pj)));
              if idx = -1 then
                idx := fEdges.IndexOf(IntToStr(Integer(pj))+'*'+IntToStr(Integer(pi)));
              if idx = -1 then
              begin
                 fEdges.AddObject(
                   IntToStr(Integer(pi))+'*'+IntToStr(Integer(pj)),
                   TVoronoiEdge.Create(lTriangle.PC, nil)
                 );
              end else begin
                TVoronoiEdge(fEdges.Objects[idx]).p2 := lTriangle.PC;
              end;
              tmp := pi;
              pi := pj;
              pj := pk;
              pk := tmp;
            end;
          end;
        end;
      end;
    end;
  end;
  pbxVoronoi.Canvas.Brush.Color := clWhite;
  pbxVoronoi.Canvas.Pen.Color := clBlue;
  pbxVoronoi.Canvas.FillRect(pbxVoronoi.ClientRect);
  for i := 0 to fTriangles.Count-1 do
  begin
    TVoronoiTriangle(fTriangles[i]).Draw(pbxVoronoi.Canvas);
  end;
  pbxVoronoi.Canvas.Pen.Color := clGreen;
  for i := 0 to fEdges.Count-1 do
  begin
    lEdge := TVoronoiEdge(fEdges.Objects[i]);
    lEdge.Draw(pbxVoronoi.Canvas, fEdges[i]);
  end;
end;

procedure TForm1.pbxVoronoiMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  liEdge: Integer;
begin
  // add point
  fTriangles.Clear;
  for liEdge := 0 to fEdges.Count-1 do
    fEdges.Objects[liEdge].Free;
  fEdges.Clear;
  fPoints.Add(TVoronoiPoint.Create(X,Y));
  pbxVoronoi.Invalidate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  fPoints := TObjectList.Create;
  fTriangles := TObjectList.Create;
  fEdges := TStringList.Create;
  (*
  fPoints.Add(TVoronoiPoint.Create(0,0));
  fPoints.Add(TVoronoiPoint.Create(pbxVoronoi.Width-1,0));
  fPoints.Add(TVoronoiPoint.Create(0,pbxVoronoi.Height-1));
  fPoints.Add(TVoronoiPoint.Create(pbxVoronoi.Width-1,pbxVoronoi.Height-1));
  *)
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  liEdge: Integer;
begin
  fPoints.Free;
  fTriangles.Free;
  for liEdge := 0 to fEdges.Count-1 do
    fEdges.Objects[liEdge].Free;
  fEdges.Free;
end;

procedure TVoronoiTriangle.Draw(aCanvas: TCanvas);
begin
  aCanvas.MoveTo(p1.X, p1.Y);
  aCanvas.LineTo(p2.X, p2.Y);
  aCanvas.LineTo(p3.X, p3.Y);
  aCanvas.LineTo(p1.X, p1.Y);
end;

end.
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 10

Expert Comment

by:Jacco
ID: 6922735
0
 

Author Comment

by:jbas
ID: 6923703
to Jacco:
 thanks for you help!
i produced it ,but it not good.
please see here.
http://www26.brinkster.com/jbaswjy/default.htm
i will continue it...
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6924108
I have looked at your sources. You are trying to make the diagram using a kind of "flood fill" deterministic approach to building the diagram. I could change my implementation to do something like yours.

My appraoch uses a "brute force" mathematical approach. The sample I submitted as comment calculates all lines of the voronoi diagram. It is quit easy to change the program so that is fills the found diagram with colors.

Tell me what you want.

Regards Jacco
0
 
LVL 10

Expert Comment

by:Jacco
ID: 6924114
By the way you approuch will not give a real voronoi in the end because you "flood fill" only points that are white but they are not all at the same distence from the point in question.

if a point is (0,1) away it is length 1 away from the point
if a point is (1,1) away it is length sqrt(1^2 + 1^2) away which is roughly 0.707

If you want the floodfill approach you need to use points of concentric circles around the point.

Regards Jacco
0
 

Author Comment

by:jbas
ID: 6925211
thanks!
i want to simulation the grain growth.
so i need a Vornoi diagrami to do it.
i worked it again,and please see this source code.
i ameliorate the source code and the speed is faster.
you can change the parameter:StartCore,Split in globunit.pas,it will change the graph.
i will continue to change the code.example:let the graph grow hexagon,octagon.....

what are you think?

http://www26.brinkster.com/jbaswjy/source2.rar

ps:my english is poor,sorry!
 
0
 

Author Comment

by:jbas
ID: 6927452
to Jacco:
this code is my friend produced.please consult.

{
  nameFTXYLink
  authorFcreation_zy
}
type
  PXYLink=^XYLink;
  XYLink=record
    X,Y,Tag:Integer;
    Next:PXYLink;
  end;
  TXYLink=class
  private
    FPXYLink:PXYLink;
    FMemImg:array of array of Integer;
    FWidth,FHeight:Integer;
    FDefaultTag:Integer;
    procedure FreeList(var PList:PXYLink);
    procedure AddPointToList(X,Y,Tag:Integer;var PList:PXYLink);
  public
    procedure AddSeekPoint(X,Y,Tag:Integer);
    procedure SetPoint(X,Y:Integer;Value:Integer=0);
    function GetPoint(X,Y:Integer):Integer;
    procedure ExpandPointList;
    constructor Create(Width,Height,DefaultTag:Integer);
    destructor Destroy; override;
  end;

{ TXYLink }

procedure TXYLink.AddPointToList(X, Y, Tag: Integer; var PList: PXYLink);
var
  m:PXYLink;
begin
  New(m);
  m.X:=X;
  m.Y:=Y;
  m.Tag:=Tag;
  m.Next:=PList;
  PList:=m;
end;

procedure TXYLink.AddSeekPoint(X, Y, Tag: Integer);
begin
  AddPointToList(X,Y,Tag,FPXYLink);
end;

constructor TXYLink.Create(Width, Height, DefaultTag: Integer);
var
  i:Integer;
begin
  FPXYLink:=nil;
  FWidth:=Width;
  FHeight:=Height;
  FDefaultTag:=DefaultTag;
  SetLength(FMemImg,FWidth);
  for i:=0 to FWidth-1 do
  begin
    SetLength(FMemImg[i],FHeight);
    FillChar(FMemImg[i][0],FHeight*SizeOf(Boolean),0);
  end;
end;

destructor TXYLink.Destroy;
var
  i:Integer;
begin
  FreeList(FPXYLink);
  for i:=0 to FWidth-1 do
    SetLength(FMemImg[i],0);
  SetLength(FMemImg,0);
  inherited;
end;

procedure TXYLink.ExpandPointList;
var
  Head,pm:PXYLink;
  procedure TestAndAdd(x0,y0,tag:Integer);
  begin
    if (x0>=0) and (x0<FWidth) and (y0>=0) and (y0<FHeight) then
      if FMemImg[x0][y0]=FDefaultTag then //
      begin
        AddPointToList(x0,y0,tag,Head);
        FMemImg[x0][y0]:=tag;
      end;
  end;
begin
  Head:=nil;
  pm:=FPXYLink;
  while pm<>nil do
  begin
    with pm^ do
    begin
      TestAndAdd(X-1,Y,Tag);
      TestAndAdd(X+1,Y,Tag);
      TestAndAdd(X,Y-1,Tag);
      TestAndAdd(X,Y+1,Tag);
    end;
    pm:=pm.Next;
  end;
  FreeList(FPXYLink);
  FPXYLink:=Head;
end;

procedure TXYLink.FreeList(var PList: PXYLink);
var
  m:PXYLink;
begin
  m:=PList;
  while m<>nil do
  begin
    m:=PList.Next;
    Dispose(PList);
    PList:=m;
  end;
  PList:=nil;
end;

function TXYLink.GetPoint(X, Y: Integer): Integer;
begin
  Result:=FMemImg[X][Y];
end;

procedure TXYLink.SetPoint(X, Y: Integer; Value: Integer);
begin
  FMemImg[X][Y]:=Value;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  PointList:TXYLink;
  i,x,y:Integer;
begin
  PointList:=TXYLink.Create(200,200,Integer(clBlack)); //Integer(clBlack))=0
  PointList.AddSeekPoint(20,60,Integer(clWhite));
  PointList.AddSeekPoint(150,100,Integer(clRed));
  PointList.AddSeekPoint(80,130,Integer(clBlue));
  PointList.AddSeekPoint(99,133,Integer(clGreen));
  PointList.AddSeekPoint(166,39,Integer(rgb(50,150,255)));
  PointList.AddSeekPoint(77,150,Integer(rgb(100,230,200)));
  with Image1.Canvas do
    for i:=1 to 100 do //ExpandPoint 100 numbers.
    begin
      PointList.ExpandPointList;
      for x:=0 to 199 do
        for y:=0 to 199 do
          Pixels[x,y]:=TColor(PointList.GetPoint(x,y));
      Application.ProcessMessages;
    end;
  PointList.Free;
end;


 
0
 
LVL 10

Accepted Solution

by:
Jacco earned 100 total points
ID: 6928949
Looks good.

I do think though that eventually you will need circle shaped growth and not daimond or hexagon.

By the way, with the method you use you will not get voronoi diagrams. This is because your simulation is time dependant, end the voronoi diagram is a steady state equilibrium.

Haven't tested you new sources yet. I will produce a sample soon.

Regards Jacco
0
 

Author Comment

by:jbas
ID: 6964675
thanks.
0
 

Author Comment

by:jbas
ID: 6989622
thanks to Jacco!
  if you have finished,please tell me!

BTW:you is my first foreign friend,i fells good!
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Delphi Spellcheck in Webbrowser 1 47
Dev express lookupcombo 3 45
MS Access from Delphi 31 80
Way to create an iPhone app for my customers 8 43
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

749 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question