Gems game step calculation, in other word some math

Question

I have a program that scans an image and converts gems to specific numbers. Look at the picture below:

enter image description here

So i have a table with numbers. Number 1 is for yellow gem, 2 for blue, etc...

Like:

    A  B  C  D  E
1 | 1  2  3  4  5
2 | 3  5  2  4  1
3 | 1  4  4  1  2
4 | 3  3  2  1  5
5 | 5  1  5  2  5

I want to calculate a step, to get 3 equal numbers (gems) horizontally or vertically. For example, in this table if i swap E2 with D2, D2 will be 1, and D2,D3,D4 creates a valid step, because it's all 1. I'm using VB.NET 2010.

My table is 8x8 size, it's just an example above.

At now i'm just have the values in multiple variables (A1=1, A2=3, so on..)

I hope you understand my question, any help would be appreciated.

Basically you're creating a program to solve Bejeweled. Considering there are sites that pay cash prizes for winners every day, wouldn't this be sort of illegal (on those sites at least)? — Lasse V. Karlsen, Feb 28 '11 at 10:48
I just want to solve for fun, not for winning prizes, or stg else.. Anyway bejeweled2 for example is just a pc game and you wont win anything. — WorK, Feb 28 '11 at 10:59
So what is your question then? You already know how to play the game, what part of this is it that you're having problems implementing? Have you tried brute-forcing it by just replacing every combination of two gems and seeing if that results in a 3+ in a row solution? — Lasse V. Karlsen, Feb 28 '11 at 11:05
You're essentially looking for a Bejeweled solver right? I'll try working on it this evening when I close from work. — Alex Essilfie, Feb 28 '11 at 11:08
@Lassse: I havent tried it yet, but i want to solve time-based bejeweled table with some AI help. I know i maybe need to put the variables into array(s) and do matrix swap and check for 3 equal items in both directions. This is what i know, but i dont know how to do these in VB. Mainly i'm a PHP coder. @Alex: Yeah, right, i want to code one solver. — WorK, Feb 28 '11 at 11:08
@Alex: It's good. I have now a 8x8 table and each value. Maybe you can help me to solve my array too. Also i'm at work too. :) — WorK, Feb 28 '11 at 11:13
Can you tell me more about the rules of the game? You 'swap' a pair of gems, and if it ends up with a sequence of three identical gems....you earn points? Do they disappear after that, and if so, do the other gems 'fall' down? Or do the gaps just remain. To 'win' do you need to remove all the gems? — Rob P., Feb 28 '11 at 20:23

score 1 · Accepted Answer · edited May 23 '17 at 12:07

Here you go:

