drawing a polygon around a series of data points 2

[LindaRichard]

I have an x-y diagram consisting of a few data points.
I would like to draw a line around these data points.
So essentially what I need is a routine to calculate the
polygon that contours these data points. I am not looking
for the routine to draw the polygon but only to calculate
the points that delimit this polygon. Does anyone know
where I can find such a routine.

Thanks for your help
Linda

 

[MichaelRed]

when you say 'line around', you do not indicate any degree of 'contour'. e.g. how 'closely' the line neeeds to follow or outline the points. Drawing a box (or just finding the points to do so) is quite simplistic. Doing a circle or ellispe is much more complicated.

some additional 'detail' of the goal might be helpful. an actual 'example' with discussion would better. where (for the discussion) you give a set of points and at least some discription of what you want the results to be.

MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[LindaRichard]

MichaelRead,

Thank's for your reply. I have an x-y plot of data
Here is a simple example:
(2,2) (3,2) (3,3) (3,4) (4,2) (4,3) (4,5) and (5,3)
(my data is actually precise to the 4 digit, eg. 27.4325)

I can draw by hand a polygon consiting of the points
(2,2) (3,4) (4,5) (3,5) (2,4) and (3,2)
which countours all of the data.
and the points (3,3) and (4,3) fall within the polygon

I am trying find a algorith or method to calculate the
polygon.

Thanks for your help

Linda

 

[strongm]

This is another of those superficially simple-looking problems that is, in fact, somehwat more complex than it appears (we recently had a thread concerning comparing images which falls under the same umbrella).

As MichaelRed points out, determing the bounding box is pretty simple (indeed the API actually has a call that can do this for you), but determining the genuine multipoint boundary of a polygon given any particular set of vertices is somewhat trickier; there are mathematical papers on the subject. As a pointer, do a search on the Web for the 'convex hull' problem. In fact, try here:

http://www.vb-helper.com/howto_convex_hull.html

 

[LindaRichard]

Strongm,

It's exactly what I am looking for.

Thank's for your help

Linda

 

[TheTuna]

Someone deserves a star, and this one should be from someone besides me. No Dolphins were harmed in the posting of this message... Dolphin Friendly Tuna!

 

[Hypetia]

I read this post in the morning and since then I was mentally stuck with it. The question was very simple and interesting, but solution was not as straight.

After doing a lot of geometrical manipulation, here is the solution. We have a function named [tt]Boundary[/tt]. Its signature is:

[tt]Private Function Boundary(Src() As POINT) As Long()[/tt]

It accepts an array of type [tt]POINT[/tt]. This UDT is used to specify the coordinates of set of points. This function returns an array of type [tt]Long[/tt]. This return array holds the indexes of those points which make up the bounding polygon. Plus the elements in this array are also in the right order, one after another corresponding to the vertices of the polygon.

All you have to do is create an array of type [tt]POINT[/tt], initialize its members and call the [tt]Boundary[/tt] function passing this array as argument. The function will return an array identifying those points which make up the bounding polygon. Here is the code.
[tt]
Option Explicit
Private Type POINT
X As Long
Y As Long
End Type
Const PI = 3.1415927

Private Function Angle(p0 As POINT, p1 As POINT, p2 As POINT) As Single
Dim a As Single, b As Single, c As Single, cosine
a = Distance(p0, p1)
b = Distance(p1, p2)
c = Distance(p0, p2)
cosine = (a * a + b * b - c * c) / (2 * a * b)
If cosine < 0 Then
Angle = Atn(Sqr(1 - cosine * cosine) / cosine)
ElseIf cosine > 0 Then
Angle = PI + PI - Atn(Sqr(1 - cosine * cosine) / cosine)
Else
Angle = PI / 2
End If
If Angle < 0 Then Angle = PI - Angle
End Function

Private Function Distance(p0 As POINT, p1 As POINT) As Single
Dim dP As POINT
dP.X = p1.X - p0.X
dP.Y = p1.Y - p0.Y
Distance = Sqr(dP.X * dP.X + dP.Y * dP.Y)
End Function

Private Function Boundary(Src() As POINT) As Long()
Dim N As Long, X As Long, P As POINT, Count As Long
Dim SmallAngle As Single, ThisAngle As Single, I() As Long

'There must be atleast 3 points in
'the collection to make a polygon.
If UBound(Src) < 2 Then Exit Function

'Set the dimension of the return array
'equal to the size of the source array.

'Internal array for temporary storage.
ReDim I(UBound(Src))

'Get the right most point in the source
'array and store its index in the first
'element of the return array.
I(0) = 0
X = Src(0).X
For N = 0 To UBound(Src)
If X < Src(N).X Then
X = Src(N).X
I(0) = N
End If
Next
Count = 1

'Get an arbitary point P below the
'right most point in the src array.
P.X = X
P.Y = Src(I(0)).Y + 1000

'Now find the next point which makes
'smallest angle with P, first point
'and with itself.
SmallAngle = PI + PI 'Initialize this value
'Try for each point in the source array.
For N = 0 To UBound(Src)
If I(0) <> N Then 'If it is not the first one...
'Calculate its angle.
ThisAngle = Angle(P, Src(I(0)), Src(N))
'If it makes a smaller angle then we need it.
If SmallAngle > ThisAngle Then
SmallAngle = ThisAngle
I(1) = N 'Make it second point in collection.
End If
End If
Next
Count = 2

