• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 193
  • Last Modified:

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 ....
0
Gryzn
Asked:
Gryzn
  • 5
  • 3
1 Solution
 
GrahamSkanRetiredCommented:
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


0
 
GryznAuthor Commented:
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...
0
 
GrahamSkanRetiredCommented:
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

0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
GryznAuthor Commented:
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?
0
 
GrahamSkanRetiredCommented:
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?
0
 
GrahamSkanRetiredCommented:
I have found configurations that give false negative results with that algorithm. I will have another look at it tomorrow.
0
 
GrahamSkanRetiredCommented:
A configuration like this: (X = True, O = False)

OOOOOO
OXOOXO
OXXXXO
OXOOXO
OXXXXO

Started the checking with the two central Os in the second line, found that their box was one and gave up, missing the two enclosed two rows lower.
This code now has no pre-selection and simply tests every position.

Option Explicit
Dim Matrix(9, 9) As Integer
Dim Inside(9, 9) As Integer
Dim EnclosedPoints() As Point2D
Dim iPointCount As Integer
Const cUntested = 0
Const cInside = 1
Const cOutSide = 2

Private Sub Check1_Click(Index As Integer)
    'Dim LeftBorder As Integer
    Dim y As Integer
    Dim x As Integer
    Dim i As Integer
    Dim a As Integer
    Dim b As Integer
   Debug.Print "********************"
    Matrix(Index Mod 10, Int(Index / 10)) = Not Matrix(Index Mod 10, Int(Index / 10))
    'PlotMatrix
    For x = 0 To 9
        For y = 0 To 9
            Inside(x, y) = cUntested
        Next y
    Next x
    ReDim EnclosedPoints(0)
    iPointCount = 0
    For y = 0 To 9
        For x = 0 To 9
            If TestBorders(x, y) Then ' see if we can enumerate each cell without getting to an edge
                If iPointCount > 0 Then
                    Me.Text1.Text = ""
                    For i = 0 To iPointCount - 1
                        Me.Text1.Text = Me.Text1 & EnclosedPoints(i).x & "," & EnclosedPoints(i).y & "   "
                    Next i
                    Exit Sub
                End If
            Else
                Me.Text1.Text = "Open"
                For a = 0 To 9
                    For b = 0 To 9
                        If Inside(a, b) = cInside Then
                            Inside(a, b) = cOutSide 'tentative inside, now proved to be outside
                        End If
                    Next b
                Next a

                ReDim EnclosedPoints(0)
                iPointCount = 0
            End If
        Next x
    Next y
End Sub


Function TestBorders(x As Integer, y As Integer) As Boolean
    Debug.Print x, y,
    If Matrix(x, y) Then
        TestBorders = True 'designated border
        Exit Function
    End If
    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) = cOutSide Then
        TestBorders = False 'already in candidate list
        Exit Function
    End If
    If Inside(x, y) = cInside Then
        TestBorders = True 'already in candidate list
        Exit Function
    End If
    Inside(x, y) = cInside '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

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
0
 
GryznAuthor Commented:
Wow, it works! Thank you for your effort.

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

0

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now