Module Module1

    Sub Main()
        Dim input = {{1, 3, 2, 4, 1, 1, 2, 1},
                     {1, 2, 5, 3, 2, 1, 3, 4},
                     {2, 1, 5, 4, 3, 2, 5, 4},
                     {3, 5, 1, 5, 2, 4, 1, 2},
                     {4, 2, 5, 1, 5, 2, 4, 2},
                     {2, 3, 2, 2, 5, 1, 3, 1},
                     {2, 1, 5, 4, 3, 2, 5, 4},
                     {3, 5, 1, 3, 2, 4, 1, 2}}

        Console.WriteLine("INPUT:")
        Console.Write("   |")
        For i = 1 To input.GetLength(1)
            Console.Write("{0,3}", GetColumnName(i))
        Next
        Console.Write(vbCrLf)
        Console.Write("---+")
        For i = 1 To input.GetLength(1)
            Console.Write("---")
        Next
        Console.Write(vbCrLf)

        For y = 0 To input.GetUpperBound(0)
            Console.Write("{0,3}|", y + 1)
            For x = 0 To input.GetUpperBound(1)
                Console.Write("{0,3}", input(y, x))
            Next
            Console.Write(vbCrLf)
        Next

        Console.WriteLine("{0}{0}SOLUTION:", vbCrLf)
        For Each match In Solve(input)
            Console.WriteLine("Move {0} {1} for a match of {2}", match.Item1, match.Item2, match.Item3)
        Next
        Console.ReadLine()
    End Sub

    Function Solve(ByVal input As Integer(,)) As IEnumerable(Of Tuple(Of String, Char, Integer))
        Dim matches As New List(Of Tuple(Of String, Char, Integer))
        Dim result As Tuple(Of Boolean, Tuple(Of String, Char, Integer))
        Dim test As Integer(,)

        Dim maxX = input.GetUpperBound(0) - 1
        Dim maxY = input.GetUpperBound(1) - 1

        For x = 0 To maxX
            For y = 0 To maxY
                ReDim test(If(maxX - x > 4, 3, maxX - x), If(maxY - y > 4, 3, maxY - y))
                For x1 = x To x + test.GetLength(0) - 1
                    For y1 = y To y + test.GetLength(1) - 1
                        test(x1 - x, y1 - y) = input(y1, x1)
                    Next
                Next

                'check if the result is a match
                For Each result In {IsMatchOnThird(test), IsMatchOnSecond(test), IsMatchOnFirst(test)}  '<-- Updated Line
                    If result.Item1 = True Then
                        Dim matchPoint = Tuple.Create(CInt(result.Item2.Item1.Split(","c)(0)),
                                                      CInt(result.Item2.Item1.Split(","c)(1)))

                        matches.Add(Tuple.Create(GetColumnName(matchPoint.Item1 + x + 1) & CStr(matchPoint.Item2 + y + 1),
                                                 result.Item2.Item2, result.Item2.Item3))
                    End If
                Next
            Next
        Next

        Return RemoveDuplicates(matches)
    End Function

   Public Function GetColumnName(ByVal colIndex As Integer) As String
        Dim result As New List(Of String)

        Do While colIndex > 0
            result.Insert(0, Chr(65 + CInt((colIndex - 1) Mod 26)))
            colIndex = (colIndex - 1) \ 26
        Loop

        Return String.Join("", result.ToArray)
    End Function

    Function RemoveDuplicates(ByVal list As IEnumerable(Of Tuple(Of String, Char, Integer))) As IEnumerable(Of Tuple(Of String, Char, Integer))

        'remove those where gems and swap direction are the same
        Dim l = (From i In list Order By i.Item3 Descending, i.Item1, i.Item2).ToList
        For i = l.Count - 1 To 1 Step -1
            If (l(i).Item1 = l(i - 1).Item1) AndAlso (l(i).Item2 = l(i - 1).Item2) Then
                l.RemoveAt(i)
            End If
        Next

        l = (From i In list Order By i.Item1, i.Item3 Descending).ToList
        For i = l.Count - 1 To 1 Step -1
            If (l(i).Item1 = l(i - 1).Item1) AndAlso (l(i).Item2 = l(i - 1).Item2) Then
                l.RemoveAt(i)
            End If
        Next

        Return From i In l Order By i.Item3 Descending, i.Item1
    End Function

    Function IsMatchOnThird(ByVal input As Integer(,)) As Tuple(Of Boolean, Tuple(Of String, Char, Integer))
        Dim size = Math.Min(input.GetLength(0), 4).ToString & "C," & Math.Min(input.GetLength(1), 4).ToString & "R"
        Dim i = input
        Dim isValid = Function(test As Integer()) test.All(Function(v) v = test(0))


        Select Case size
            Case "4C,4R"
                If isValid({i(0, 0), i(0, 1), i(1, 2)}) Then
                    Return Tuple.Create(True, Tuple.Create("1,2", "L"c, If(isValid({i(0, 0), i(0, 3)}), 4, 3)))
                ElseIf isValid({i(1, 0), i(1, 1), i(0, 2)}) Then
                    Return Tuple.Create(True, Tuple.Create("0,2", "R"c, If(isValid({i(1, 0), i(1, 3)}), 4, 3)))
                ElseIf isValid({i(0, 0), i(1, 0), i(2, 1)}) Then
                    Return Tuple.Create(True, Tuple.Create("2,1", "U"c, If(isValid({i(0, 1), i(3, 0)}), 4, 3)))
                ElseIf isValid({i(0, 1), i(1, 1), i(2, 0)}) Then
                    Return Tuple.Create(True, Tuple.Create("2,0", "D"c, If(isValid({i(0, 1), i(3, 1)}), 4, 3)))
                End If
            Case "4C,3R"
                If isValid({i(0, 0), i(0, 1), i(1, 2)}) Then
                    Return Tuple.Create(True, Tuple.Create("1,2", "L"c, 3))
                ElseIf isValid({i(1, 0), i(1, 1), i(0, 2)}) Then
                    Return Tuple.Create(True, Tuple.Create("0,2", "R"c, 3))
                ElseIf isValid({i(0, 0), i(1, 0), i(2, 1)}) Then
                    Return Tuple.Create(True, Tuple.Create("2,1", "U"c, If(isValid({i(0, 1), i(3, 0)}), 4, 3)))
                ElseIf isValid({i(0, 1), i(1, 1), i(2, 0)}) Then
                    Return Tuple.Create(True, Tuple.Create("2,0", "D"c, If(isValid({i(0, 1), i(3, 1)}), 4, 3)))
                End If
            Case "4C,2R"
                If isValid({i(0, 0), i(1, 0), i(2, 1)}) Then
                    Return Tuple.Create(True, Tuple.Create("2,1", "U"c, If(isValid({i(0, 1), i(3, 0)}), 4, 3)))
                ElseIf isValid({i(0, 1), i(1, 1), i(2, 0)}) Then
                    Return Tuple.Create(True, Tuple.Create("2,0", "D"c, If(isValid({i(0, 1), i(3, 1)}), 4, 3)))
                End If
            Case "3C,4R"
                If isValid({i(0, 0), i(0, 1), i(1, 2)}) Then
                    Return Tuple.Create(True, Tuple.Create("1,2", "L"c, If(isValid({i(0, 0), i(0, 3)}), 4, 3)))
                ElseIf isValid({i(1, 0), i(1, 1), i(0, 2)}) Then
                    Return Tuple.Create(True, Tuple.Create("0,2", "R"c, If(isValid({i(1, 0), i(1, 3)}), 4, 3)))
                ElseIf isValid({i(0, 0), i(1, 0), i(2, 1)}) Then
                    Return Tuple.Create(True, Tuple.Create("2,1", "U"c, 3))
                ElseIf isValid({i(0, 1), i(1, 1), i(2, 0)}) Then
                    Return Tuple.Create(True, Tuple.Create("2,0", "D"c, 3))
                End If
            Case "3C,3R"
                If isValid({i(0, 0), i(0, 1), i(1, 2)}) Then
                    Return Tuple.Create(True, Tuple.Create("1,2", "L"c, 3))
                ElseIf isValid({i(1, 0), i(1, 1), i(0, 2)}) Then
                    Return Tuple.Create(True, Tuple.Create("0,2", "R"c, 3))
                ElseIf isValid({i(0, 0), i(1, 0), i(2, 1)}) Then
                    Return Tuple.Create(True, Tuple.Create("2,1", "U"c, 3))
                ElseIf isValid({i(0, 1), i(1, 1), i(2, 0)}) Then
                    Return Tuple.Create(True, Tuple.Create("2,0", "D"c, 3))
                End If
            Case "3C,2R"
                If isValid({i(0, 0), i(1, 0), i(2, 1)}) Then
                    Return Tuple.Create(True, Tuple.Create("2,1", "U"c, 3))
                ElseIf isValid({i(0, 1), i(1, 1), i(2, 0)}) Then
                    Return Tuple.Create(True, Tuple.Create("2,0", "D"c, 3))
                End If
            Case "2C,4R"
                If isValid({i(0, 0), i(0, 1), i(1, 1)}) Then
                    Return Tuple.Create(True, Tuple.Create("1,1", "L"c, If(isValid({i(0, 1), i(0, 3)}), 4, 3)))
                ElseIf isValid({i(1, 0), i(1, 1), i(0, 2)}) Then
                    Return Tuple.Create(True, Tuple.Create("0,2", "R"c, If(isValid({i(1, 0), i(1, 3)}), 4, 3)))
                End If
            Case "2C,3R"
                If isValid({i(0, 0), i(0, 1), i(1, 1)}) Then
                    Return Tuple.Create(True, Tuple.Create("1,1", "L"c, 3))
                ElseIf isValid({i(1, 0), i(1, 1), i(0, 2)}) Then
                    Return Tuple.Create(True, Tuple.Create("0,2", "R"c, 3))
                End If
        End Select

        Return Tuple.Create(False, Tuple.Create("None", "."c, 0))
    End Function

    Function IsMatchOnSecond(ByVal input As Integer(,)) As Tuple(Of Boolean, Tuple(Of String, Char, Integer))
        Dim i = input
        Dim isValid = Function(test As Integer()) test.All(Function(v) v = test(0))
        Dim xLength = input.GetLength(0)
        Dim yLength = input.GetLength(1)

        If xLength >= 3 AndAlso yLength >= 3 Then
            If isValid({i(0, 0), i(1, 1), i(0, 2)}) Then
                Return Tuple.Create(True, Tuple.Create("1,1", "L"c, 3))
            ElseIf isValid({i(1, 0), i(2, 1), i(1, 2)}) Then
                Return Tuple.Create(True, Tuple.Create("2,1", "L"c, 3))
            ElseIf isValid({i(1, 0), i(0, 1), i(1, 2)}) Then
                Return Tuple.Create(True, Tuple.Create("0,1", "R"c, 3))
            ElseIf isValid({i(2, 0), i(1, 1), i(2, 2)}) Then
                Return Tuple.Create(True, Tuple.Create("1,1", "R"c, 3))
            ElseIf isValid({i(0, 0), i(1, 1), i(2, 0)}) Then
                Return Tuple.Create(True, Tuple.Create("1,1", "U"c, 3))
            ElseIf isValid({i(0, 1), i(1, 2), i(2, 1)}) Then
                Return Tuple.Create(True, Tuple.Create("1,2", "U"c, 3))
            ElseIf isValid({i(0, 2), i(1, 1), i(2, 2)}) Then
                Return Tuple.Create(True, Tuple.Create("1,1", "D"c, 3))
            ElseIf isValid({i(0, 1), i(1, 0), i(2, 1)}) Then
                Return Tuple.Create(True, Tuple.Create("1,0", "D"c, 3))
            End If
        End If

        Return Tuple.Create(False, Tuple.Create("None", "."c, 0))
    End Function

    Private Function IsMatchOnFirst(ByVal input As Integer(,)) As Tuple(Of Boolean, Tuple(Of String, Char, Integer)) '<-- New method
        Dim i = input
        Dim isValid = Function(test As Integer()) test.All(Function(v) v = test(0))
        Dim xLength = input.GetLength(0)
        Dim yLength = input.GetLength(1)

        If xLength >= 3 AndAlso yLength >= 3 Then
            If isValid({i(0, 0), i(1, 1), i(1, 2)}) Then
                Return Tuple.Create(True, Tuple.Create("0,0", "R"c, 3))
            ElseIf isValid({i(1, 0), i(2, 1), i(2, 2)}) Then
                Return Tuple.Create(True, Tuple.Create("1,0", "R"c, 3))
            ElseIf isValid({i(2, 0), i(1, 1), i(1, 2)}) Then
                Return Tuple.Create(True, Tuple.Create("2,0", "L"c, 3))
            ElseIf isValid({i(1, 0), i(0, 1), i(0, 2)}) Then
                Return Tuple.Create(True, Tuple.Create("1,0", "L"c, 3))
            ElseIf isValid({i(0, 0), i(1, 1), i(2, 1)}) Then
                Return Tuple.Create(True, Tuple.Create("0,0", "D"c, 3))
            ElseIf isValid({i(0, 1), i(1, 2), i(2, 2)}) Then
                Return Tuple.Create(True, Tuple.Create("0,1", "D"c, 3))
            ElseIf isValid({i(0, 1), i(1, 0), i(2, 0)}) Then
                Return Tuple.Create(True, Tuple.Create("0,1", "U"c, 3))
            ElseIf isValid({i(0, 2), i(1, 1), i(2, 1)}) Then
                Return Tuple.Create(True, Tuple.Create("0,2", "U"c, 3))
            End If
        End If

        Return Tuple.Create(False, Tuple.Create("None", "."c, 0))
    End Function