'Now we have found two points for the return array.
'The rest of the points can be calculated with the
'following loop.
Do
'Initialize the Smallest angle to a large value.
SmallAngle = PI + PI

'Try for each point in the source array.
For N = 0 To UBound(Src)
'Make sure point is not already used.
For X = 0 To Count - 1
If I(X) = N Then GoTo TryNextOne
Next
'Calculate its angle with the previous
'two points in the collection.
ThisAngle = Angle(Src(I(Count - 2)), Src(I(Count - 1)), Src(N))
'If it makes a smaller angle then we need it.
If SmallAngle > ThisAngle Then
SmallAngle = ThisAngle
I(Count) = N 'Add this point to the collection.
End If
TryNextOne: 'Point is already used, try next one.
Next
Count = Count + 1
Loop Until UBound(I) = Count - 1

'Remove extra points from the collection.
For N = 2 To Count - 1
If Angle(Src(I(N - 2)), Src(I(N - 1)), Src(I(N))) > Angle(Src(I(N - 2)), Src(I(N - 1)), Src(I(0))) Then Exit For
Next
ReDim Preserve I(N - 1)
Boundary = I 'Return the result array.
End Function
[/tt]

To test this code, paste all the above code in a form.
Also add the following procedure to the form.

[tt]
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static PointCount As Long, P() As POINT
If Button = 1 Then
If PointCount = 0 Then Cls: AutoRedraw = True
ReDim Preserve P(PointCount)
P(PointCount).X = X
P(PointCount).Y = Y
ForeColor = vbBlack
DrawWidth = 2
PSet (X, Y)
Print PointCount
PointCount = PointCount + 1
Else
If UBound(P) < 2 Then Exit Sub
ForeColor = vbRed
DrawWidth = 1
Dim I() As Long
I = Boundary(P)
PSet (P(I(0)).X, P(I(0)).Y)
Dim N As Integer
For N = 0 To UBound(I)
Line -(P(I(N)).X, P(I(N)).Y)
Next
Line -(P(I(0)).X, P(I(0)).Y)
PointCount = 0
End If
End Sub
[/tt]

Run the program and randomly click on the form's client area. Numbered points will apprear on the form. After clicking several times, right click on the form once. A polygon will be drawn bounding all the points. The coordinates of this polygon are calculated with this [tt]Boundary[/tt] function. Try again by left clicking on the form repeatedly and then right clicking once.
I think it is exactly what you wanted.

One thing to note. At the moment, this function does not accept &quot;duplicate&quot; points and generates an error. So when passing the [tt]POINT[/tt] array to the function, make sure that there are no duplicate elements.

Please do tell me if it works.

 

[LindaRichard]

Hypetia,

Thanks for the program, it works great and does exactly what I wanted.

I made a sligth modification to allow for duplicate points and it seems to work.

Private Function Angle(p0 As POINT, p1 As POINT, p2 As POINT) As Single
Dim a As Single, b As Single, c As Single, cosine
a = Distance(p0, p1)
b = Distance(p1, p2)
c = Distance(p0, p2)
If a <> 0 And b <> 0 Then
cosine = (a * a + b * b - c * c) / (2 * a * b)
Else
cosine = 0
End If
If cosine < 0 Then
Angle = Atn(Sqr(1 - cosine * cosine) / cosine)
ElseIf cosine > 0 Then
Angle = PI + PI - Atn(Sqr(1 - cosine * cosine) / cosine)
Else
Angle = PI / 2
End If
If Angle < 0 Then Angle = PI - Angle
End Function

Thanks again for your help.

Linda

 

[CajunCenturion]

TheTuna - Your words are truer now more than ever. Good Luck
--------------
As a circle of light increases so does the circumference of darkness around it. - Albert Einstein

 

[johnwm]

Linda,

I notice that you've thanked people for a couple of the replies given (which is nice)

Looking at your member profile, I notice that you haven't as yet marked any replies to any of the questions that you've asked as 'Helpful/Expert posts'
I guess that's probably because you haven't noticed the link at the bottom left of each post ' Mark this post as a helpful/expert post!'

If you have found any of these replies either helpful or expert you might consider using the link to indicate it.

See also faq222-2244
________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first

'People who live in windowed environments shouldn't cast pointers.'

 

[TheTuna]

You see, the trick is, to click the link labeled Mark this post as a helpful/expert post! at which time a little pinkish-red colored shape, known as a star will appear beside the name of the user who's post was considered helpful and worthy of thanks. This action has many results. 1) the user who showed appreciation will have shown that they might be willing to give, instead of just take. 2) the user who is thanked gets recognition, and it builds their credibility among the users herein. 3) Said Thanked User will be inclined to continue to be helpful (ie. everyone likes a pat on the back now and then, you know, the ever beloved 'atta-boy' or 'atta-girl'...

This would be this threads originator's chance to show a bit of class as well... Go ahead, click the link and show your thanks! No Dolphins were harmed in the posting of this message... Dolphin Friendly Tuna!

 

[Hypetia]

Linda,

Thanks for your correction. I tested this modified version and found it to be running just fine. I am just going to update my program as well.
Thanks again *

 

[TheTuna]

[Surprise] No Dolphins were harmed in the posting of this message... Dolphin Friendly Tuna!

 

[LindaRichard]

You are correct,

I hadn't noticed the link: Mark this post as a helpful/expert post!
I will make sure to use it is the future.

Linda