asked on

How to detect the inner fields of a surrounded part of a matrix (array)?

I have a FieldMatrix of 10 to 10 Fields (may vary)
I'm gonna to set some Fields to TRUE
On every set, i have to check, if there is a closed border
If yes, I need the inner fields (x,y) of this border

Dim Matrix(9,9)

Matrix(2,3)=vbTrue
Matrix(3,4)=vbTrue
Matrix(2,5)=vbTrue
Matrix(3,6)=vbTrue
Matrix(4,7)=vbTrue
Matrix(5,3)=vbTrue
Matrix(5,4)=vbTrue
Matrix(5,5)=vbTrue
Matrix(5,6)=vbTrue
Matrix(5,2)=vbTrue
Matrix(4,1)=vbTrue

My Field now looks like this:

x 0 1 2 3 4 5 6 7 8 9
y
0 _ _ _ _ _ _ _ _ _ _
1 _ _ _ _ 1 _ _ _ _ _
2 _ _ _ _ _ 1 _ _ _ _
3 _ _ 1 _ _ 1 _ _ _ _
4 _ _ _ 1 _ 1 _ _ _ _
5 _ _ 1 _ _ 1 _ _ _ _
6 _ _ _ 1 _ 1 _ _ _ _
7 _ _ _ _ 1 _ _ _ _ _
8 _ _ _ _ _ _ _ _ _ _
9 _ _ _ _ _ _ _ _ _ _

Now I set this ...

Matrix(3,2)=vbTrue

... which results in a closed border

x 0 1 2 3 4 5 6 7 8 9
y
0 _ _ _ _ _ _ _ _ _ _
1 _ _ _ _ 1 _ _ _ _ _
2 _ _ _ 1 _ 1 _ _ _ _
3 _ _ 1 _ _ 1 _ _ _ _
4 _ _ _ 1 _ 1 _ _ _ _
5 _ _ 1 _ _ 1 _ _ _ _
6 _ _ _ 1 _ 1 _ _ _ _
7 _ _ _ _ 1 _ _ _ _ _
8 _ _ _ _ _ _ _ _ _ _
9 _ _ _ _ _ _ _ _ _ _

I need a function, that detects such a close and returns me all inner fields (here marked as 9)

x 0 1 2 3 4 5 6 7 8 9
y
0 _ _ _ _ _ _ _ _ _ _
1 _ _ _ _ 1 _ _ _ _ _
2 _ _ _ 1 9 1 _ _ _ _
3 _ _ 1 9 9 1 _ _ _ _
4 _ _ _ 1 9 1 _ _ _ _
5 _ _ 1 9 9 1 _ _ _ _
6 _ _ _ 1 9 1 _ _ _ _
7 _ _ _ _ 1 _ _ _ _ _
8 _ _ _ _ _ _ _ _ _ _
9 _ _ _ _ _ _ _ _ _ _