End Module

And here is the tuple class I used.
BTW: I converted the it from C# to VB.NET from a question on StackOverflow

Imports System.Collections.Generic

Public Class Tuple(Of T1, T2, T3)
    Inherits Tuple(Of T1, T2)
    Implements IEqualityComparer(Of Tuple(Of T1, T2, T3))

    Private _third As T3

    Public Sub New(ByVal item1 As T1, ByVal item2 As T2, ByVal item3 As T3)
        MyBase.New(item1, item2)
        _third = item3
    End Sub

    Public Property Item3() As T3
        Get
            Return _third
        End Get
        Private Set(ByVal value As T3)
            _third = value
        End Set
    End Property

    Public Overloads Function Equals(ByVal x As Tuple(Of T1, T2, T3), ByVal y As Tuple(Of T1, T2, T3)) As Boolean Implements IEqualityComparer(Of Tuple(Of T1, T2, T3)).Equals
        Return EqualityComparer(Of T1).[Default].Equals(x.Item1, y.Item1) AndAlso EqualityComparer(Of T2).[Default].Equals(x.Item2, y.Item2) AndAlso EqualityComparer(Of T3).[Default].Equals(x.Item3, y.Item3)
    End Function

    Public Overrides Function Equals(ByVal obj As Object) As Boolean
        Return TypeOf obj Is Tuple(Of T1, T2, T3) AndAlso Equals(Me, DirectCast(obj, Tuple(Of T1, T2, T3)))
    End Function

    Public Overloads Function GetHashCode(ByVal obj As Tuple(Of T1, T2, T3)) As Integer Implements IEqualityComparer(Of Tuple(Of T1, T2, T3)).GetHashCode
        Return EqualityComparer(Of T1).[Default].GetHashCode(Item1) Xor EqualityComparer(Of T2).[Default].GetHashCode(Item2) Xor EqualityComparer(Of T3).[Default].GetHashCode(Item3)
    End Function

    Public Shared Shadows Operator =(ByVal left As Tuple(Of T1, T2, T3), ByVal right As Tuple(Of T1, T2, T3)) As Boolean
        If DirectCast(left, Object) Is Nothing AndAlso DirectCast(right, Object) Is Nothing Then
            Return True
        End If

        Return left.Equals(right)
    End Operator

    Public Shared Shadows Operator <>(ByVal left As Tuple(Of T1, T2, T3), ByVal right As Tuple(Of T1, T2, T3)) As Boolean
        If DirectCast(left, Object) Is Nothing AndAlso DirectCast(right, Object) Is Nothing Then
            Return False
        End If

        Return Not left.Equals(right)
    End Operator
