cbobsmap.vb

一个使用VB.Net开发的演示人工神经网络的程序

Public Class CBobsMap
    Public Const WINDOW_WIDTH As Integer = 450
    Public Const WINDOW_HEIGHT As Integer = 300

    Public Const MAP_WIDTH As Integer = 15
    Public Const MAP_HEIGHT As Integer = 10

    Public Const CROSSOVER_RATE As Double = 0.7
    Public Const MUTATION_RATE As Double = 0.001

    Public Const POP_SIZE As Integer = 140
    Public Const CHROMO_LENGTH As Integer = 70
    Public Const GENE_LENGTH As Integer = 2


    '//storage for the map
    Dim map(,) As Integer = {{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, _
                            {1, 0, 1, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1}, _
                            {8, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1}, _
                            {1, 0, 0, 0, 1, 1, 1, 0, 0, 1, 0, 0, 0, 0, 1}, _
                            {1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 0, 1}, _
                            {1, 1, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 0, 1}, _
                            {1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 1, 0, 1}, _
                            {1, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 5}, _
                            {1, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1}, _
                            {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}}

    Dim m_iMapWidth As Integer = MAP_WIDTH
    Dim m_iMapHeight As Integer = MAP_HEIGHT

    '//index into the array which is the start point
    Dim m_iStartX As Integer = 14
    Dim m_iStartY As Integer = 7

    '//and the finish point
    Dim m_iEndX As Integer = 0
    Dim m_iEndY As Integer = 2

    Public Sub New()

    End Sub

    '//we can use this array as Bobs memory if rqd
    Public memory(MAP_HEIGHT - 1, MAP_WIDTH - 1) As Integer

    '//takes a string of directions and see's how far Bob
    '//can get. Returns a fitness score proportional to the 
    '//distance reached from the exit.
    Public Function TestRoute(ByVal vecPath As ArrayList, ByVal Bobs As CBobsMap) As Double
        Dim posX As Integer = m_iStartX
        Dim posY As Integer = m_iStartY
        Dim dir, NextDir As Integer

        For dir = 0 To vecPath.Count - 1
            NextDir = vecPath(dir)
            Select Case NextDir
                Case 0 '//North

                    '//check within bounds and that we can move
                    If (((posY - 1) >= 0) AndAlso (map(posY - 1, posX) = 0 Or map(posY - 1, posX) = 8)) Then
                        posY -= 1
                    End If

                Case 1 '//South

                    '//check within bounds and that we can move
                    If (((posY + 1) < m_iMapHeight) AndAlso (map(posY + 1, posX) = 0 Or map(posY + 1, posX) = 8)) Then
                        posY += 1
                    End If

                Case 2 '//East

                    '//check within bounds and that we can move
                    If (((posX + 1) < m_iMapWidth) AndAlso (map(posY, posX + 1) = 0 Or map(posY, posX + 1) = 8)) Then
                        posX += 1
                    End If
                Case 3 '//West

                    '//check within bounds and that we can move
                    If (((posX - 1) >= 0) AndAlso (map(posY, posX - 1) = 0 Or map(posY, posX - 1) = 8)) Then
                        posX -= 1
                    End If
            End Select
            '//mark the route in the memory array
            Bobs.memory(posY, posX) = 1

        Next

        '//now we know the finish point of Bobs journey, let's assign
        '//a fitness score which is proportional to his distance from
        '//the exit

        Dim DiffX As Integer = Math.Abs(posX - m_iEndX)
        Dim DiffY As Integer = Math.Abs(posY - m_iEndY)

        '//we add the one to ensure we never divide by zero. Therefore
        '//a solution has been found when this return value = 1
        Return 1 / CDbl(DiffX + DiffY + 1)
    End Function

    '//given a surface to draw on this function uses the windows GDI
    '//to display the map.
    Public Sub Render(ByVal cxClient As Integer, ByVal cyClient As Integer, ByVal g As Graphics)
        Dim border As Integer = 0

        Dim BlockSizeX As Integer = (cxClient - 2 * border) / m_iMapWidth
        Dim BlockSizeY As Integer = (cyClient - 2 * border) / m_iMapHeight

        Dim left, right, top, bottom As Integer
        Dim x, y As Integer
        For y = 0 To m_iMapHeight - 1
            For x = 0 To m_iMapWidth - 1
                left = border + (BlockSizeX * x)
                right = left + BlockSizeX

                top = border + (BlockSizeY * y)
                bottom = top + BlockSizeY
                If (map(y, x) = 0) Then g.FillRectangle(Brushes.White, left, top, BlockSizeX, BlockSizeY)
                If (map(y, x) = 1) Then g.FillRectangle(Brushes.DarkBlue, left, top, BlockSizeX, BlockSizeY)
                '//draw red for exit and entrance
                If ((map(y, x) = 5) Or (map(y, x) = 8)) Then g.FillRectangle(Brushes.Red, left, top, BlockSizeX, BlockSizeY)
                g.DrawRectangle(Pens.Black, left, top, BlockSizeX, BlockSizeY)

            Next
        Next

    End Sub

    '//draws whatever path may be stored in the memory
    Public Sub MemoryRender(ByVal cxClient As Integer, ByVal cyClient As Integer, ByVal g As Graphics)
        Dim border As Integer = 0

        Dim BlockSizeX As Integer = (cxClient - 2 * border) / m_iMapWidth
        Dim BlockSizeY As Integer = (cyClient - 2 * border) / m_iMapHeight

        Dim left, right, top, bottom As Integer
        Dim x, y As Integer
        For y = 0 To m_iMapHeight - 1
            For x = 0 To m_iMapWidth - 1
                left = border + (BlockSizeX * x)
                right = left + BlockSizeX

                top = border + (BlockSizeY * y)
                bottom = top + BlockSizeY
                If memory(y, x) = 1 Then g.FillRectangle(Brushes.Cyan, left, top, BlockSizeX, BlockSizeY)

            Next
        Next
    End Sub

    Public Sub ResetMemory()
        Dim x, y As Integer
        For y = 0 To m_iMapHeight - 1
            For x = 0 To m_iMapWidth - 1
                memory(y, x) = 0
            Next
        Next

    End Sub


End Class