So I'm trying to write a program that will iterate through every possible permutation of 16 cells chosen from a grid of 40 (8x5) cells. To make the program run in feasible time, I'm excluding the top and bottom rows.

So it's essentially 24 choose 16.

For each permutation, it evaluates a score based on some properties about how many "chosen" cells are adjacent to each "unchosen" cell.

Problem is, when I run this, it only calls the makePermutation function about 25 times and it seems to pick 22 cells for its final answer

Here is my code:



Module Module1

'1 -> occupied by null value
'0 -> unoccupied


Dim bestValue As Integer = 0
Dim bestGrid(8, 5) As Integer
Dim width As Integer = 8
Dim height As Integer = 5

Sub Main()
Dim cells(8, 5) As Integer

For i = 0 To width - 1
For j = 0 To height - 1
cells(i, j) = 0
bestGrid(i, j) = 0
Next
Next

Dim startTime As Long = DateTime.Now.Ticks

makePermutations(cells, 0)

Dim endTime As Long = DateTime.Now.Ticks

outputResult(bestGrid, bestValue, startTime, endTime)

Console.ReadLine()
End Sub

Sub outputResult(ByVal bestGrid(,) As Integer, ByVal bestValue As Integer, ByVal startTime As Long, ByVal endTime As Long)
Dim outputLine As String = ""

Console.WriteLine("Runtime approx:" & vbTab & vbTab & Math.Round((endTime - startTime) / 10000) / 1000 & " s")
Console.WriteLine("Best Value found:" & vbTab & bestValue)
Console.WriteLine("Best Grid:")
For i = height - 1 To 0 Step -1
For j = 0 To width - 1
outputLine = outputLine & bestGrid(j, i)
Next
Console.WriteLine(outputLine)
outputLine = ""
Next
End Sub

Function evaluate(ByVal cells(,) As Integer) As Integer
Dim value As Integer = 0
Dim numAdjacent As Integer = 0

For i = 0 To width - 1
For j = 0 To height - 1
'if not a null value itself
If cells(i, j) = 0 Then
'count adjacent nulls to determine value
If i > 0 And j > 0 Then numAdjacent = numAdjacent + cells(i - 1, j - 1)
If i > 0 Then numAdjacent = numAdjacent + cells(i - 1, j)
If i > 0 And j < height - 1 Then numAdjacent = numAdjacent + cells(i - 1, j + 1)
If j > 0 Then numAdjacent = numAdjacent + cells(i, j - 1)
If j < height - 1 Then numAdjacent = numAdjacent + cells(i, j + 1)
If i < width - 1 And j > 0 Then numAdjacent = numAdjacent + cells(i + 1, j - 1)
If i < width - 1 Then numAdjacent = numAdjacent + cells(i + 1, j)
If i < width - 1 And j < height - 1 Then numAdjacent = numAdjacent + cells(i + 1, j + 1)

'augment value based on number of adjacent nulls
value = value + adjacentToValue(numAdjacent)

'reset numAdjacent for the next cell
numAdjacent = 0
End If
Next
Next

Return value
End Function

Function adjacentToValue(ByVal numAdjacent) As Integer
If numAdjacent = 0 Then
Return 1
ElseIf numAdjacent < 3 Then
Return 5
ElseIf numAdjacent < 5 Then
Return 20
ElseIf numAdjacent < 7 Then
Return 100
Else
Return 300
End If
End Function

Sub makePermutations(ByVal cells(,) As Integer, ByVal numNulls As Integer)
Dim currentValue As Integer = 0
If numNulls < 16 Then
'loop through all cells, i, excluding top row and bottom corners
For i = 0 To width - 1
For j = 1 To height - 2 '"1 to -2" excludes top and bottom row (excluding both to speed up testing)
'If cells(i, j) = 0 AndAlso Not (i = 0 And j = 0) AndAlso Not (i = width - 1 And j = 0) Then 'exclude bottom two corners
If cells(i, j) = 0 Then
makePermutations(cellsAppend(cells, i, j), numNulls + 1)
End If
Next j
Next i
Else
currentValue = evaluate(cells)
If currentValue > bestValue Then
bestValue = currentValue
For i = 0 To width - 1
For j = 0 To height - 1
bestGrid(i, j) = cells(i, j)
Next j
Next i
End If
End If
End Sub

Function cellsAppend(ByVal cells(,) As Integer, ByVal i As Integer, ByVal j As Integer) As Integer(,)
cells(i, j) = 1
Return cells
End Function
End Module


I'm worried it may be an issue of how I've setup my global variables.. or something to do with byval vs. byref.

I've never done much if anything with VB, so this may or may not be helpful, but just a general suggestion:

Using a debugger to step through code is priceless in these types of situations. You know what the code should be doing at certain points, so inspect variables at these points to make sure they match your expectations. In fact, this is likely the process mentally that someone who is reviewing the code would be going through.

I've identified one issue:

It's apparently not possible to pass arrays by value in vb.net It always passes the pointer to the array so it's always by reference.

Is there a way around this? It seems stupid to omit the ability to pass an array by value.

I'll have to copy the array to a new array, modify the new array, then return the new array.

Well I did a manual array copy in my cellsAppend function (which I assume is necessary so that I can pass a modified array to my recursive function without modifying it one level too high)

This worked.

I also had to tweak the algorithm so it would generate all permutations instead of all combinations. (permutations don't allow the same elements in different orders)