End Class

Public Class Tuple(Of T1, T2)
    Implements IEqualityComparer(Of Tuple(Of T1, T2))

    Public Property Item1() As T1
        Get
            Return _first
        End Get
        Private Set(ByVal value As T1)
            _first = value
        End Set
    End Property
    Private _first As T1

    Public Property Item2() As T2
        Get
            Return _second
        End Get
        Private Set(ByVal value As T2)
            _second = value
        End Set
    End Property
    Private _second As T2

    Public Sub New(ByVal item1 As T1, ByVal item2 As T2)
        _first = item1
        _second = item2
    End Sub

    Public Overloads Function Equals(ByVal x As Tuple(Of T1, T2), ByVal y As Tuple(Of T1, T2)) As Boolean Implements IEqualityComparer(Of Tuple(Of T1, T2)).Equals
        Return EqualityComparer(Of T1).[Default].Equals(x.Item1, y.Item1) AndAlso EqualityComparer(Of T2).[Default].Equals(x.Item2, y.Item2)
    End Function

    Public Overrides Function Equals(ByVal obj As Object) As Boolean
        Return TypeOf obj Is Tuple(Of T1, T2) AndAlso Equals(Me, DirectCast(obj, Tuple(Of T1, T2)))
    End Function

    Public Overloads Function GetHashCode(ByVal obj As Tuple(Of T1, T2)) As Integer Implements IEqualityComparer(Of Tuple(Of T1, T2)).GetHashCode
        Return EqualityComparer(Of T1).[Default].GetHashCode(Item1) Xor EqualityComparer(Of T2).[Default].GetHashCode(Item2)
    End Function

    Public Shared Operator =(ByVal left As Tuple(Of T1, T2), ByVal right As Tuple(Of T1, T2)) As Boolean
        If DirectCast(left, Object) Is Nothing AndAlso DirectCast(right, Object) Is Nothing Then
            Return True
        End If

        Return left.Equals(right)
    End Operator

    Public Shared Operator <>(ByVal left As Tuple(Of T1, T2), ByVal right As Tuple(Of T1, T2)) As Boolean
        If DirectCast(left, Object) Is Nothing AndAlso DirectCast(right, Object) Is Nothing Then
            Return False
        End If

        Return Not left.Equals(right)
    End Operator
