Avatar of Gryzn
Gryzn

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 ....
Visual Basic Classic

Avatar of undefined
Last Comment
Gryzn
Avatar of GrahamSkan
GrahamSkan
Flag of United Kingdom of Great Britain and Northern Ireland image

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


Avatar of Gryzn
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...
Avatar of GrahamSkan
GrahamSkan
Flag of United Kingdom of Great Britain and Northern Ireland image

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

Avatar of Gryzn
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?
Avatar of GrahamSkan
GrahamSkan
Flag of United Kingdom of Great Britain and Northern Ireland image

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?
Avatar of GrahamSkan
GrahamSkan
Flag of United Kingdom of Great Britain and Northern Ireland image

I have found configurations that give false negative results with that algorithm. I will have another look at it tomorrow.
ASKER CERTIFIED SOLUTION
Avatar of GrahamSkan
GrahamSkan
Flag of United Kingdom of Great Britain and Northern Ireland image

Blurred text
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
Avatar of Gryzn
Gryzn

ASKER

Wow, it works! Thank you for your effort.

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

Visual Basic Classic
Visual Basic Classic

Visual Basic is Microsoft’s event-driven programming language and integrated development environment (IDE) for its Component Object Model (COM) programming model. It is relatively easy to learn and use because of its graphical development features and BASIC heritage. It has been replaced with VB.NET, and is very similar to VBA (Visual Basic for Applications), the programming language for the Microsoft Office product line.

165K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
Ask the experts
Read over 600 more reviews

TRUSTED BY

IBM logoIntel logoMicrosoft logoUbisoft logoSAP logo
Qualcomm logoCitrix Systems logoWorkday logoErnst & Young logo
High performer badgeUsers love us badge
LinkedIn logoFacebook logoX logoInstagram logoTikTok logoYouTube logo