03

train reservation in visual basic

Public Class Solver
    Private mGoalState As PuzzleState
    Private OpenList As New ArrayList
    Private ClosedList As New ArrayList
    Private mRowGoal(), mColGoal() As Integer
    Private mRowSize As Integer

    Public Sub New(ByVal MaxTile As Integer, ByVal GoalString As String)
        mGoalState = New PuzzleState(MaxTile, GoalString, 0)
        Dim Upper As Integer = mGoalState.Upper
        ReDim mRowGoal(Upper + 1), mColGoal(Upper + 1)
        mRowSize = CInt(Math.Sqrt(Upper + 1))
        For i As Integer = 0 To Upper
            mRowGoal(mGoalState.Tile(i)) = i \ mRowSize
            mColGoal(mGoalState.Tile(i)) = i Mod mRowSize
        Next
    End Sub
    Public Function IsGoal(ByVal ps As PuzzleState) As Boolean
        If ManhattanDistance(ps) = 0 Then
            Return True
        Else
            Return False
        End If
    End Function
    Public Function GetNextStates(ByVal ps As PuzzleState) As PuzzleState()
        Dim psNew() As PuzzleState
        Dim Count As Integer
        Dim State() As Byte = ps.GetStateArray


        ReDim psNew(3)  '4 possible new states

        Dim SpacePos As Integer = ps.SpacePosition
        If SpacePos - mRowSize > -1 Then
            'An available move from the top
            psNew(Count) = New PuzzleState(ps.GetGeneration + 1, ps, StateSwitch(State, SpacePos, SpacePos - mRowSize))
            Count += 1
        End If
        If SpacePos + mRowSize < ps.Upper + 1 Then
            'an available move from below
            psNew(Count) = New PuzzleState(ps.GetGeneration + 1, ps, StateSwitch(State, SpacePos, SpacePos + mRowSize))
            Count += 1

        End If
        If SpacePos Mod mRowSize > 0 Then
            'available move from left
            psNew(Count) = New PuzzleState(ps.GetGeneration + 1, ps, StateSwitch(State, SpacePos, SpacePos - 1))
            Count += 1

        End If
        If SpacePos Mod mRowSize < mRowSize - 1 Then
            'available move from right 
            psNew(Count) = New PuzzleState(ps.GetGeneration + 1, ps, StateSwitch(State, SpacePos, SpacePos + 1))
            Count += 1
        End If
        ReDim Preserve psNew(Count - 1)
        Return psNew
    End Function
    Private Function StateSwitch(ByVal State() As Byte, ByVal Pos1 As Integer, ByVal Pos2 As Integer) As Byte()
        Dim StateNew(State.GetUpperBound(0)) As Byte
        State.CopyTo(StateNew, 0)
        Dim Temp As Byte = StateNew(Pos1)
        StateNew(Pos1) = StateNew(Pos2)
        StateNew(Pos2) = Temp
        Return StateNew
    End Function

    Public Function ManhattanDistance(ByVal ps As PuzzleState) As Integer
        Dim Upper As Integer = ps.Upper
        Dim Distance, Row(Upper + 1), Col(Upper + 1) As Integer


        For i As Integer = 0 To Upper
            Row(ps.Tile(i)) = i \ mRowSize
            Col(ps.Tile(i)) = i Mod mRowSize
        Next

        For i As Integer = 0 To Upper
            Distance = Distance + Math.Abs(Row(i) - mRowGoal(i)) + Math.Abs(Col(i) - mColGoal(i))
        Next
        Return Distance
    End Function

    Public Sub DebugPrint(ByVal ps As PuzzleState)
        Dim i, j As Integer
        If ps Is Nothing Then Exit Sub
        'Debug.Write(Space(ps.GetGeneration))
        For i = 0 To ps.Upper
            Debug.Write(ps.Tile(i).ToString & " ")
            If i Mod mRowSize = mRowSize - 1 Then
                Debug.WriteLine("")
                'Debug.Write(Space(ps.GetGeneration))
                If i = ps.Upper Then
                    Debug.WriteLine("")
                End If
            End If
        Next
        Debug.WriteLine("Cost: " & ps.Cost.ToString)
        Debug.WriteLine("Generation: " & ps.GetGeneration.ToString)
        Debug.WriteLine("=======")
        DebugPrint(ps.Parent)
    End Sub

    Public Function Shuffle(ByVal ps As PuzzleState, ByVal NumSteps As Integer) As PuzzleState
        Dim States(NumSteps) As PuzzleState
        Dim NextStates() As PuzzleState, psRnd As PuzzleState, psTemp As PuzzleState
        Dim rnd As New Random

        Dim i, j As Integer
        Dim Repeat As Boolean

        States(0) = ps
        'Shuffle works by getting the potential moves for a state, and selecting one randomly
        'and repeating the process NumSteps times.

        NextStates = RandomizeArray(GetNextStates(ps))
        States(1) = NextStates(rnd.Next(NextStates.GetUpperBound(0) + 1))

        For i = 2 To NumSteps
            NextStates = RandomizeArray(GetNextStates(States(i - 1)))
            Do
                psTemp = NextStates(rnd.Next(NextStates.GetUpperBound(0) + 1))
                'All this loop condition does is ensure that we don't flip back and forth between two states over two moves.
                'eg, tile moves left then tile moves right.
                'it doesn't prevent matching the same state over three or more moves, but that is less common.
            Loop Until Not States(i - 1).Parent.Equals(psTemp)

            States(i) = psTemp


        Next

        DebugPrint(psRnd)
        States(NumSteps).Parent = Nothing
        States(NumSteps).Generation = 0
        Return States(NumSteps)

    End Function

    Private Function RandomizeArray(ByVal ps() As PuzzleState) As PuzzleState()
        Dim RandInt(ps.GetUpperBound(0)) As Integer
        Dim i As Integer
        Dim rnd As New Random

        'Randomize the order of the PS array by sorting using a key array of random integers.
        For i = 0 To RandInt.GetUpperBound(0)
            RandInt(i) = rnd.Next
        Next

        Array.Sort(RandInt, ps)
        Return ps

    End Function

End Class

Public Module [Global]
    Public gSolver As Solver
End Module