End Class

Public MustInherit Class Tuple
    <DebuggerStepThrough()> _
    Public Shared Function Create(Of T1, T2)(ByVal first As T1, ByVal second As T2) As Tuple(Of T1, T2)
        Return New Tuple(Of T1, T2)(first, second)
    End Function

    <DebuggerStepThrough()> _
    Public Shared Function Create(Of T1, T2, T3)(ByVal first As T1, ByVal second As T2, ByVal third As T3) As Tuple(Of T1, T2, T3)
        Return New Tuple(Of T1, T2, T3)(first, second, third)
    End Function

End Class

Running the application give this output:

INPUT:
   |  A  B  C  D  E  F  G  H
---+------------------------
  1|  1  3  2  4  1  1  2  1
  2|  1  2  5  3  2  1  3  4
  3|  2  1  5  4  3  2  5  4
  4|  3  5  1  5  2  4  1  2
  5|  4  2  5  1  5  2  4  2
  6|  2  3  2  2  5  1  3  1
  7|  2  1  5  4  3  2  5  4
  8|  3  5  1  3  2  4  1  2


SOLUTION:
Move B4 R for a match of 4
Move D4 L for a match of 4
Move B3 L for a match of 3
Move B5 D for a match of 3
Move C3 D for a match of 3
Move C5 U for a match of 3
Move D4 D for a match of 3
Move E4 R for a match of 3
Move F3 L for a match of 3

