Jaringan Syaraf Tiruan menggunakan Visual Basic 6

Jaringan syaraf tiruan merupakan salah satu sistem pemrosesan informasi yang didesain dengan menirukan cara kerja otak manusia dalam menyelesaikan suatu masalah dengan melakukan proses belajar melalui perubahan bobot sinapsisnya.

Kebanyakan buku mungkin hanya menulis teori dari JST (Jaringan Syaraf Tiruan) dan biasanya implementasinya menggunakan Matlab. Yaaa mungkin karena di Matlab sudah ada fungsi untuk Neural Network (JST). Hal ini menjadikan teori yang ada di buku tersebut "seolah olah tidak digunakan" karena kita hanya menggunakan tools yang ada di Matlab. Tanpa  menerapkan secara langsung teorinya. Hal ini menjadikan sesuatu yang menarik jadi kurang menarik.

Program berikut dibuat menggunakan Visual Basic 6 beberapa tahun lalu saat ada teman yang meminta bantuan untuk program Jaringan Syaraf tiruan menggunakan VB 6. Untuk teori tentang JST (Jaringan Syaraf Tiruan) Sy tidak menyertakan di sini. Teorinya bisa di search dan banyak tersedia di blog yg lain.

JST yg digunakan di sini adalah menggunakan metode Backpropagation. Dengan dua output. Ceritanya adalah ingin membuat suatu sistem yang terhubung dengan webcam kemudian gambar yang diperoleh diolah sehingga sistem tersebut bisa membedakan apakah objek di depannya merupakan penghalang atau bukan. Hal ini bisa diterapkan pada sistem robotik. Biasanya sih lebih mudah menggunakan sensor Ultrasonik dari pada menggunakan webcam. Yupp itulah tantangannya menggunakan webcam.

Karena webcam menghasilkan gambar yang tidak secara langsung merepresentasikan besaran jarak dari suatu objek didepannya alias mau jauh atau dekat gak perduli, webcam hanya bertugas menghasilkan frame image.

Baik Sy tidak fokus pada program bagaimana webcam mengambil gambar, jadi Sy CapturePRO untuk fungsi pengambilan gambar (bisa disearch dan didownload waktu itu). Bisa pake yang lain juga kok.

Disini Sy fokus pada program JSTnya. Di sini JST akan memproses crop image dari hasil gambar webcam sebagai input dan menghasilkan dua output sesuai permintaan. Kalo di sini outputnya (0 dan 1) atau (1 dan 0), karena hasil ini akan dibaca oleh perangkat berikutnya untuk mengambil keputusan apakah robot akan belok atau tidak, maka akan lebih mudah jika output di representasikan dengan 0 dan 1.

Sebelum proses training dijalankan maka di set terlebih dahulu Y out yang dikehendaki dan di set juga error yg diinginkan. Kemudian Bobot yang dihasilkan akan disimpan dalam suatu file untuk kemudian pada saat dijalankan (Test) pada sistem tidak perlu lagi melakukan training dan bisa langsung menggunakan bobot yang sudah diperoleh pada saat training JST.

Program ini menggunakan VB.6 dan belum Sy koding ulang di VB.Net. Silahkan disesuaikan sendiri untuk VB.Net.
    
Option Explicit
Dim StopTrain, StopTest As Boolean
Dim Bo2tVTraining(1 To JumNeHid, 0 To JumInp), Bo2tWTraining(1 To JumOut, 0 To JumNeHid) As Double
Dim YoutTraining(1 To JumOut) As Double



Private Sub CmdTraining_Click()
Dim i, j, k, x, y, n As Integer
Dim xInpTrain(1 To JumInp) As Double
''
Dim zHid(1 To JumNeHid) As Double
Dim xv, zw, dw, z_net(1 To JumNeHid), y_net(1 To JumOut) As Double
Dim Iter, MaxIter  As Long
Dim Target(1 To JumOut), Error, MSE, MaxErr, alfa  As Double
Dim deltaOut(1 To JumOut), deltaHidden(1 To JumNeHid), DeltaW(1 To JumOut, 0 To JumNeHid), DeltaV(1 To JumNeHid, 0 To JumInp), Delta_Net(1 To JumNeHid) As Double

TxtMse.Text = ""
TxtIter.Text = ""
CmdTraining.Enabled = False
CmdSave.Enabled = False
'inisialisasi bobot
For j = 1 To JumNeHid
    For i = 0 To JumInp
    Randomize Timer
    Bo2tVTraining(j, i) = Int(Rnd * 2) - Rnd * 1
    Next i
Next j
For k = 1 To JumOut
    For j = 0 To JumNeHid
    Randomize Timer
    Bo2tWTraining(k, j) = Int(Rnd * 2) - Rnd * 1
    Next j