Something like: InnerFields=Inner(3,2)
In the example above, InnerFields should be 4,2 3,3 4,3 4,4 3,5 4,5 4,6 (Collection, Array,String does'nt matter)
If the passed x,y does not close a border, the return should be nothing of course

I spend a lot of hours to find a way, no success....

I hope, the problem is defined clearly ....

GrahamSkan

This code finds a possible enclosed point, then looks in all connected points recursively. If they are all mapped before reaching an edge of the matrix, the point is considered to be enclosed.

Option Explicit
Dim Matrix(9, 9) As Integer
Dim Inside(9, 9) As Boolean

Private Sub Command3_Click()
Dim LeftBorder As Integer
Dim RightBorder As Integer
Dim y As Integer
Dim x As Integer

Matrix(2, 3) = vbTrue
Matrix(3, 4) = vbTrue
Matrix(2, 5) = vbTrue
Matrix(3, 6) = vbTrue
Matrix(4, 7) = vbTrue
Matrix(5, 3) = vbTrue
Matrix(5, 4) = vbTrue
Matrix(5, 5) = vbTrue
Matrix(5, 6) = vbTrue
Matrix(5, 2) = vbTrue
Matrix(4, 1) = vbTrue

Matrix(3, 2) = vbTrue
For y = 0 To 9
LeftBorder = -1
RightBorder = -1
For x = 0 To 9
If Matrix(x, y) = -1 Then
If LeftBorder = -1 Then
LeftBorder = x
Else
If x > LeftBorder + 1 Then
If TestBorders(x - 1, y) Then
MsgBox "Enclosed"
Else
MsgBox "Open"
End If
Exit Sub
End If
End If
End If
Next x
Next y
End Sub

Function TestBorders(x As Integer, y As Integer) As Boolean
If x = 0 Or x = 9 Then
Exit Function
End If
If y = 0 Or y = 9 Then
Exit Function
End If
If Inside(x, y) Then
TestBorders = True
Exit Function
End If
If Matrix(x, y) Then
TestBorders = True
Exit Function
End If
Inside(x, y) = True
If TestBorders(x + 1, y) Then
If TestBorders(x - 1, y) Then
If TestBorders(x, y + 1) Then
If TestBorders(x, y - 1) Then
TestBorders = True
End If
End If
End If
End If
End Function

Gryzn

ASKER

Thanks GrahmanSkan

Looks good and I'm gonna to test it. If it work for all possiblities the first part is solved.

The second part is to return a list of the inside fields...

GrahamSkan

Ok This now collects the points in a user type array. There are also a few comments inserted..

In a module:

Option Explicit

Type Point2D
x As Integer
y As Integer
End Type

In a form (because it uses a command button)

Option Explicit
Dim Matrix(9, 9) As Integer
Dim Inside(9, 9) As Boolean
Dim EnclosedPoints() As Point2D
Dim iPointCount As Integer

Private Sub Command1_Click()
Dim LeftBorder As Integer
Dim y As Integer
Dim x As Integer
Dim i As Integer
Dim strMessage As String
Matrix(2, 3) = vbTrue
Matrix(3, 4) = vbTrue
Matrix(2, 5) = vbTrue
Matrix(3, 6) = vbTrue
Matrix(4, 7) = vbTrue
Matrix(5, 3) = vbTrue
Matrix(5, 4) = vbTrue
Matrix(5, 5) = vbTrue
Matrix(5, 6) = vbTrue
Matrix(5, 2) = vbTrue
Matrix(4, 1) = vbTrue

Matrix(3, 2) = vbTrue
For y = 0 To 9
LeftBorder = -1
For x = 0 To 9
If Matrix(x, y) = -1 Then
If LeftBorder = -1 Then 'as initialised
LeftBorder = x 'First border found
Else
If x > LeftBorder + 1 Then 'Inner candidate if there is space between left and right borders?
If TestBorders(x - 1, y) Then ' see if we can enumerate each cell without getting to an edge
strMessage = "Enclosed"
For i = 0 To iPointCount - 1
strMessage = strMessage & vbCrLf & "x:" & EnclosedPoints(i).x & ", y:" & EnclosedPoints(i).y
Next i
MsgBox strMessage
Else
MsgBox "Open"
End If
Exit Sub
End If
End If
End If
Next x
Next y
End Sub

Function TestBorders(x As Integer, y As Integer) As Boolean
If x = 0 Or x = 9 Then
Exit Function 'left or right edge
End If
If y = 0 Or y = 9 Then
Exit Function 'top or bottom
End If
If Inside(x, y) Then
TestBorders = True 'already in candidate list
Exit Function
End If
If Matrix(x, y) Then
TestBorders = True 'designated border
Exit Function
End If
Inside(x, y) = True 'plot new inside candidate on Inside map

'save new candidate
ReDim Preserve EnclosedPoints(iPointCount)
EnclosedPoints(iPointCount).x = x
EnclosedPoints(iPointCount).y = y
iPointCount = iPointCount + 1

'test adjacent cell in each direction
If TestBorders(x + 1, y) Then
If TestBorders(x - 1, y) Then
If TestBorders(x, y + 1) Then
If TestBorders(x, y - 1) Then
TestBorders = True
End If
End If
End If
End If
End Function

Gryzn

ASKER

Either your function does not work as it should or I've made some mistake somehow ...

I have changed the form and use a checkbox matrix to check the result returned by the function on differrent states.

Each time you change a checkbox in the matrix, your function is called and we can check the results immediately.

Add to Form1 :

Checkbox Check1 with Index 0
Textbox Text1

Option Explicit
Dim Matrix(9, 9) As Integer
Dim Inside(9, 9) As Boolean
Dim EnclosedPoints() As Point2D
Dim iPointCount As Integer

Private Sub Form_Load()
Dim i, x, y

For y = 0 To 9
For x = 0 To 9
Matrix(x, y) = False
i = y * 10 + x
If i > 0 Then
Load Check1(i)
Check1(i).Left = Check1(i).Left + 200 * x
Check1(i).Top = Check1(i).Top + 200 * y
Check1(i).Visible = True
End If
Next x
Next y
End Sub

Private Sub Check1_Click(Index As Integer)

Dim LeftBorder As Integer
Dim y As Integer
Dim x As Integer
Dim i As Integer
Me.Text1 = ""

Matrix(Index Mod 10, Int(Index / 10)) = Not Matrix(Index Mod 10, Int(Index / 10))
PlotMatrix

For y = 0 To 9
LeftBorder = -1
For x = 0 To 9
If Matrix(x, y) = -1 Then
If LeftBorder = -1 Then 'as initialised
LeftBorder = x 'First border found
Else
If x > LeftBorder + 1 Then 'Inner candidate if there is space between left and right borders?
If TestBorders(x - 1, y) Then ' see if we can enumerate each cell without getting to an edge
For i = 0 To iPointCount - 1
Me.Text1 = Me.Text1 & EnclosedPoints(i).x & "," & EnclosedPoints(i).y & " "
Next i
Else
Me.Text1 = "Open"
End If
Exit Sub
End If
End If
End If
Next x
Next y
End Sub

Function TestBorders(x As Integer, y As Integer) As Boolean
If x = 0 Or x = 9 Then
Exit Function 'left or right edge
End If
If y = 0 Or y = 9 Then
Exit Function 'top or bottom
End If
If Inside(x, y) Then
TestBorders = True 'already in candidate list
Exit Function
End If
If Matrix(x, y) Then
TestBorders = True 'designated border
Exit Function
End If
Inside(x, y) = True 'plot new inside candidate on Inside map

'save new candidate
ReDim Preserve EnclosedPoints(iPointCount)
EnclosedPoints(iPointCount).x = x
EnclosedPoints(iPointCount).y = y
iPointCount = iPointCount + 1

'test adjacent cell in each direction
If TestBorders(x + 1, y) Then
If TestBorders(x - 1, y) Then
If TestBorders(x, y + 1) Then
If TestBorders(x, y - 1) Then
TestBorders = True
End If
End If
End If
End If
End Function

So where I an wrong?

GrahamSkan

A couple of points. I don't know what PlotMatrix does.
Also, several things will need resetting:

'PlotMatrix ?
For x = 0 To 9
For y = 0 To 9
Inside(x, y) = False
Next y
Next x
ReDim EnclosedPoints(0)
iPointCount = 0

If you already have these points covered, can you give a clue about what goes wrong?

GrahamSkan

I have found configurations that give false negative results with that algorithm. I will have another look at it tomorrow.

ASKER CERTIFIED SOLUTION

GrahamSkan

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Gryzn

ASKER

Wow, it works! Thank you for your effort.

Since I always struggling with recursive functions, you prevented me from that pain.