patterngrid.vb

neural networks applications

Imports BrainNet.NeuralFramework

Public Class PatternGrid
    Inherits System.Windows.Forms.UserControl


    Public Event TrainingProgress(ByVal Current As Long, ByVal Max As Long)


    Dim writingMode As Boolean = False
    Dim eraseMode As Boolean = False
    Dim grdSize As Long
    Dim trainingDataQueue As New ArrayList()
    Dim panels As New ArrayList()

    Dim mynn As NeuralNetwork

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    'UserControl overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    Friend WithEvents pnMain As System.Windows.Forms.Panel
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.pnMain = New System.Windows.Forms.Panel()
        Me.SuspendLayout()
        '
        'pnMain
        '
        Me.pnMain.BackColor = System.Drawing.Color.White
        Me.pnMain.BorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
        Me.pnMain.Location = New System.Drawing.Point(8, 8)
        Me.pnMain.Name = "pnMain"
        Me.pnMain.Size = New System.Drawing.Size(32, 32)
        Me.pnMain.TabIndex = 0
        Me.pnMain.Visible = False
        '
        'PatternGrid
        '
        Me.BackColor = System.Drawing.Color.White
        Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.pnMain})
        Me.Name = "PatternGrid"
        Me.Size = New System.Drawing.Size(48, 48)
        Me.ResumeLayout(False)

    End Sub

#End Region