Next k
'normalisasi masukan
n = 0
For x = 1 To 52                 'LbrCropX
    For y = 1 To 44             'LbrCropY
    n = n + 1
    xInpTrain(n) = (InputBiner(x + BtsKiri - 1, y + BtsAtas - 1)) / 255
    Next y
Next x
'======================<<<<<<<<<<<backpropagation>>>>>>>>>>============================

MaxErr = Val(TxtMaxError.Text) '0.0001
MaxIter = Val(TxtMaxEpoch.Text) '1000
alfa = Val(TxtLearnRate.Text) '0.1 'learning rate
Iter = 0
If CmbTarget.ListIndex = 0 Then
        Target(1) = 1
        Target(2) = 0
Else:   Target(1) = 0
        Target(2) = 1
End If
'------------------>>>>>>>>>>>>>>>>>>>>>begin<<<<<<<<<<<<<<<<<<<<----------------------
StopTrain = False
Do
    DoEvents
' -->> forward
    Iter = Iter + 1

    For j = 1 To JumNeHid
        xv = 0
        For i = 1 To JumInp
        xv = xv + (xInpTrain(i) * Bo2tVTraining(j, i))
        Next i
        z_net(j) = Bo2tVTraining(j, 0) + xv
        zHid(j) = f(z_net(j))
    Next j
    Error = 0
    For k = 1 To JumOut
        zw = 0
        For j = 1 To JumNeHid
        zw = zw + (zHid(j) * Bo2tWTraining(k, j))
        Next j
        y_net(k) = Bo2tWTraining(k, 0) + zw
        YoutTraining(k) = f(y_net(k))
        Error = Error + ((Target(k) - YoutTraining(k)) ^ 2)
    Next k
    MSE = Error / JumOut
  
'---------------------------------------->grafik
    MSChart1.RowCount = Iter
    MSChart1.Row = Iter
    MSChart1.RowLabel = Iter
    MSChart1.Column = 1
    MSChart1.Data = MSE
'----------------------------------------->end of grafik

    TxtMse.Text = Format(MSE, "0.00E+00")
    TxtIter.Text = Iter

    If MSE < MaxErr Then Exit Do
' -->> backward
    For k = 1 To JumOut
        deltaOut(k) = (Target(k) - YoutTraining(k)) * df(y_net(k))
    Next k
    For k = 1 To JumOut
        DeltaW(k, 0) = alfa * deltaOut(k) * 1
        For j = 1 To JumNeHid
        DeltaW(k, j) = alfa * deltaOut(k) * zHid(j)
        Next j
    Next k
    For j = 1 To JumNeHid
        dw = 0
        For k = 1 To JumOut
        dw = dw + (deltaOut(k) * Bo2tWTraining(k, j))
        Next k
        Delta_Net(j) = dw
    Next j
    For j = 1 To JumNeHid
        deltaHidden(j) = Delta_Net(j) * df(z_net(j))
    Next j
    For j = 1 To JumNeHid
        DeltaV(j, 0) = alfa * deltaHidden(j) * 1
        For i = 1 To JumInp
        DeltaV(j, i) = alfa * deltaHidden(j) * xInpTrain(i)
        Next i
    Next j
    For k = 1 To JumOut
        For j = 0 To JumNeHid
        Bo2tWTraining(k, j) = Bo2tWTraining(k, j) + DeltaW(k, j)
        Next j
    Next k
    For j = 1 To JumNeHid
        For i = 0 To JumInp
        Bo2tVTraining(j, i) = Bo2tVTraining(j, i) + DeltaV(j, i)
        Next i
    Next j
Loop Until Iter >= MaxIter Or StopTrain = True
'------------------>>>>>>>>>>>>>>>>>>>>>finish<<<<<<<<<<<<<<<<<<<<----------------------
'====================<<<<<<<<<<<end of backpropagation>>>>>>>>>>============================

CmdTraining.Enabled = True
CmdSave.Enabled = True
End Sub


 
Private Sub CmdTest_Click()
Dim Bo2tVTest(1 To JumNeHid, 0 To JumInp, 1 To 10), Bo2tWTest(1 To JumOut, 0 To JumNeHid, 1 To 10) As Double
Dim i, j, k, x, y, n, l, m As Integer
Dim xInpTest(1 To JumInp) As Double
Dim NamaBobot, NamaTarget As String
Dim save As String
Dim bytRed, bytGreen, bytBlue, bytGrey, bytbiner2 As Integer
Dim TargetTest(1 To JumOut, 1 To 10) As Double
''
Dim zHid(1 To JumNeHid) As Double
Dim YoutTest(1 To JumOut) As Double
Dim xv, zw, z_net(1 To JumNeHid), y_net(1 To JumOut) As Double
Dim Error, MSE(1 To 10) As Double
Dim Msex, MinMse As Double
Dim YoutTestAkhir(1 To JumOut) As Integer


