PDA

View Full Version : [SOLVED] Blockbusters Array



paulked
06-17-2015, 05:19 AM
Hi

I have made up a sheet containing a grid of 4x5 hexagons to re-create the 1980's gameshow "Blockbusters".

For those of you young enough(and lucky enough!) not to remember it, it was a quiz for two teams (1 person v 2 people) answering questions to cross a grid.

I would like to detect when a team has won, ie crossed the grid.

I have put the grid into two arrays, one for crossing left to right, and one for top to bottom.

I started writing code using IF statements:



Sub MyAlgArray()
Dim A() As Variant
A = Sheet1.Range("i12:m15")
'Line across top
If A(1, 1) = 1 And A(1, 2) = 1 Or A(1, 1) = 1 And A(2, 2) = 1 Then
If A(1, 3) = 1 And A(2, 4) = 1 And A(2, 5) Then MsgBox "Equal"
If A(1, 3) = 1 And A(1, 4) = 1 Or A(1, 3) = 1 And A(2, 4) = 1 Then
If A(1, 5) = 1 Then MsgBox "Equal"
End If
End If

'2nd line
If A(2, 1) = 1 And A(2, 2) = 1 Or A(2, 1) = 1 And A(3, 2) = 1 Then
If A(2, 3) = 1 And A(2, 4) = 1 And A(1, 5) Then MsgBox "Equal"
If A(2, 3) = 1 And A(3, 4) = 1 And A(3, 5) Then MsgBox "Equal"
If A(2, 3) = 1 And A(2, 4) = 1 Or A(2, 3) = 1 And A(3, 4) = 1 Then
If A(2, 5) = 1 Then MsgBox "Equal"
End If
End If
'3rd line
If A(3, 1) = 1 And A(3, 2) = 1 Or A(3, 1) = 1 And A(4, 2) = 1 Then
If A(3, 3) = 1 And A(3, 4) = 1 Or A(3, 3) = 1 And A(4, 4) = 1 Then
If A(3, 5) = 1 Then MsgBox "Equal"
End If
End If
'4th line
If A(4, 1) = 1 And A(4, 2) = 1 Then
If A(4, 2) = 1 And A(3, 3) = 1 Or A(4, 2) = 1 And A(4, 3) = 1 Then
If A(4, 4) = 1 And A(3, 5) = 1 Or A(4, 4) = 1 And A(4, 5) = 1 Then MsgBox "Equal"
End If
End If
End Sub


As you can see, this has got very messy very quickly, and this is just for the basic right to left crossing.

Any ideas how this can be done more efficiently?

Best regards

Paul Ked

Paul_Hossler
06-17-2015, 11:14 AM
I think I understood the game

If the worksheet grid was always 1's or 0's, it'd be simpler




Option Explicit
Dim A() As Variant

Sub CheckOnes()
Dim iRow As Long, iCol As Long

A = Sheet1.Range("i12:m15").Value

'make array only 1's and 0's
For iRow = LBound(A, 1) To UBound(A, 1)
For iCol = LBound(A, 2) To UBound(A, 2)
If Len(A(iRow, iCol)) = 0 Then
A(iRow, iCol) = 0
Else
A(iRow, iCol) = 1
End If
Next iCol
Next iRow

'check rows
For iRow = LBound(A, 1) To UBound(A, 1)
If pvtSumArray(iRow, 0) = UBound(A, 2) Then
MsgBox "Row " & iRow & " = " & UBound(A, 2)
End If
Next iRow

'check cols
For iCol = LBound(A, 2) To UBound(A, 2)
If pvtSumArray(0, iCol) = UBound(A, 1) Then
MsgBox "Column " & iCol & " = " & UBound(A, 1)
End If
Next iCol
End Sub

Private Function pvtSumArray(Optional iRowSum As Long = 0, Optional iColSum As Long = 0) As Long
Dim i As Long, iHold As Long

'sum accross row = iRowSum
If iRowSum > 0 Then
For i = LBound(A, 2) To UBound(A, 2)
iHold = iHold + A(iRowSum, i)
Next I

'sum down col = iColSum
ElseIf iColSum > 0 Then
For i = LBound(A, 1) To UBound(A, 1)
iHold = iHold + A(i, iColSum)
Next I
End If

pvtSumArray = iHold
End Function

paulked
06-17-2015, 12:38 PM
Hi Paul.

Thanks for reply, but unfortunately it doesn't solve the problem.

As the 'boxes' are hexagonal there are numerous connections to get from one side of the grid to the other (see modification to your book attached).

This is where the headache begins!

Best Regards

Paul Ked

PS. I have set up two arrays which are only ones and zeros, one array for team A (L to R) and the other for team B (T to B).

paulked
06-17-2015, 07:42 PM
Whilst digging around, I found this:




For each player, loop through all the cells; if the cell is owned by the player, and is adjacent on one if it's six sides to a cell 'marked' by this fill routine, then the cell gets marked too. Loop again through all the cells, and again until no cells get marked to the current player. Here's some pseudo-code:





for player in players:


# those on the starting edge that the player owns get 'marked'


for cells in cells.start_edge(player):


if cell.owner = player:


cell.mark = player


do:


count = 0


for cell in cells:


if cell.mark == None && cell.owner == player:


for adjacent in cell.neighbours:


if adjacent.mark == player


cell.owner = player


count += 1


break


while count


for cell in cells.stop_edge(player):


if cell.mark == player


player won!!





At this point, if any of the cells on the appropriate side of the board belong to the player, the player reached that side of the board.


I understand the logic but have no idea how to code it!

Any help would be appreciated

Best regards

Paul Ked

paulked
06-17-2015, 07:44 PM
?????

Don't know what happened, but last part went AWOL!

I understand the logic but don't know how to code it. Any help would be much appreciated.

Best regards

Paul Ked

ashleyrobbin
11-15-2015, 05:33 AM
solved problem?