Results 1 to 4 of 4

Thread: How to begin coding a brain for a similar to 8-puzzle game to calculate least moves

Threaded View

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Nov 2006
    Posts
    129

    How to begin coding a brain for a similar to 8-puzzle game to calculate least moves

    I managed to solve this problem with a brute force with RNG it takes around 4-5 seconds to find the best solution even though the working grid is a 3x3.

    I want to know how do I make it possible to generate the same moves the brute force finds without the brute force.

    I'll list 2 examples and the solutions brute force found. I tried to analyze the solutions to figure out why it picked them and I can't figure anything out.

    This game works by using cyclic rotation in both directions (left to right) and (right to left)

    Left to right cyclic rotation does this
    If [a, b, c] then [b, c, a]
    Right to left cyclic rotation does this
    If [a, b, c] then [c, a, b]

    Game Data lets say is this (it can be any permutation of 1 to 9)
    For example
    Data = 7, 2, 6, 1, 5, 4, 3, 8, 9


    I can move the pieces on the table in 8 different ways.
    1) Cyclic Rotation (Left To Right) based on Row.
    2) Cyclic Rotation (Right to Left) based on Row.
    3) Top To Bottom based on Column.
    4) Bottom To Top based on Column.
    Now 5 to 8 don't require Column or Row since they are set diagonally.
    5) Top Left To Bottom Right (Left To Right).
    6) Top Left To Bottom Right (Right To Left).
    7) Top Right To Bottom Left (Left To Right).
    8) Top Right To Bottom Left (Right To Left).


    The data is loaded as following

    007 | 002 | 006
    001 | 005 | 004
    003 | 008 | 009

    Solution brute forced:
    1). [Top-Right] To [Bottom-Left] (Right To Left)
    2). Bottom to Top, Column : 0
    3). Left To Right, Row : 1



    Here is the solution simlutated

    1). [Top-Right] To [Bottom-Left] (Right To Left)

    007 | 002 | 003
    001 | 006 | 004
    005 | 008 | 009

    2). Bottom to Top, Column : 0

    001 | 002 | 003
    005 | 006 | 004
    007 | 008 | 009

    3). Left To Right, Row : 1

    001 | 002 | 003
    004 | 005 | 006
    007 | 008 | 009

    Here is example 2 which takes 6 moves to solve

    009 | 008 | 007
    006 | 005 | 004
    003 | 002 | 001
    Solve with: (6 moves)
    1). [Top-Right] To [Bottom-Left] (Right To Left)
    2). Top to Bottom, Column:1
    3). Bottom to Top, Column:0
    4). [Top-Left] To [Bottom-Right] (Left To Right)
    5). Left To Right, Row:1
    6). Right to Left, Row:2

    So it's a pretty simple puzzle but finding efficient solutions is not a simple task. Can someone guide me in a right direction.

    This is how I did it it finds first 6 moves.. then click button again finds 5 moves (if possible) 4, 3 etc..

    Code:
        Public Structure Move
            Dim moveId As Byte
            Dim rowOrColumn As Byte
            Public Sub New(ByVal moveId As Byte, ByVal rowOrColumn As Byte)
                Me.moveId = moveId
                Me.rowOrColumn = rowOrColumn
            End Sub
        End Structure
    
        Public leastMoves As New List(Of Move)
        Public leastMovesTaken As Long = 9999999
        Dim rnd As New Random()
        Dim answer() As Byte
        Public answerSet As Boolean = False
    
        Function SortDataRandomized(ByVal data() As Byte) As List(Of Move)
            If data Is Nothing Then
                MessageBox.Show("You haven't loaded a box yet")
                Return Nothing
            End If
            Dim newdata() As Byte
            ReDim newdata(UBound(data))
            Buffer.BlockCopy(data, 0, newdata, 0, data.Length)
    
            If answerSet = False Then
                ReDim answer(UBound(data))
                Buffer.BlockCopy(data, 0, answer, 0, data.Length)
                Array.Sort(answer)
                answerSet = True
            End If
    
            Dim whatToDo As Byte
            Dim randomXY As Byte
            Dim answersFound As Integer = 0
            Dim movesTaken As New List(Of Move)
            While answersFound < 100
                whatToDo = rnd.Next(0, 8) '0,1,2,3,4,5,6,7
                randomXY = rnd.Next(0, 3) '0,1,2
                Select Case whatToDo
                    Case 0
                        newdata = CyclicRotationLeftToRight(newdata, randomXY)
                        movesTaken.Add(New Move(0, randomXY))
                    Case 1
                        newdata = CyclicRotationRightToLeft(newdata, randomXY)
                        movesTaken.Add(New Move(1, randomXY))
                    Case 2
                        newdata = CyclicRotationTopToBottom(newdata, randomXY)
                        movesTaken.Add(New Move(2, randomXY))
                    Case 3
                        newdata = CyclicRotationBottomToTop(newdata, randomXY)
                        movesTaken.Add(New Move(3, randomXY))
                    Case 4
                        newdata = CyclicRotationTLtoBRLeftToRight(newdata)
                        movesTaken.Add(New Move(4, 0))
                    Case 5
                        newdata = CyclicRotationTLtoBRRightToLeft(newdata)
                        movesTaken.Add(New Move(5, 0))
                    Case 6
                        newdata = CyclicRotationTRtoBLLeftToRight(newdata)
                        movesTaken.Add(New Move(6, 0))
                    Case 7
                        newdata = CyclicRotationTRtoBLRightToLeft(newdata)
                        movesTaken.Add(New Move(7, 0))
                End Select
    
                'Reset any randomized path since its already too long.
                If movesTaken.Count > leastMovesTaken Then
                    movesTaken.Clear()
                    'resets newdata back to scrambled state
                    Buffer.BlockCopy(data, 0, newdata, 0, data.Length)
                End If
    
                For i As Integer = 0 To data.Length - 1
                    If (newdata(i) <> answer(i)) Then
                        Exit For
                    ElseIf (i = newdata.Length - 1) AndAlso newdata(i) = answer(i) Then
                        answersFound += 1
                        Form1.lblRandomSortAnswers.Text = "Total Answers: " + answersFound.ToString
                        If leastMovesTaken > movesTaken.Count Then
                            leastMoves.Clear()
                            leastMoves.AddRange(movesTaken)
                            leastMovesTaken = movesTaken.Count
                            Form1.lblRandomSortMoves.Text = "Moves Took: " + movesTaken.Count.ToString
                            If movesTaken.Count <= 6 Then
                                'Best path found.
                                Exit While
                            End If
                        End If
                        'Reset any randomized path since its already too long.
                        movesTaken.Clear()
                        'resets newdata back to scrambled state.
                        Buffer.BlockCopy(data, 0, newdata, 0, data.Length)
                        Exit For
                    End If
                Next i
                Application.DoEvents()
            End While
            Return leastMoves
        End Function
    Code:
        Public Function CyclicRotationLeftToRight(ByVal data() As Byte, ByVal YRow As Byte) As Byte()
            Dim Side As Long = Math.Sqrt(UBound(data) + 1)
            Dim newdata() As Byte
            ReDim newdata(UBound(data))
            Buffer.BlockCopy(data, 0, newdata, 0, data.Length)
    
            Dim row() As Byte
            ReDim row(Side - 1)
    
            For i = 0 To UBound(row)
                row(i) = data(i + (YRow * Side))
            Next i
            row = CyclicRotation(row, False)
            For i = 0 To UBound(row)
                newdata(i + (YRow * Side)) = row(i)
            Next i
            Return newdata
        End Function
    
        Public Function CyclicRotationRightToLeft(ByVal data() As Byte, ByVal YRow As Byte) As Byte()
            Dim Side As Long = Math.Sqrt(UBound(data) + 1)
            Dim newdata() As Byte
            ReDim newdata(UBound(data))
            Buffer.BlockCopy(data, 0, newdata, 0, data.Length)
    
            Dim row() As Byte
            ReDim row(Side - 1)
    
            For i = 0 To UBound(row)
                row(i) = data(i + (YRow * Side))
            Next i
            row = CyclicRotation(row, True)
            For i = 0 To UBound(row)
                newdata(i + (YRow * Side)) = row(i)
            Next i
            Return newdata
        End Function
    
        Public Function CyclicRotationTopToBottom(ByVal data() As Byte, ByVal XColumn As Byte) As Byte()
            Dim Side As Long = Math.Sqrt(UBound(data) + 1)
            Dim newdata() As Byte
            ReDim newdata(UBound(data))
            Buffer.BlockCopy(data, 0, newdata, 0, data.Length)
    
            Dim column() As Byte
            ReDim column(Side - 1)
    
            For i = 0 To UBound(column)
                column(i) = data(XColumn + (i * Side))
            Next i
            column = CyclicRotation(column, False)
            For i = 0 To UBound(column)
                newdata(XColumn + (i * Side)) = column(i)
            Next i
            Return newdata
        End Function
    
        Public Function CyclicRotationBottomToTop(ByVal data() As Byte, ByVal XColumn As Byte) As Byte()
            Dim Side As Long = Math.Sqrt(UBound(data) + 1)
            Dim newdata() As Byte
            ReDim newdata(UBound(data))
            Buffer.BlockCopy(data, 0, newdata, 0, data.Length)
    
            Dim column() As Byte
            ReDim column(Side - 1)
    
            For i = 0 To UBound(column)
                column(i) = data(XColumn + (i * Side))
            Next i
            column = CyclicRotation(column, True)
            For i = 0 To UBound(column)
                newdata(XColumn + (i * Side)) = column(i)
            Next i
            Return newdata
        End Function
    
        Public Function CyclicRotationTLtoBRLeftToRight(ByVal data As Byte()) As Byte()
            Dim Side As Long = Math.Sqrt(UBound(data) + 1)
            Dim newdata() As Byte
            ReDim newdata(UBound(data))
            Buffer.BlockCopy(data, 0, newdata, 0, data.Length)
    
            Dim diagonal() As Byte
            ReDim diagonal(Side - 1)
    
            For i = 0 To UBound(diagonal)
                diagonal(i) = data(i + (i * Side)) 'X and Y's both increment together to run the diagonal.
            Next i
            diagonal = CyclicRotation(diagonal, False)
            For i = 0 To UBound(diagonal)
                newdata(i + (i * Side)) = diagonal(i)
            Next i
            Return newdata
        End Function
    
        Public Function CyclicRotationTLtoBRRightToLeft(ByVal data As Byte()) As Byte()
            Dim Side As Long = Math.Sqrt(UBound(data) + 1)
            Dim newdata() As Byte
            ReDim newdata(UBound(data))
            Buffer.BlockCopy(data, 0, newdata, 0, data.Length)
    
            Dim diagonal() As Byte
            ReDim diagonal(Side - 1)
    
            For i = 0 To UBound(diagonal)
                diagonal(i) = Data(i + (i * Side)) 'X and Y's both increment together to run the diagonal.
            Next i
            diagonal = CyclicRotation(diagonal, True)
            For i = 0 To UBound(diagonal)
                newdata(i + (i * Side)) = diagonal(i)
            Next i
            Return newdata
        End Function
    
        Public Function CyclicRotationTRtoBLLeftToRight(ByVal data As Byte()) As Byte()
            Dim Side As Long = Math.Sqrt(UBound(data) + 1)
            Dim newdata() As Byte
            ReDim newdata(UBound(data))
            Buffer.BlockCopy(data, 0, newdata, 0, data.Length)
    
            Dim diagonal() As Byte
            ReDim diagonal(Side - 1)
    
            Dim y As Long
            y = 0
            For i = UBound(diagonal) To 0 Step -1
                diagonal(i) = data(i + (y * Side)) 'X goes down and Y goes up
                y += 1
            Next i
            diagonal = CyclicRotation(diagonal, False)
            y = 0
            For i = UBound(diagonal) To 0 Step -1
                newdata(i + (y * Side)) = diagonal(i)
                y += 1
            Next i
            Return newdata
        End Function
    
        Public Function CyclicRotationTRtoBLRightToLeft(ByVal data As Byte()) As Byte()
            Dim Side As Long = Math.Sqrt(UBound(data) + 1)
            Dim newdata() As Byte
            ReDim newdata(UBound(data))
            Buffer.BlockCopy(data, 0, newdata, 0, data.Length)
    
            Dim diagonal() As Byte
            ReDim diagonal(Side - 1)
    
            Dim y As Long
            y = 0
            For i = UBound(diagonal) To 0 Step -1
                diagonal(i) = Data(i + (y * Side)) 'X goes down and Y goes up
                y += 1
            Next i
            diagonal = CyclicRotation(diagonal, True)
            y = 0
            For i = UBound(diagonal) To 0 Step -1
                newdata(i + (y * Side)) = diagonal(i)
                y += 1
            Next i
            Return newdata
        End Function
    
        Public Function CyclicRotation(ByVal data() As Byte, ByVal leftDirection As Boolean) As Byte()
    
            'Left Direction = true
            '--------------------------------------------------------
            'Shifted cyclically rotation If [a, b, c] then [b, c, a]
            '--------------------------------------------------------
            'Left Direction = false
            '--------------------------------------------------------
            'Shifted cyclically rotation If [a, b, c] then [c, a, b]
            '--------------------------------------------------------
    
            Dim newdata() As Byte
            ReDim newdata(UBound(data))
    
            If leftDirection = True Then
                newdata(UBound(newdata)) = data(0) '1st element will be last.
                For i = 0 To UBound(data) - 1
                    newdata(i) = data(i + 1)
                Next i
            Else
                newdata(0) = data(UBound(data)) 'last element will be first.
                For i = 1 To UBound(data)
                    newdata(i) = data(i - 1)
                Next i
            End If
    
            Return newdata
        End Function
    Last edited by sspoke; Jul 19th, 2013 at 06:05 PM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width