CmdTest.Enabled = False
'membaca bobot
For l = 1 To 10
NamaBobot = "\bobot\Sample" & l
NamaTarget = "\OutTraining\Yout" & l
Open App.Path & NamaBobot & "BobotV.txt" For Input As #1
For j = 1 To JumNeHid
    For i = 0 To JumInp
    Input #1, Bo2tVTest(j, i, l)
    Next i
Next j
Close #1

Open App.Path & NamaBobot & "BobotW.txt" For Input As #2
For k = 1 To JumOut
    For j = 0 To JumNeHid
    Input #2, Bo2tWTest(k, j, l)
    Next j
Next k
Close #2

Open App.Path & NamaTarget & ".txt" For Input As #3
For k = 1 To JumOut
    Input #3, TargetTest(k, l)
Next k
Close #3
Next l
'======================<<<<<<<<<<<backpropagation>>>>>>>>>>============================


'------------------>>>>>>>>>>>>>>>>>>>>>begin<<<<<<<<<<<<<<<<<<<<----------------------
StopTest = False
Do Until StopTest = True
    On Error GoTo errorhandler
    save = App.Path & "\Sample.jpg"
    CapturePRO1.FrameFile = save
    CapturePRO1.CaptureFrame
    PicHidden.Refresh
    PicHidden.Picture = LoadPicture(save)
    BitBlt PicPreview.hdc, 0, 0, Lebar, Tinggi, PicHidden.hdc, 0, 0, vbSrcCopy
    n = 0
    For x = BtsKiri To BtsKiri + LbrCropX - 1
        For y = BtsAtas To BtsAtas + LbrCropY - 1
            Pixels(x, y) = PicHidden.Point(x, y)
            bytRed = Pixels(x, y) And &HFF&
            bytGreen = geserkiri((Pixels(x, y) And &HFF00&), 8)
            bytBlue = geserkiri((Pixels(x, y) And &HFF0000), 16)
            bytGrey = (bytRed + bytGreen + bytBlue) / 3
            If bytGrey < 90 Then
                bytbiner2 = 0
            Else: bytbiner2 = 255
            End If
            n = n + 1
            xInpTest(n) = bytbiner2 / 255
        Next y
    Next x
' -->> forward
    DoEvents
    For l = 1 To 10
        For j = 1 To JumNeHid
            xv = 0
            For i = 1 To JumInp
            xv = xv + (xInpTest(i) * Bo2tVTest(j, i, l))
            Next i
            z_net(j) = Bo2tVTest(j, 0, l) + xv
            zHid(j) = f(z_net(j))
        Next j
        Error = 0
        For k = 1 To JumOut
            zw = 0
            For j = 1 To JumNeHid
            zw = zw + (zHid(j) * Bo2tWTest(k, j, l))
            Next j
            y_net(k) = Bo2tWTest(k, 0, l) + zw
            YoutTest(k) = f(y_net(k))
            Error = Error + ((TargetTest(k, l) - YoutTest(k)) ^ 2)
        Next k
        MSE(l) = Error / JumOut
    Next l
  
    MinMse = 1
    For l = 1 To 10
        Msex = MSE(l)
        MinMse = Min(Msex, MinMse)
    Next l
  
    For m = 1 To 10
        If MinMse = MSE(m) Then
            Exit For
        End If
    Next m
    YoutTestAkhir(1) = CInt(TargetTest(1, m))
    YoutTestAkhir(2) = CInt(TargetTest(2, m))
    Open App.Path & "\OutTest\OutTest.Txt" For Output As #4
    For k = 1 To JumOut
        Print #4, YoutTestAkhir(k)
    Next k
    Close #4
  
    TxtOut1.Text = YoutTestAkhir(1)
    TxtOut2.Text = YoutTestAkhir(2)
    TxtError.Text = Format(MinMse, "0.00E+00")
Loop
CmdTest.Enabled = True
Exit Sub
errorhandler:
MsgBox "Maaf koneksi dengan kamera belum berhasil", vbInformation, "Status koneksi"
PicHidden.Refresh
Me.CapturePRO1.Preview = False
CmdConnect.Caption = "Connect"
CmdConnectTraining.Caption = "Connect"
CmdTest.Enabled = True
End Sub

Berikut contoh tampilan sederhananya untuk mode training penentuan bobot (ternyata masih ada print screennya :D)

Dan berikut contoh tampilan untuk mode penggunaan JSTnya

Pengen sih di Run ulang tapi sayangnya gak bisa di Run di VB. Net :'( (sdh gak pake VB 6)


Semoga Bermanfaat..