This program can work with any board size. The program is based on the way I search for matches in the game (which I suppose is brute-force).

Edit
It appears the solver was not able to find matches on the first gem (see sample below).

5, 2, 5
2, 5, 3
1, 5, 4

If the algorithm were applied on the sample above, no matches would be found.

I've fixed that now. There is now an IsMatchOnFirst() method to handle those cases.
See the updated code for changes.

One other thing... This program does not consider the explosion and lightning [hope I got the name right] gems. I'll work on that soon though. — Alex Essilfie, Mar 03 '11 at 15:24
It's quite great! But had an error that i've corrected: "GetColumnName(ByVal colIndex As Integer) As String" added "Public Function" before, it was missing. I tested and works like a charm. But. Can we do result a little bit another way? For example, result should be two array, one is the X, Y of the gem1 that would be replaced, and result two is X,Y of the gem2 that replaces gem1? "Move B4 R for a match of 4" would be look like this result: (2,4),(3,4). An example or guide is very appreciated. Thanks :) PS: It's not problem that this not counts special gems, it's awesome! — WorK, Mar 05 '11 at 20:49
I've edited your answer (i hope it's ok) now the code is correct. I figured out how to convert the results B3 to L etc, to simple 5,3 to 5,4 for example, if you want i will share the conversion functions in this answer, i accept this as solution. — WorK, Mar 05 '11 at 23:21
I updated the code to find matches on the first gem. It appears it managed to escape detection until now. — Alex Essilfie, Mar 08 '11 at 17:50

score 0 · Answer 2 · answered Mar 02 '11 at 11:39

You want to have three (or more) numbers in a line, so do the following:

scan for two (or more) equal numbers in a line
for every found line, check the neighbours of both ends if they contain an element that would augment the line
if you found something, you have your move and are done

The neighbourhood is defined as follows:

    0
   0x0   x is the central point, 0 are the neighbours.
    0

E.g.

_____
__0__   0 represents the line found
__0__
_X___   X represents the element that would augment the line.
_____

Gems game step calculation, in other word some math

2 Answers2