#Region "Custom Functions And Properties"


    '<summary> This contains all the added training states </summary>
    Public ReadOnly Property TrainingStates() As ArrayList
        Get
            Return Me.trainingDataQueue
        End Get
    End Property

    '<summary> Let us clear all training states </summary>
    Public Sub ClearStates()
        trainingDataQueue.Clear()
    End Sub


    '<summary> According to Joe's advice, I've decided to use discrete units in a drawing grid </summary>
    Public Sub Initialize(ByVal UnitSize As Size, ByVal GridSize As Long, ByVal MaxOutputBits As Long)

        'Initialize the system
        Me.trainingDataQueue.Clear()
        panels.Clear()


        Dim i, j As Long


        For i = 0 To GridSize - 1

            For j = 0 To GridSize - 1

                'Create the writing grid

                Dim pn As Panel = New Panel()
                pn.Size = UnitSize
                pn.BackColor = Color.White
                'pn.BorderStyle = BorderStyle.FixedSingle

                pn.Left = pn.Width * i
                pn.Top = pn.Height * j

                'Add the handlers

                panels.Add(pn)
                pn.Visible = False


            Next

        Next

        Me.Width = (i) * UnitSize.Width
        Me.Height = Me.Width
        Me.grdSize = GridSize


        mynn = New BackPropNetworkFactory().CreateNetwork(panels.Count, MaxOutputBits)


    End Sub

    Public ReadOnly Property GridSize() As Size
        Get
            Return New Size(grdSize, grdSize)
        End Get
    End Property


    '<summary> Returns a panel under a given point </summary>
    Private Function PanelUnderPoint(ByVal x As Single, ByVal y As Single) As Panel
        Dim pn As Panel

        For Each pn In panels
            If x >= pn.Left And x <= (pn.Left + pn.Width) Then
                If y >= pn.Top And y <= (pn.Height + pn.Top) Then
                    Return pn
                    Exit Function
                End If
            End If
        Next
    End Function


    '<summary> Get an binary string from a decimal (byte) </summary>
    Friend Function BinaryFromNumber(ByVal bt As Integer) As String


        Dim binStr As String = ""

        Dim max As Integer = 0

        Dim i

        'Find the maximum number of bits that can accomodate the value
        Do While ((2 ^ max) < bt)
            max = max + 1
        Loop

        For i = 0 To max
            If ((2 ^ i) And bt) = (2 ^ i) Then
                binStr = "1" & binStr
            Else
                binStr = "0" & binStr
            End If

        Next

        Return binStr

    End Function


    '<summary> Convert a binary string to long value</summary>
    Friend Function NumberFromBinary(ByVal bin As String) As Integer

        Dim number As Integer = 0

        Dim i, bit
        For i = 0 To bin.Length - 1
            If bin.Chars(bin.Length - 1 - i) = "1" Then
                bit = 1
            Else
                bit = 0
            End If

            number = number + ((2 ^ i) * bit)

        Next

        Return number

    End Function




    '<summary>Train the grid specified number of times</summary>
    Public Sub Train(ByVal Times As Long)
        If mynn Is Nothing Then Exit Sub


        Dim i As Integer
        For i = 0 To Times
            Dim tempStates As ArrayList = Me.trainingDataQueue.Clone()

            Do While (tempStates.Count > 0)
                Randomize()

                Dim itemno As Long = Rnd() * (tempStates.Count - 1)

                Dim td As TrainingData = tempStates(itemno)
                mynn.TrainNetwork(td)
                tempStates.Remove(td)
                Application.DoEvents()
                RaiseEvent TrainingProgress(i, Times)
            Loop


        Next

    End Sub

    '<summary>Add the state to training queue</summary>
    Public Sub AddStateFromPattern(ByVal InputPattern As String, ByVal OutputPattern As String)

        Dim td As New TrainingData()


        'Provide the inputs to the input array

        Dim counter As Long
        For counter = 0 To InputPattern.Length - 1
            td.Inputs.Add(CType(InputPattern.Chars(counter).ToString, System.Double))
        Next

        For counter = 0 To OutputPattern.Length - 1
            td.Outputs.Add(CType(OutputPattern.Chars(counter).ToString, System.Double))
        Next


        'Give this to the neural network
        Me.trainingDataQueue.Add(td)

    End Sub

    '<summary>Add the state to training queue</summary>
    Public Sub AddStateFromData(ByVal td As TrainingData)

        'Give this to the neural network
        Me.trainingDataQueue.Add(td)


    End Sub


    '<summary>Add the current state to training queue</summary>
    Public Sub AddStateFromGrid(ByVal TargetOutputValue As Long)

        Dim td As New TrainingData()


        'Provide the inputs to the input array

        Dim p As Panel

        For Each p In panels
            If p.BackColor.Equals(Color.Red) Then
                td.Inputs.Add(1)
            Else
                td.Inputs.Add(0)
            End If
        Next



        'Convert current value to bit patterns and give it
        'to the output array

        Dim bin As String
        bin = BinaryFromNumber(TargetOutputValue)

        'Just get the last bits 
        bin = Mid(bin, bin.Length - mynn.OutputLayer.Count + 1)

        Dim i As Integer

        For i = 0 To bin.Length - 1
            If bin.Chars(i) = "1" Then
                td.Outputs.Add(1)
            Else
                td.Outputs.Add(0)
            End If
        Next


        'Give this to the neural network
        Me.trainingDataQueue.Add(td)


    End Sub

    '<summary>Run the grid to detect the drawn pattern</summary>
    Function Detect(ByVal Input As ArrayList) As ArrayList

        Dim td As New TrainingData()


        'Get the output and let us convert it to a value

        mynn.RunNetwork(Input)
        Return mynn.GetOutput



    End Function

    '<summary>Run the grid to detect the drawn pattern</summary>
    Function Detect() As Long
        Dim td As New TrainingData()


        'Provide the inputs to the input array

        Dim p As Panel

        For Each p In panels
            If p.BackColor.Equals(Color.Red) Then
                td.Inputs.Add(1)
            Else
                td.Inputs.Add(0)
            End If
        Next



        'Get the output and let us convert it to a value

        mynn.RunNetwork(td.Inputs)
        Dim output As ArrayList
        output = mynn.GetOutput()
        Dim str As String = ""
        Dim val As Double

        For Each val In output
            str = str & Math.Round(val)
        Next


        Return NumberFromBinary(str)

    End Function


    '<summary>Clear the grid, by setting the background of all panels to white</summary>
    Sub ClearDrawing()
        Dim pn As Panel
        For Each pn In Me.panels
            pn.BackColor = Color.White
            Me.Invalidate()

        Next
    End Sub


    '<summary>To report the state to a grid</summary>
    Public Sub Report(ByVal lv As ListView)
        Utility.Report(lv, mynn)

    End Sub


#End Region


#Region "Event Handlers"

    Private Sub WritingGrid_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
        If e.Button = MouseButtons.Left Then
            writingMode = True
        ElseIf e.Button = MouseButtons.Right Then
            eraseMode = True
        End If
    End Sub

    Private Sub WritingGrid_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseUp
        writingMode = False
        eraseMode = False
    End Sub

    Private Sub WritingGrid_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove

        If writingMode Or eraseMode Then
            Dim pn As Panel = PanelUnderPoint(e.X, e.Y)
            If pn Is Nothing Then Exit Sub

            If writingMode Then
                pn.BackColor = Color.Red
            Else
                pn.BackColor = Color.White
            End If


            Dim g As Graphics = Me.CreateGraphics
            For Each pn In panels
                g.FillRectangle(New Drawing.SolidBrush(pn.BackColor), pn.Left, pn.Top, pn.Width, pn.Height)
            Next

        End If


    End Sub

    Private Sub WritingGrid_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

    End Sub

    Private Sub WritingGrid_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
        Dim pn As Panel

        For Each pn In panels
            e.Graphics.FillRectangle(New Drawing.SolidBrush(pn.BackColor), pn.Left, pn.Top, pn.Width, pn.Height)
        Next
    End Sub

#End Region

End Class