Public Group

Permutations of cells in a Grid

This topic is 2495 days old which is more than the 365 day threshold we allow for new replies. Please post a new topic.

Recommended Posts

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.

Share on other sites
I don't see anything offhand incorrect, but I'm not particularly familiar with VB.

Share on other sites
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.

Share on other sites
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.

Share on other sites
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)

• What is your GameDev Story?

In 2019 we are celebrating 20 years of GameDev.net! Share your GameDev Story with us.

(You must login to your GameDev.net account.)

• 10
• 11
• 13
• 9
• 11
• Forum Statistics

• Total Topics
634090
• Total Posts
3015430
×