<< Nerual Networks
Download
A “Neural Network” with Post-Train Testingfor Windows computers (last modified 2 November 2022)
Given a collection of patterns, if the number of nodes in the hidden layer is large enough, you can train the network to 100% accuracy over all the patterns, that is, the network can properly categorize all of them. Then after you stop training, if you use the network as it has become and give it one of the patterns it trained on, it will categorize the pattern correctly, naturally. There is nothing impressive about that.
What makes a neural network impressive and useful is that after training on only some of the possible patterns, but still sufficiently large and diverse, it can do well on patterns it did not train on.
The following program illustrates the above with a simple but non-trivial problem: determine the number of dots in an area. To make the training fast, the dots will be in a line and not too close together. Specifically, we have 20 positions and from 1 to 5 dots are placed at random in those positions, and the difference in any two dots’ positions does not exceed 3 (that is, there is a gap of at least 2 spaces between dots). For example:
..*....*...*...*....
.......*........*...
....*....*......*...
After training the network, when it is given the first pattern above its number 4 output node should light up and the other output nodes (1, 2, 3, 5) go dim. Given the second pattern, its number 2 output node should stand out similarly. Etc. (This problem has the advantage over an OCR problem in that the program doesn’t need a database of patterns; it can generate its own patterns.)
There are somewhat over 4,000 such patterns possible. A network with only about ten hidden nodes, after training on only about 300 random patterns, will almost always correctly determine the number of dots in any of the other patterns, that is, the patterns the network had not trained on. 300 is less than 8% of the total number of possible patterns so that is rather impressive.
Here’s how to play with the program below when you run it. If you want to see the color coded diagram updated as it trains, have the setting Update screen when training fast Yes. (However in that case the program will take a long time to get to 100% accuracy because redrawing the lines and nodes takes most of the time.)
Then press F to start training at the fastest possible speed (or S at a slow speed – you can switch between the two without losing ground). Eventually (if the number of hidden nodes is large enough) 100% accuracy will be reached and stay there over a full pass through the training patterns.
At that point training will automatically stop. You can force it to continue by pressing F or S again, but afterwards you will have to stop it manually with the same key.
Then press E to test the network on completely new patterns.
Here is the source code for NN2:
' This program was inspired by a program by Erik Christensen:
' forum.powerbasic.com/forum/user-to-user-discussions/source-code/
' 25186-artificial-backpropagation-neural-network
'
' Here the input pattern is a series of dots, numbering from 1 to
' %outputs, in random positions except that they are at least
' %minSeparation distant from each other. Given such a pattern, the
' desired output of the network is the total number of dots, from
' 1 to %outputs. The user can set the number of training patterns.
' (When there are 20 spaces with from 1 to 5 dots spaced at least
' 3 apart, over 4,000 patterns are possible.)
'
' When in stepping mode (hence using untrained-on patterns), if the
' variance is too large the output is split between the brightest
' output node and second brightest, even if the brightest is the
' correct one, and counted as an error.
'
' A training collection of random input patterns, as described above,
' is created at the start and stored. After training on these the net
' can be given completely new random patterns per above, none of which
' is in the training set. Call it the test set of patterns. The
' network may give an incorrect answer now and then on the test set
' but usually itis not more than one off.
'
' If the training set is large it will probably include every pattern
' consisting of exactly one dot, thus patterns consisting of exactly
' one dot will probably not be in the test set.
'
' Generally, the larger the number of training patterns (patternCount)
' the more accurate the testing. And the larger the number of hidden
' nodes (hiddens) the faster the training converges.
'
' Training automatically stops when the success rate reaches 100% and
' stays there over a full cycle of the training patterns.
'==========================================================================
#Compile Exe
#Dim All
'==========================================================================
%ncol = 20 'dimension of a pattern (%nrow = 1)
%inputsWObias = %ncol 'number of input nodes for the pattern
%inputs = %inputsWObias + 1 'number of input nodes plus one constantly active bias node
%outputs = 5 'number of output nodes, one for each category of pattern
%minSeparation = 3 'must not be too large given %ncol and %outputs
'--------------------------------------------------------------------------
' Windows API constants, types, functions
%PS_SOLID = 0
%SRCCOPY = &HCC0020
%SM_CXSCREEN = 0 :%SM_CYSCREEN = 1
Type RECT
nLeft As Long
nTop As Long
nRight As Long
nBottom As Long
End Type
Type PAINTSTRUCT
hDC As Dword
fErase As Long
rcPaint As RECT
fRestore As Long
fIncUpdate As Long
rgbReserved(0 To 31) As Byte
End Type
Declare Function MoveToEx Lib "GDI32.DLL" Alias "MoveToEx" (ByVal hdc As Dword, ByVal x As Long, ByVal y As Long, lpPoint As PointAPI) As Long
Declare Function LineTo Lib "GDI32.DLL" Alias "LineTo" (ByVal hDC As Dword, ByVal X As Long, ByVal Y As Long) As Long
Declare Function Ellipse Lib "GDI32.DLL" Alias "Ellipse" (ByVal hdc As Dword, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function FillRect Lib "USER32.DLL" Alias "FillRect" (ByVal hDC As Dword, lpRect As RECT, ByVal hBrush As Dword) As Long
Declare Function FrameRect Lib "USER32.DLL" Alias "FrameRect" (ByVal hDC As Dword, lpRect As RECT, ByVal hBrush As Dword) As Long
Declare Function CreateSolidBrush Lib "GDI32.DLL" Alias "CreateSolidBrush" (ByVal crColor As Dword) As Dword
Declare Function CreatePen Lib "GDI32.DLL" Alias "CreatePen" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Dword) As Dword
Declare Function TextOut Lib "GDI32.DLL" Alias "TextOutA" (ByVal hdc As Dword, ByVal x As Long, ByVal y As Long, Asciiz, ByVal nCount As Long) As Long
Declare Function GetDC Lib "USER32.DLL" Alias "GetDC" (ByVal hWnd As Dword) As Dword
Declare Function CreateCompatibleDC Lib "GDI32.DLL" Alias "CreateCompatibleDC" (ByVal hdc As Dword) As Dword
Declare Function CreateCompatibleBitmap Lib "GDI32.DLL" Alias "CreateCompatibleBitmap" (ByVal hdc As Dword, ByVal nWidth As Long, ByVal nHeight As Long) As Dword
Declare Function SelectObject Lib "GDI32.DLL" Alias "SelectObject" (ByVal hdc As Dword, ByVal hObject As Dword) As Dword
Declare Function DeleteObject Lib "GDI32.DLL" Alias "DeleteObject" (ByVal hObject As Dword) As Long
Declare Function ReleaseDC Lib "USER32.DLL" Alias "ReleaseDC" (ByVal hWnd As Dword, ByVal hDC As Dword) As Long
Declare Function SetBkColor Lib "GDI32.DLL" Alias "SetBkColor" (ByVal hdc As Dword, ByVal crColor As Dword) As Dword
Declare Function SetTextColor Lib "GDI32.DLL" Alias "SetTextColor" (ByVal hdc As Dword, ByVal crColor As Dword) As Dword
Declare Function InvalidateRect Lib "USER32.DLL" Alias "InvalidateRect" (ByVal hWnd As Dword, lpRect As RECT, ByVal bErase As Long) As Long
Declare Function GetSystemMetrics Lib "USER32.DLL" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Declare Function BeginPaint Lib "USER32.DLL" Alias "BeginPaint" (ByVal hWnd As Dword, lpPaint As PAINTSTRUCT) As Long
Declare Function EndPaint Lib "USER32.DLL" Alias "EndPaint" (ByVal hWnd As Dword, lpPaint As PAINTSTRUCT) As Long
Declare Function ShellExecute Lib "SHELL32.DLL" Alias "ShellExecuteA" (ByVal hwnd As Dword, lpOperation As Asciiz, lpFile As Asciiz, lpParameters As Asciiz, lpDirectory As Asciiz, ByVal nShowCmd As Long) As Dword
Declare Function BitBlt Lib "GDI32.DLL" Alias "BitBlt" (ByVal hDestDC As Dword, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Dword, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Dword) As Long
'------------------------------------------------------------------------------------------
Declare Sub DefineColors
Declare Sub DefineCoordinatesInput (x() As Long, Long)
Declare Sub DefineCoordinatesHidden(x() As Long, Long)
Declare Sub DefineCoordinatesOutput(x() As Long, Long)
Declare Sub Printit(ByVal String, ByVal Long, ByVal Long)
Declare Sub PrintitHighlight(ByVal String, ByVal Long, ByVal Long)
Declare Function Sigma(Precision) As Precision
Declare Function SigmaInv(Precision) As Precision
Declare Function Bell As Precision
Declare Function InputBox(ByVal String, ByVal Long) As Long
Declare CallBack Function ForInputBox
Declare CallBack Function MainCallback
' Major gosubs within MainCallback:
' ResetNet
' WorkNet
'==========================================================================================
Macro seed = Timer
Macro Precision = Single 'using Single converges in a bit fewer training steps rather than Double, oddly enough
%sigmoid = 0 'see Else comment below -- FIXED, 0 results in fewer steps to convergence
%separableTD = 1 'TransferDeriv() = Arch(Transfer()) -- FIXED, 1 is a tiny bit faster
#If %sigmoid
Macro Transfer(x) = 1 / (1 + Exp(-x)) '(-oo, +oo) --> (0, 1); Transfer(-oo) = 0, Transfer(0) = .5, Transfer(+oo) = 1
Macro TransferInv(x) = Log(x / (1 - x)) '0 < x < 1; inverse of Transfer, used in Color Key display, not the netork computation
#If %separableTD
Macro Arch(x) = x * (1 - x) '0 <= x <= 1; Arch(0) = 0, Arch(.5) = .25, Arch(1) = 0
#Else
Macro TransferDeriv(x) = (Transfer(x) * (1 - Transfer(x))) 'Transfer'(x) or d Transfer(x) / dx = .25 when x = 0
#EndIf
#Else 'piecewise linear (converges in the same or fewer training steps compared with sigmoid, usually fewer)
Declare Function Transfer(Precision) As Precision
Declare Function TransferInv(Precision) As Precision
#If %separableTD
Declare Function Arch(Precision) As Precision
#Else
Declare Function TransferDeriv(Precision) As Precision
#EndIf
Macro xc = 4 'anything between 4 and 6 inclusive works well
Macro xcD = (xc * 2) 'parentheses are necessary
Function Transfer(x As Precision) As Precision ' | not to scale, slope of central line segment is 1/8 when xc = 4
If x <= - xc Then ' | ________
' Function = 0 ' |/
ElseIf x <= xc Then ' /
Function = (x + xc) / xcD ' _________/|_ _ _ _ _
Else ' | x
Function = 1 ' |
End If ' |
End Function
#If %separableTD
'want TransferDeriv(x) = Arch(Transfer(x))
Function Arch(x As Precision) As Precision 'or Arch(u) = TransferDeriv(TransferInv(u))
If x <= 0 Then '= would work as well because Arch is applied to Transfer
' Function = 0
ElseIf x >= 1 Then 'ditto
' Function = 0
Else
Function = 1 / xcD
End If
End Function
#Else
Function TransferDeriv(x As Precision) As Precision
If x <= - xc Then
' Function = 0
ElseIf x <= xc Then
Function = 1 / xcD
Else
' Function = 0
End If
End Function
#EndIf
Function TransferInv(x As Precision) As Precision
If x <= 0 Then
Function = - xc
ElseIf x <= 1 Then
Function = (x - .5) * xcD
Else
Function = xc
End If
End Function
#EndIf
Macro MakeColorIndex(x) = Fix(1.5 + %ncolor1 * x) '0 <= x <= 1
Macro SelectnetPen(x) = SelectObject winDC, netPen(x) 'net lines
Macro SelectnodePen(x) = SelectObject winDC, nodePen(x) 'node circumference
Macro SelectnodeBrush(x) = SelectObject winDC, nodeBrush(x) 'node interior
Macro SelectNodeSolid(x) = SelectnodePen(x) :SelectnodeBrush(x)
Macro SelectDarkMarker = SelectObject winDC, darkPen :SelectObject winDC, darkBrush 'output nodes
Macro SelectLightMarker = SelectObject winDC, lightPen :SelectObject winDC, lightBrush '
Macro DrawLine(x1,y1, x2,y2)
MoveToEx winDC, x1,y1, ByVal 0
LineTo winDC, x2,y2
End Macro
Macro Divider(y)
rpixel.nTop = y - 2
rpixel.nBottom = y
FillRect winDC, rpixel, netBrush(0)
End Macro
'--------------------------------------------------------------------------
Global pd As Precision
Global lowerlimit As Precision, upperlimit As Precision
Global winDC, hform As Dword
Global patternCount As Long 'number of training patterns
Global radM As Long
Global darkBrush, darkPen As Long
Global lightBrush, lightPen As Long
Global mediumBrush As Long
Global blackBrush, blackPen As Long
Global exitFlag As Long
Global updateScreenFlag As Long
Global hiddensWObias As Long 'number of hidden nodes excluding bias
Global IBvalue, IBreturn As Long
Global netPen(), netBrush() As Long 'dimensioned in PBMain
Global nodePen(), nodeBrush() As Long '
'--------------------------------------------------------------------------
%dialogWidth = 1600 'dimensions of main window, see GetSystemMetrics in PBMain
%dialogHeight = 900
%Yupdatescreen = 343
%Yhiddens = %Yupdatescreen + 31
%YTrainingPatterns = %Yupdatescreen + 62
%Ytraincount = 260
%YtrainTest = 185
%Xout0 = 32
%Xout = %Xout0 + 128
%Yout = 815
%Yinfo0 = 456
%Xout1 = 1195
%Yinfo1 = 700
%Ybutton = %Yupdatescreen 'keyboard glossary vertical position
%KBG = 1100 'keyboard glossary horizontal position
%hide = -100 'for hiding buttons when only want key
%YErrorCount = 760
%Xstepcount = %Xout0
%Xwrong = %Xout0 + 60
%Xindefinite = %Xout0 + 130
%Xpcterror = %Xout0 + 220
%Ysuccess = 286
%Yinput = -48
%Ybrightest = 23
%Yvariance = -6
%stx = %xout0 'position of compact pattern display at upper left
%sty = 156
%rad = 20 'radius of an output node
%radH = %rad \ 2
%rad1 = %rad - 1
%pixelsize = 15 'patterns
%pixelsizeI = 8
%dotsizeIB = 4
%ncolor = 21
%ncolor1 = %ncolor - 1
%ncolorH = %ncolor1 \ 2
%colorindexH = 11 'Fix(1.5 + %ncolor1 * .5) = Fix(1.5 + 20/2)
%resetButton = 100 'arbitrary values for buttons and labels
%trainslowButton = 110
%trainfastButton = 120
%stepButton = 130
%exitButton = 140
%websiteButton = 150
%updateScreenButton = 160
%hiddensButton = 200
%trainingPatternsButton = 250
%valueUpbutton = 300 :%valueUpbutton2 = 301 :%valueUpbutton3 = 302
%valueDownButton = 310 :%valueDownButton2 = 311 :%valueDownButton3 = 312
%valueEnterButton = 330
%valueCancelButton = 335
%IBvalueLabel = 340
%statusSign = 350
%starting =-1 'arbitrary values for programstatus
%stopped = 0
%stepping = 1
%trainingFast = 2
%trainingSlow = 3
%textcolor = &hD0D0D0
%dimtextcolor = &h808080
%lightred = &h6060FF
%darkyellow = &h004040
%lightyellow = &h00E0E0
%mediumyellow = &h00B0B0
%orange = &h008CFF
%greencolor = &h00FF00
%s = 6 :%t = 11 'color key half width, half vertical step
%t2 = %t * 2
%Xck = 1410 'color key horizontal position
'--------------------------------------------------------------------------
' called once by PBMain
Sub DefineColors
Local k As Long
Local rg, gb As Long
Local colour As Long, x As Single
Dim netPen(%ncolor) As Global Long, netBrush(%ncolor) As Global Long
Dim nodePen(%ncolor) As Global Long, nodeBrush(%ncolor) As Global Long
' As what is given transfer goes from -oo to 0 to +oo,
' what it provides goes from 0 to .5 to 1).
' Colors go from blue to dark gray to red.
For k = 1 To %ncolorH + 1
x = (k - 1) / %ncolorH
rg = &h40 * x
colour = RGB(rg, rg, &hFF * (1 - x) + rg)
netPen(k) = CreatePen(%PS_SOLID, 0, colour) :netBrush(k) = CreateSolidBrush(colour)
Next
For k = k To %ncolor
x = (k - (%ncolorH + 1)) / %ncolorH
gb = &h40 * (1 - x)
colour = RGB(gb + &hFF * x, gb, gb)
netPen(k) = CreatePen(%PS_SOLID, 0, colour) :netBrush(k) = CreateSolidBrush(colour)
Next
For k = 1 To %ncolor
x = (k - 1) / %ncolor1
rg = &h40 * (1 - x) + &hFF * x
colour = RGB(rg, rg, 0)
nodePen(k) = CreatePen(%PS_SOLID, 0, colour) :nodeBrush(k) = CreateSolidBrush(colour)
Next
' pens and brushes
darkPen = CreatePen(%PS_SOLID, 0, %darkyellow) :darkBrush = CreateSolidBrush(%darkyellow)
lightPen = CreatePen(%PS_SOLID, 0, %lightyellow) :lightBrush = CreateSolidBrush(%lightyellow)
blackPen = CreatePen(%PS_SOLID, 0, %Black) :blackBrush = CreateSolidBrush(%Black)
mediumBrush = CreateSolidBrush(%mediumyellow)
End Sub
'--------------------------------------------------------------------------
%ds = %pixelsize * (2 * %ncol - 5) \ (%ncol - 2)
%dt = %ncol * %ds + %pixelsize * 8 \ 7
%w = %dt - %pixelsize
%g = %pixelsize + 12
%Ileft = (%dialogWidth - %w) \ 2 - 60
' called by InitDialog for input layer
Sub DefineCoordinatesInput(x() As Long, y As Long)
Local i As Long
y = 80
For i = 1 To %ncol
x(i) = %Ileft + (i - 1) * %g
Next
' input bias
x(%inputs) = x(%inputsWObias) + %ds * 2
End Sub
%Hmidpoint = 730
%Hwidth = 590
' called by InitDialog for hidden layer
Sub DefineCoordinatesHidden(x() As Long, y As Long)
Local Hleft, i As Long
Local ds As Single 'might be very close together
y = 441
ds = %Hwidth / (hiddensWObias + 1) '\ hiddens
Hleft = %Hmidpoint- hiddensWObias * ds / 2 + radm \ 2
For i = 1 To hiddensWObias + 1 'To hiddens
x(i) = Hleft + (i - 1) * ds
Next
End Sub
%Omidpoint = 820
%Owidth = 900
' called by InitDialog for output layer
Sub DefineCoordinatesOutput(x() As Long, y As Long)
Local Oleft, i, ds As Long
y = 800
ds = %Owidth \ %outputs
Oleft = %Omidpoint - %outputs * ds \ 2
For i = 1 To %outputs
x(i) = Oleft + (i - 1) * ds
Next
End Sub
'---------------------------------------------------------------------------
Sub Printit(ByVal a As String, ByVal x As Long, ByVal y As Long)
TextOut winDC, x, y, (a), Len(a)
End Sub
Sub PrintitHighlight(ByVal a As String, ByVal x As Long, ByVal y As Long)
SetTextColor winDC, %greencolor
Printit a, x, y
SetTextColor winDC, %textcolor
End Sub
'---------------------------------------------------------------------------
' This is the cumulative distribution of Exp(x) / (1 + Exp(x)) ^ 2
' which is a bell-shaped curve.
Function Sigma(x As Precision) As Precision
Function = 1 / (1 + Exp(-x))
End Function
' The inverse of Sigma.
Function SigmaInv(x As Precision) As Precision
Function = Log(x / (1 - x))
End Function
%limit = 4 'lowerlimit = Sigma(-%limit), upperlimit = Sigma(%limit)
' This function is like Rnd only instead of uniformly distributed between 0 and 1
' it is Gaussian-like distributed, specifically the probability density is
' Exp(x) / (1 + Exp(x)) ^ 2), restricted to be between -%limit and %limit.
Function Bell As Precision
Local r As Precision
Do
r = Rnd
If r >= lowerlimit And r <= upperlimit Then Exit Do
Loop
Function = SigmaInv(r)
End Function
'---------------------------------------------------------------------------
CallBack Function ForInputBox
If Cb.Msg = %WM_Command Then
Select Case Long Cb.Ctl
Case %IdCancel, %valueCancelButton
IBvalue = 0
Dialog End Cb.Hndl
Case %valueEnterButton, %IdOk
IBreturn = IBvalue 'indirection because user might click window's X
Dialog End Cb.Hndl
Case %valueDownButton, %valueDownButton2, %valueDownButton3
If IBvalue > 1 Then
Decr IBvalue
Control Set Text Cb.Hndl, %IBvaluelabel, Format$(IBvalue)
End If
Case %valueUpButton, %valueUpButton2, %valueUpButton3
Incr IBvalue
Control Set Text Cb.Hndl, %IBvaluelabel, Format$(IBvalue)
End Select
End If
End Function
Function InputBox(ByVal prompt As String, ByVal start As Long) As Long
Local hIB As Dword, y As Long
Dialog Font "Verdana", 10, 0
If InStr(prompt, "hidden") Then y = 159 Else y = 176
Dialog New hform, "",%Xout0+130,y, 174,39, %DS_3DLook + %DS_SetFont + %DS_ModalFrame + %DS_NoFailCreate + %WS_Border + %WS_ClipSiblings + %WS_Popup To hIB
Control Add Label, hIB, 500, prompt,7,5, 170,100
IBvalue = start
IBreturn = 0
Control Add Label, hIB, %IBvalueLabel, Format$(IBvalue), 5,26, 20,10
Control Add Button, hIB, %valueDownbutton, "&,", %hide,0,0,0 'hide, just want key
Control Add Button, hIB, %valueDownbutton2, "&<", %hide,0,0,0
Control Add Button, hIB, %valueDownbutton3, "<", 27,13, 9,10, %BS_Flat
Control Add Button, hIB, %valueUpButton, "&.", %hide,0,0,0
Control Add Button, hIB, %valueUpButton2, ">", 49,13, 9,10, %BS_Flat
Control Add Button, hIB, %valueUpButton3, "&>", %hide,0,0,0
Control Add Button, hIB, %valueEnterButton, "Enter", 135,13, 23,10, %BS_Flat
If y = 159 Then 'see Instr above
Control Add Button, hIB, %valueCancelButton, "&H", %hide,0,0,0 'hide, just want key
Else
Control Add Button, hIB, %valueCancelButton, "&N", %hide,0,0,0
End If
Dialog Show Modal hIB Call ForInputBox
Function = IBreturn
End Function
'---------------------------------------------------------------------------
CallBack Function MainCallback
Static hiddens As Long
Static m As Long 'current input pattern #
Static mv As Long 'current input pattern value
Static n As Long 'count of shown patterns
Static initButton, trainslowButton, trainfastButton, stepButton, exitButton, updateScreenButton, hiddensButton, trainingPatternsButton As Dword 'button handles
Static successcount As Long 'number of successful outputs in last patterncount attempts
Static successcount0 As Long
Static successcount0text As String
Static staticsuccesscount As Long
Static traincount As Long
Static lasttraincycle As Long
Static lastpass As String
Static successcurrent As Long
Static programstatus As Long
Static variance As Single
Static highSuccessCount, targetSuccessReached As Long
Static correct As Long
Static lastcorrect As Long
Static lenTC As Long
Static stepcount, wrongcount, indefinitecount As Long
Local i, j, k, q As Long 'indices
Local hbit As Dword 'temporary bitmap handle
Local outH As Precision 'one of outH()
Local delta As Precision 'one of deltaO() or deltaH()
Local hDC As Dword 'device context
Local hBP As Dword 'used in %WM_Paint
Local ps As PAINTSTRUCT 'used in %WM_Paint
Local outmax As Precision 'used to compute brightest output node
Local outmaxindex As Long
Local outmax2 As Precision 'used to compute second brightest output node
Local outmaxindex2 As Long
Local v As Precision 'intermediate value
Local y0, x0, x1 As Long 'intermediate values
Local rpixel, fpixel As RECT 'for drawing rectangles
Local sum As Precision
Local nv As Long
Local c As Long
Local t As Long
Local w As Precision
Local a As String
Dim success(patternCount - 1) As Static Long 'used: 0 to %outputs
Dim xi(%inputs) As Static Long, yi(%inputs) As Static Long, yi As Static Long
Dim xh(hiddens) As Static Long, yh As Static Long
Dim xo(%outputs) As Static Long, yo As Static Long
Dim weightHI(1 To hiddens, 1 To %inputs) As Static Precision
Dim weightOH(1 To %outputs, 1 To hiddens) As Static Precision '1 To ... required for Mat
#If Not %separableTD
Dim netH(1 To hiddens) As Precision 'netH = weightH * pattern
#EndIf
Dim outH(1 To hiddens) As Static Precision 'outH = Transfer(netH) except outH(hiddens) = 1, which makes Static necessary
Dim netO(1 To %outputs) As Precision 'netO = weightO * outH
Dim outO(1 To %outputs) As Precision 'outO = Transfer(netO)
Dim deltaO(1 To %outputs) As Precision
Dim bitmp(1 To patternCount, 1 To %inputs) As Static Long '%outputs copies of bitmap pattern of %inputs (0 is for blank start when m = 0)
Dim bitmpV(1 To patternCount) As Static Long 'desired output for this pattern
Dim pattern(1 To %inputs) As Long 'current bitmap pattern input, Long but if use Mat must be same type as weightHI()
Dim hp(%outputs) As Long 'used in making random patterns
' Though the "pixels" of our bitmaps are either on or off, bitmp() could be declared as single
' for grayshaded bitmaps. Sections of bitmp() are repeatedly loaded into pattern().
' If use Mat then pattern() must be single to work in the matrix operations on single martrices
' and arrays, so in that case bitmp() would have to be single as well.
' Used in a Mat command: netH(), weightHI(), netO(), weightOH(), outH(), pattern()
' Range and type must match:
' weightH operates on pattern
' weightO operates on outH
' Note: pattern() is no longer used in a Mat command
Select Case Long CbMsg
Case %WM_InitDialog
hDC = GetDC(hform) 'hform = Cb.Hndl
hbit = CreateCompatibleBitmap(hDC, %dialogWidth, %dialogHeight)
winDC = CreateCompatibleDC(hDC)
SelectObject winDC, hbit
DeleteObject hbit
ReleaseDC hform, hDC
hiddens = hiddensWObias + 1 'number of hidden nodes plus one constantly active bias node
GoSub RedimensionArrays
' instructions to user
SetBkColor winDC, %Black
SetTextColor winDC, %textcolor
Printit "Press S or F -- slow or fast -- to train the network.", %Xout0, %Yinfo0
Printit "Training will stop automatically when the success", %Xout0, %Yinfo0 + 16
Printit "rate over one pass ( " + Format$(patternCount) +" patterns ) stays at 100%.", %Xout0, %Yinfo0 + 16*2
Printit "Press S or F again to resume or stop training.", %Xout0, %Yinfo0 + 16*4 - 4
Printit "If training had stopped automatically per above, it", %Xout0, %Yinfo0 + 16*5 - 4
Printit "will continue to train until you stop it manuually", %Xout0, %Yinfo0 + 16*6 - 4
Printit "Press E to step through, without training -- using", %Xout0, %Yinfo0 + 16*8 - 4*3
printit "the last network weights -- random test patterns", %Xout0, %Yinfo0 + 16*9 - 4*3
Printit "that differ from those used during training.", %Xout0, %Yinfo0 + 16*10 - 4*3
Printit "Press R to start over with a new set of", %Xout0, %Yinfo0 + 16*12 - 4*4
Printit "training patterns and initial network weights.", %Xout0, %Yinfo0 + 16*13 - 4*4
Printit "Press X to quit.", %Xout0, %Yinfo0 + 16*15 - 4*5
Printit "The value of a network line is its weight, -oo to +oo,", %Xout1, %Yinfo1
Printit "times the value, 0 to 1, of the node it comes down from.", %Xout1, %Yinfo1 + 16
Printit "The value of a node is the sum of the values of the", %Xout1, %Yinfo1 + 16*3
Printit "lines going down to it, squashed to the range 0 to 1.", %Xout1, %Yinfo1 + 16*4
rpixel.nLeft = %Xout1
rpixel.nRight = %Xout1 + 360
Divider(%Yinfo1 - 6)
Divider(%Yinfo1 + 92)
If hiddens <= 10 Then
radM = 20 'radius of hidden nodes
Else
radM = 200 / hiddens
End If
DefineCoordinatesInput xi(), yi
DefineCoordinatesHidden xh(), yh
DefineCoordinatesOutput xo(), yo
Control Add Label, hform, %statusSign, "", %Xout,%YtrainTest, 68,20, %SS_Center, %WS_Ex_ClientEdge
GoSub Resetsign
' control buttons. or rather keys
Control Add Button, hform, %stepButton, "&E", %hide, 0,0,0 'hide, just want key
Control Add Button, hform, %trainslowButton, "&S", %hide, 0,0,0
Control Add Button, hform, %trainfastButton, "&F", %hide, 0,0,0
Control Add Button, hform, %resetButton, "&R", %hide, 0,0,0
Control Add Button, hform, %exitButton, "&X", %hide, 0,0,0
Control Add Button, hform, %websiteButton, "&W", %hide, 0,0,0
PrintitHighlight "S", %KBG, %Ybutton + 1 :Printit "-- train Slow ( toggle )", %KBG + 24, %Ybutton + 1
PrintitHighlight "F", %KBG, %Ybutton + 25 :Printit "-- train Fast ( toggle )", %KBG + 24, %Ybutton + 25
PrintitHighlight "E", %KBG, %Ybutton + 59 :Printit "-- step test ( no training )", %KBG + 24, %Ybutton + 59
PrintitHighlight "R", %KBG, %Ybutton + 99 :Printit "-- start over ( new training patterns )", %KBG + 24, %Ybutton + 99
PrintitHighlight "X", %KBG, %Ybutton + 140 :Printit "-- exit program", %KBG + 24, %Ybutton + 140
rpixel.nLeft = %KBG
rpixel.nRight = %KBG + 260
Divider(%Ybutton - 8)
Divider(%Ybutton + 168)
PrintitHighlight "G", %Xout0, %Yupdatescreen
PrintIt "-- Update screen if training Fast:", %Xout0 + 30, %Yupdatescreen
GoSub PrintUpdateScreen
Control Add Button, hform, %updateScreenButton, "&G", %hide, 0,0,0
GoSub DisableUpdateScreenButton
PrintitHighlight "H", %Xout0, %Yhiddens
PrintIt "-- Number of ""hidden nodes"":", %Xout0 + 30, %Yhiddens
Printit Format$(hiddensWObias) + " ", %Xout0 + 252,%Yhiddens
Control Add Button, hform, %hiddensButton, "&H", %hide, 0,0,0
PrintitHighlight "N", %Xout0, %YTrainingPatterns
PrintIt "-- Number of training patterns:", %Xout0 + 30, %YTrainingPatterns
Printit Format$(patternCount) + " ", %Xout0 + 252,%YTrainingPatterns
Control Add Button, hform, %trainingPatternsButton, "&N", %hide, 0,0,0
Printit "... Number of training patterns: " + Format$(patterncount) + " ...", %Xout0 + 25, %YTrainTest + 50
Printit "Training pass:", %Xout0, %Ytraincount
Printit "Correct answer:", %Xout0 + 3, %Yout - %Yinput
Printit "Wrong", %Xwrong, %YErrorCount - 36
Printit "Indefinite", %Xindefinite, %YErrorCount - 36
Printit "Steps", %Xstepcount, %YErrorCount - 20
Printit "output", %Xwrong, %YErrorCount - 20
Printit "output", %Xindefinite, %YErrorCount - 20
Printit "Pct. correct", %Xpcterror, %YErrorCount - 20
Printit "Output:", %Xout0 + 60, %Yout - %Ybrightest
Printit "Variance:", %Xout0 + 46, %Yout - %Yvariance
Printit "Success rate:", %Xout0, %Ysuccess
Printit "Color Key", %xck + 13, 166
Printit "net nodes", %xck - 10, 189
rpixel.nLeft = %Xout0
rpixel.nRight = %Xout0 + 325
Divider(%Yupdatescreen - 18)
Divider(%Yinfo0 - 12)
Divider(%YErrorCount - 55)
Printit ". . . . . . . . . . . . . .",%Xout0 + 177, %Yout - %Ybrightest - 3
Printit ". . . . . . . . . . . . . .",%Xout0 + 177, %Yout - %Yvariance - 3
Printit ". . . . . . . . . . . . . .",%Xout0 + 177, %Yout - %Yinput - 3
i = 214
For q = %ncolor To 1 Step -1
rpixel.nLeft = %xCK - %s
rpixel.nRight = %xCK + %s
rpixel.nTop = i - %t + 5
rpixel.nBottom = i + %t + 5
FillRect winDC, rpixel, netBrush(q) 'net lines
v = (q - 1) / %ncolor1
If q = %ncolor Then
Printit "+ o", 19 + %xCK, i-2 :Printit "o", 38 + %xCK, i-2 '+ oo
ElseIf q = 1 Then
Printit "-- o", 18 + %xCK, i-2 :Printit "o", 37 + %xCK, i-2 '- oo
Else
Printit Format$(TransferInv(v), "+ 0.00;-- 0.00; 0.00"), 18 + %xCK, i
End If
Printit Format$(v, "0.00"), 116 + %xCK, i
rpixel.nLeft = %xCK - %s + 95
rpixel.nRight = %xCK + %s + 95
FillRect winDC, rpixel, nodeBrush(q) 'nodes
i = i + %t2
Next
SetTextColor winDC, %Cyan
PrintitHighlight "W", 1424, 860 :Printit "-- open website", 1424+26, 860
SetTextColor winDC, %textcolor
GoSub ResetNet
Case %WM_Paint
If programstatus <> %stopped Then
GoSub WorkNet
hBP = BeginPaint(hform, ps)
BitBlt hBP, 0, 0, %dialogWidth, %dialogHeight, winDC, 0, 0, %SRCCOPY
EndPaint hform, ps
Function = 1 'tell Windows the paint message was processed
If programstatus = %starting Then
programstatus = %stepping :GoSub UpdateButtons
Exit Select
End If
If programstatus = %trainingSlow Then
Sleep 400
ElseIf programstatus = %stepping Then
programstatus = %stopped :GoSub UpdateButtons
GoSub TestSign
End If
GoSub RefreshWindow
End If
Case %WM_Command
If CbCtlMsg = %BN_Clicked Then
Select Case Long CbCtl
Case %resetButton 'Reset
GoSub EnableSomeButtons
GoSub ResetSign
GoSub ResetNet
GoSub DisableUpdateScreenButton
GoSub ClearTrainCount
GoSub RefreshWindow
Case %trainslowButton 'Toggle slow training
If programstatus = %trainingSlow Then
programstatus = %stopped
Else
programstatus = %trainingSlow
End If
GoSub ClearTrainCount
GoSub UpdateButtons
GoSub DisableUpdateScreenButton
GoSub ClearStep
GoSub RefreshWindow
Sleep 1 'prevents crash if pressing Reset simultaneously
Case %trainfastButton 'Toggle fast training
If programstatus = %trainingFast Then
programstatus = %stopped
Else
programstatus = %trainingFast
End If
GoSub ClearTrainCount
GoSub UpdateButtons
GoSub ClearStep
GoSub RefreshWindow
Sleep 1 'prevents crash if pressing Reset simultaneously
Case %stepButton 'Step through test patterns without training
If programstatus >= %trainingFast Then 'training fast or slow
programstatus = %stopped
Else
programstatus = %stepping
GoSub TestSign
End If
GoSub UpdateButtons
GoSub DisableUpdateScreenButton
GoSub RefreshWindow
Case %exitButton 'Exit program
exitFlag = 1
Dialog End hform
Case %websiteButton
If MsgBox("Exit program and open website ?", %MB_OkCancel," ") = %IdOk Then
ShellExecute 0, "open", "http://ARIwatch.com/VS/Algorithms", "", "", %SW_ShowNormal
exitFlag = 1
Dialog End hform
End If
Case %updateScreenButton 'Update screen while training fast
If programstatus <> %trainingfast Then Exit Select 'screen won't update
updateScreenFlag = 1 - updateScreenFlag
GoSub PrintUpdateScreen
GoSub ClearCorrectOutput
GoSub RefreshWindow
Case %hiddensButton 'Change number of hidden nodes
If programstatus <> %stopped And programstatus = %starting Then Exit Select
k = InputBox("Change the number of ""hidden nodes.""" + $CrLf + _
"Press < or > (fewer or more) then Enter :", hiddensWObias)
If Not (k = 0 Or k = hiddensWObias) Then
hiddensWObias = k
Dialog End hform 'clear screen
End If
Case %trainingPatternsButton 'Change number of training patterns
If programstatus <> %stopped And programstatus = %starting Then Exit Select
k = InputBox("Change the number of training patterns." + $CrLf + _
"Press < or > (fewer or more) then Enter :", patternCount)
If Not (k = 0 Or k = patternCount) Then
patternCount = k
' Dialog End hform -- needn't clear entire screen
a = Format$(patternCount)
Printit a, %Xout0+ 138, %Yinfo0 + 16*2
Printit a + " ", %Xout0 + 252,%YTrainingPatterns
Printit a, %Xout0 + 230, %YTrainTest + 50
GoSub RefreshWindow
GoSub RedimensionArrays1
GoSub ResetSign
GoSub Resetnet
End If
End Select
End If
End Select
Exit Function
'======================== GOSUBS ==============================================================
RedimensionArrays:
' these ReDims are necessary because hiddens and patternCount are variable
ReDim weightHI(1 To hiddens, 1 To %inputs)
ReDim xh(hiddens)
ReDim weightOH(1 To %outputs, 1 To hiddens)
#If Not %separableTD
ReDim netH(1 To hiddens)
#EndIf
ReDim outH(1 To hiddens)
RedimensionArrays1:
ReDim success(patternCount - 1)
ReDim bitmp(1 To patternCount, 1 To %inputs)
ReDim bitmpV(1 To patternCount)
Return
'==============================================================================================
RefreshWindow:
InvalidateRect hform, ByVal 0, 0
Return
'==============================================================================================
DisableSomeButtons:
Control Disable hform, %hiddensButton
Control Disable hform, %trainingPatternsButton
Return
EnableSomeButtons:
Control Enable hform, %hiddensButton
Control Enable hform, %trainingPatternsButton
Return
'-----------------------------------------------------
DisableUpdateScreenButton:
Control Disable hform, %updateScreenButton
Return
EnableUpdateScreenButton:
Control Enable hform, %updateScreenButton
Return
'-----------------------------------------------------
UpdateButtons:
Select Case Long programstatus
' Case %starting
Case %stopped
GoSub EnableSomeButtons
GoSub DisableUpdateScreenButton
GoSub StopSign
' Case %stepping GoSub TestSign done already
Case %trainingFast
GoSub ClearSuccessRateSign
GoSub TrainSign
GoSub DisableSomeButtons
GoSub EnableUpdateScreenButton
Case %trainingSlow
GoSub ClearSuccessRateSign
GoSub TrainSign
End Select
Return
'==============================================================================================
PrintUpdateScreen:
If updateScreenFlag Then
PrintIt "Yes", %Xout0 + 252, %Yupdatescreen
Else
PrintIt "No ", %Xout0 + 252, %Yupdatescreen
End If
Return
'==============================================================================================
' Ww define the variance as the square root of the average square of the difference
' between the outputs and what they should be, after scaling all outputs up so that
' the brightest is 1 (that is, dividing all outO() by outputmax).
ComputePrintVariance:
sum = 0
For k = 1 To %outputs
If k <> outmaxindex Then
sum = sum + (outO(k) / outmax) ^ 2
' Else
' sum = sum + (1 - outmax) ^ 2 'outO(outmaxindex) / outmax = 1
End If
Next
variance = Sqr(sum / %outputs)
Printit Format$(variance, "0.00 "), %Xout - 3, %Yout - %Yvariance
Return
'==============================================================================================
ClearCorrectOutput:
' draw placeholders for correct output
For i = 1 To %outputs
SelectDarkMarker
Ellipse winDC, xo(i) - %rad, yo - %rad + 72, xo(i) + %rad, yo + %rad + 72
Next
Return
'==============================================================================================
ClearTrainCount:
Printit "0.0 ", %Xout, %ytraincount
Return
'==============================================================================================
ClearSuccessRateSign: 'auto-stop and convergence failure sign
Printit Space$(21+15), %Xout + 60, %Ysuccess
Return
'==============================================================================================
ClearStep:
Printit Space$(75), %Xstepcount, %YerrorCount
stepcount = 0 :wrongcount = 0 :indefinitecount = 0
Return
ResetSign:
Control Set Text hform, %statusSign, "Reset"
GoSub ClearStep
GoSub ClearLowerNeters
Return
StopSign:
Control Set Text hform, %statusSign, "Stopped"
Return
ClearLowerNeters:
Printit " ", %Xout - 2, %Yout - %Ybrightest
Printit " ", %Xout - 2, %Yout - %Yvariance
Printit " ", %Xout - 2, %Yout - %Yinput
Return
TrainSign:
SetTextColor winDC, %Black :SetBkColor winDC, %orange 'black on orange
Printit " Training ", %Xout, %YtrainTest + 2
SetTextColor winDC, %textcolor :SetBkColor winDC, %Black 'white on black
If updateScreenFlag = 0 And programstatus = %trainingFast Then 'clear lower meters
GoSub ClearLowerNeters
End If
Return
TestSign:
Control Set Text hform, %statusSign, "Testing"
Return
'===========================================================================================
ResetNet:
Randomize seed
Reset bitmp()
For j = 1 To patternCount
GetDots:
nv = Rnd(1, %outputs) 'number of dots
For c = 1 To nv
t = 0
Do
Incr t
If t > 10000 Then GoTo GetDots 'start over
k = Rnd(1, %ncol) 'horizontal position
For i = 1 To c - 1
If Abs(k - hp(i)) < %minSeparation Then Iterate Do
Next
hp(c) = k
Exit Do
Loop
bitmp(j, k) = 1 'create the pattern array
Next
bitmpV(j) = nv
' Is it unique?
For i = 1 To j - 1
If nv <> bitmpV(i) Then GoTo NextJ
For q = 1 To %ncol
If bitmp(i, q) <> bitmp(j, q) Then GoTo NextJ
Next
' found, try again; first erase it
For q = 1 To %ncol
bitmp(j, q) = 0
Next
GoTo GetDots
NextJ:
Next
' input bias
bitmp(j, %inputs) = 1 'the input bias value is always 1
Next
' Dim Identity(1 To %outputs, 1 To %outputs) As Static Single 'the identity matrix
' Mat Identity() = Idn 'Identity(i ,j) = 1 when i = j, 0 otherwise
' erase success rate
Printit "--- ", %Xout, %Ysuccess
GoSub ClearSuccessRateSign
For i = 1 To %inputs 'input nodes to hidden nodes
For j = 1 To hiddens
weightHI(j, i) = Bell
Next
Next
' see pattern(%inputs) = 1 below for input bias
For j = 1 To hiddens 'To hiddensWObias + 1, weights from hidden nodes to output nodes
For k = 1 To %outputs
weightOH(k, j) = Bell 'must vary, cannot be fixed (at least for j <= hiddensWObias)
Next
Next
outH(hiddens) = 1 'hidden bias, always 1
n = -1 'count of shown patterns, training or stepping
programstatus = %starting 'draw network and revert to %stopped
traincount = -1
lasttraincycle = -1
lastpass = ""
successcount = 0
successcount0 = 0
highSuccessCount = 0
targetSuccessReached = 0
correct = 0
staticsuccesscount = 0
Reset success()
' draw placeholders for correct output
GoSub ClearCorrectOutput
Return
'=========================================================================================
' m = # of pattern being presented, from 0 to patternCount (0 indicates no pattern)
WorkNet:
Incr n 'at start n goes from -1 to 0
If programstatus = %stepping Then
m = n Mod patterncount + 1 'at start m is 1
Else
' Incr traincount
k = traincount \ patternCount
If k <> lasttraincycle Then
Printit Format$(k), %Xout, %ytraincount
lenTC = Len(Format$(k))
End If
a = Format$(Frac(traincount / patterncount), ".0") '(traincount - k * patternCount) / patterncount
If a <> lastpass Then '(traincount / patterncunt - k
If k = 9 And a = ".0" Then Incr lenTC
Printit a, %Xout + 8 * lenTC + 1, %Ytraincount
lastpass = a
End If
' m = (traincount - 1) Mod patternCount + 1
m = traincount Mod patternCount + 1
Incr traincount
End If
mv = bitmpV(m)
' copy current bitmap, the m'th, to pattern array
If n = 0 Then
Reset pattern() 'here at start
pattern(%inputs) = 1 'input bias
Else
If programstatus <> %stepping Then
For i = 1 To %inputs
pattern(i) = bitmp(m, i)
Next
lastcorrect = correct
correct = mv 'see above
Else '%stepping - create a pattern different from all the training patterns
GetDots2:
Reset pattern()
nv = Rnd(1,%outputs) 'number of dots in the pattern
For c = 1 To nv
t = 0
Do
Incr t
If t > 10000 Then GoTo GetDots2 'start over
k = Rnd(1, %ncol) 'horizontal position of new dot
For i = 1 To c - 1 'check if too near a previous dot
If Abs(k - hp(i)) < %minSeparation Then Iterate Do
Next
hp(c) = k 'save it
Exit Do
Loop
pattern(k) = 1 'create the pattern array
Next
' is this pattern in the training collection?
For i = 1 To patternCount 'compare with each training pattern
If nv <> bitmpV(i) Then GoTo NextJJ 'no, try next training pattern
For q = 1 To %ncol
If bitmp(i, q) <> pattern(q) Then GoTo NextJJ 'no, try next
Next
GoTo GetDots2 'yes, make another test pattern
NextJJ:
Next
' input bias
pattern(%inputs) = 1
lastcorrect = correct
correct = nv
End If
End If
If updateScreenFlag = 1 Or programstatus <> %trainingFast Then'~~~~~~~~~~~~~~~~~~~~
' draw current input pattern at upper left
rpixel.nTop = %sty
rpixel.nBottom = %sty + %pixelsize
fpixel.nTop = %sty - 1
fpixel.nBottom = %sty + %pixelsize + 1
For j = 0 To %ncol - 1
rpixel.nLeft = %stx + j * 16
rpixel.nRight = rpixel.nLeft + %pixelsize
fpixel.nLeft = rpixel.nLeft - 1
fpixel.nRight = rpixel.nRight + 1
If pattern(j + 1) Then 'bitmp(*, j + 1)
FillRect winDC, rpixel, lightBrush
FrameRect winDC, fpixel, mediumBrush
Else
FillRect winDC, rpixel, darkBrush
FrameRect winDC, fpixel, darkBrush
End If
Next
End If'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' calculate and draw the nets and outs for each node
' weightHI(1 To hiddens, 1 To %inputs)
' pattern(1 To %inputs)
' netH(1 To hiddens)
' Mat netH() = weightHI() * pattern()
For j = 1 To hiddens
sum = 0
For i = 1 To %inputs
If pattern(i) Then 'either 0 or 1
sum = sum + weightHI(j, i) '* pattern(i)
End If
Next
#If Not %separableTD
netH(j) = sum
#Else
outH(j) = Transfer(sum)
#EndIf
Next
If updateScreenFlag = 1 Or programstatus <> %trainingFast Then'~~~~~~~~~~~~~~~~~~~~
' erase net from inactive input nodes
SelectnetPen(%colorindexH) 'Transfer(0) = .5
For j = 1 To hiddensWObias 'hidden and not bias (already have set outH(hiddens) = 1)
For i = 1 To %inputsWObias 'input
If pattern(i) = 0 Then
DrawLine(xi(i), yi, xh(j), yh)
End If
Next
#If Not %separableTD 'done above is %separableTD
' calculate resulting output from hidden node j
outH(j) = Transfer(netH(j))
#EndIf
Next
' draw connections from input nodes to hidden nodes
For j = 1 To hiddensWObias 'hidden but not bias
For i = 1 To %inputsWObias 'input
If pattern(i) Then
SelectnetPen(MakeColorIndex(Transfer(weightHI(j, i) * pattern(i))))
DrawLine(xi(i), yi, xh(j), yh)
End If
Next
' input bias, %inputs = i
SelectnetPen(MakeColorIndex(Transfer(weightHI(j, %inputs)))) 'pattern(%inputs) = 1
DrawLine(xi(%inputs), yi, xh(j), yh)
Next
' draw input nodes at mid top (do after the above to cover net lines going into the input nodes)
rpixel.nTop = yi - %pixelsizeI - 5
rpixel.nBottom = yi + %pixelsizeI - 5
For i = 1 To %inputsWObias
rpixel.nLeft = xi(i) - %pixelsizeI
rpixel.nRight = xi(i) + %pixelsizeI
If pattern(i) Then 'bitmp(*, i)
FillRect winDC, rpixel, lightBrush
Else
FillRect winDC, rpixel, darkBrush
End If
Next
' and input bias
' here i = %inputs, input bias, always on, isn't in InitDialog as must cover net lines
SelectObject winDC, lightPen :SelectObject winDC, lightBrush
Ellipse winDC, xi(%inputs) - %dotsizeIB, yi - %dotsizeIB \ 2 + 4, xi(%inputs) + %dotsizeIB, yi - %dotsizeIB \ 2 - 4
#If Not %separableTD
Else'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For j = 1 To hiddensWObias 'hidden and not bias
' calculate resulting output from hidden node k
outH(j) = Transfer(netH(j))
Next
#EndIf
End If'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' calculate netO() and outO() for output layer
Mat netO() = weightOH() * outH()
If updateScreenFlag = 1 Or programstatus <> %trainingFast Then'~~~~~~~~~~~~~~~~~~~~
For k = 1 To %outputs
x0 = xo(k)
For j = 1 To hiddens
' draw connections
SelectnetPen(MakeColorIndex(Transfer(outH(j) * weightOH(k, j))))
DrawLine(xh(j), yh, x0, yo)
Next
outO(k) = Transfer(netO(k)) 'could dispense with netO() if didn't use Mat
Next
' draw hidden nodes
For j = 1 To hiddensWObias
SelectNodeSolid(MakeColorIndex(outH(j)))
Ellipse winDC, xh(j) - radM, yh - radM, xh(j) + radM, yh + radM
Next
' and hidden bias)
SelectNodeSolid(MakeColorIndex(outH(hiddens))) 'outH(hiddens) = 1
Ellipse winDC, xh(hiddens) - %dotsizeIB, yh - %dotsizeIB, xh(hiddens) + %dotsizeIB, yh + %dotsizeIB
Else'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For k = 1 To %outputs
outO(k) = Transfer(netO(k))
Next
End If'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' draw output nodes
outmax = -1
If updateScreenFlag = 1 Or programstatus <> %trainingFast Then'~~~~~~~~~~~~~~~~~~~~
For k = 1 To %outputs 'only the color (brightness) of the larger disk changes
v = outO(k)
x0 = xo(k)
SelectNodeSolid(MakeColorIndex(outO(k)))
Ellipse winDC, x0 - %rad, yo - %rad, x0 + %rad, yo + %rad
SelectNodeSolid(1)
Ellipse winDC, x0 - %radH, yo - %radH, x0 + %radH, yo + %radH
SetBkColor winDC, &h007070
SetTextColor winDC, %White
Printit Format$(k), x0 - 4, yo - 8
SetBkColor winDC, %Black
SetTextColor winDC, %textcolor
Printit Format$(v, "0.000"), x0 - 20, yo + 22
If v > outmax Then
outmax = v :outmaxindex = k
End If
Next
Else'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For k = 1 To %outputs
v = outO(k)
If v > outmax Then
outmax = v :outmaxindex = k
End If
Next
End If'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If programstatus = %starting Then
Return
End If
If updateScreenFlag Or programstatus = %trainingslow Then
GoSub ComputePrintVariance
End If
If programstatus = %stepping Then
Incr stepcount
If Not updateScreenFlag Then
GoSub ComputePrintVariance
End If
' An output is counted a success when the output node with the
' largest value (and which is unique in that regard) indicates
' the input. It will be unique if the variance is not too high.
' Also find the second largest output node.
If variance > 0.3 Then
outmax2 = -1 'find second brightest output node
For k = 1 To %outputs
If k <> outmaxindex Then
v = outO(k)
If v > outmax2 Then
outmax2 = v :outmaxindex2 = k
End If
End If
Next
SetTextColor winDC, %lightRed
If outmaxindex > outmaxindex2 Then Swap outmaxindex, outmaxindex2
Printit Format$(outmaxindex) + " ... " + Format$(outmaxindex2), %Xout, %Yout - %Ybrightest
Sleep 100
SetTextColor winDC, %textcolor
Incr indefinitecount
Else
Printit Format$(outmaxindex) + Space$(10), %Xout, %Yout - %Ybrightest
If outmaxindex <> correct And lastcorrect > 0 Then
SetTextColor winDC, %lightRed
Printit "X", %Xout + 20, %Yout - %Ybrightest
Sleep 100
SetTextColor winDC, %textcolor
Incr wrongcount
End If
End If
PrintIt Format$(correct), %Xout, %Yout - %Yinput
Printit Format$(stepcount), %Xstepcount, %YErrorCount
Printit Format$(wrongcount), %Xwrong, %YErrorCount
Printit Format$(indefinitecount), %Xindefinite, %YErrorCount
Printit Format$((stepcount - wrongcount - indefinitecount) * 100/ stepcount,"0") + " % ", %Xpcterror, %YErrorCount
If targetSuccessReached Then 'only necessary if trained beyond target, but doesn't hurt to do it twice
GoSub ClearCorrectOutput
End If
Else
If updateScreenFlag = 1 Or programstatus <> %trainingFast Then'~~~~~~~~~~~~~~~~~~
Printit Format$(outmaxindex) + Space$(10), %Xout, %Yout - %Ybrightest
If outmaxindex <> correct And lastcorrect > 0 Then
SetTextColor winDC, %lightRed
Printit "X", %Xout + 20, %Yout - %Ybrightest
SetTextColor winDC, %textcolor
End If
PrintIt Format$(correct), %Xout, %Yout - %Yinput
End If'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
successcurrent = - (k > %outputs And outmaxindex = correct) '1 if success, 0 if failure
If successcurrent Then
Incr successcount
End If
If traincount > patternCount Then successcount = successcount - success(0)
If successcount <= successcount0 And targetSuccessReached = 0 Then 'no prograss
Incr staticsuccesscount
If staticsuccesscount > patterncount * 12 Then
Printit "Failure to Converge", %Xout + 60 + 6, %Ysuccess
' Printit " ", %Xout, %Ysuccess
' staticsuccesscount = 0
' For i = 1 To %inputs
' For j = 1 To hiddens
' weightHI(j, i) = Bell
' Next
' Next
' For j = 1 To hiddens
' For k = 1 To %outputs
' weightOH(k, j) = Bell
' Next
' Next
' Exit If
programstatus = %stopped :GoSub UpdateButtons
staticsuccesscount = 0
Return
End If
Else
staticsuccesscount = 0
End If
If successcount <> successcount0 Then
w = successcount * 100/ patternCount
If w >= 99 And successcount <> patternCount Then 'the second condition is w <> 100
a = Format$(w, "0.0")
Else
a = Format$(w, "0")
End If
If a <> successcount0text Then
Printit a + " % ", %Xout, %Ysuccess
successcount0text = a
End If
successcount0 = successcount
End If
For i = 0 To patternCount - 2 'make room at end for successcurrent
success(i) = success(i + 1)
Next 'success(0) is the new oldest
success(patternCount - 1) = successcurrent
If successcount = patternCount Then
Incr highSuccessCount
Else
highSuccessCount = 0
End If
End If
If updateScreenFlag = 1 Or programstatus <> %trainingFast Then'~~~~~~~~~~~~~~~~~~~~
' draw correct output
If lastcorrect <> 0 And correct <> 0 Then
SelectDarkMarker
Ellipse winDC, xo(lastcorrect) - %rad, yo - %rad + 72, xo(lastcorrect) + %rad, yo + %rad + 72
SelectLightMarker
x0 = xo(correct)
Ellipse winDC, x0 - %rad, yo - %rad + 72, x0 + %rad, yo + %rad + 72
SelectNodeSolid(1)
Ellipse winDC, x0 - %radH, yo - %radH + 72, x0 + %radH, yo + %radH + 72
SetTextColor winDC, %White
SetBkColor winDC, &h007070
Printit Format$(correct), x0 - 4, yo + 64
SetTextColor winDC, %textcolor
SetBkColor winDC, %Black
End If
End If'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If programstatus <> %stepping Then
If highSuccessCount = patternCount And targetSuccessReached = 0 Then
Printit "Auto-stopped", %Xout + 60, %Ysuccess
programstatus = %stopped :GoSub UpdateButtons
targetSuccessReached = 1 'highSuccessCount = 0
Return
End If
Else
Return
End If
'------------- TRAINING --------------
' Adjust the weights based on the difference between the output and the value of the input pattern.
' mv is the correct answer.
' For k = 1 To %outputs
' deltaO(k) = Identity(mv, k) - outO(k)
' Next
For k = 1 To %outputs 'faster than above
deltaO(k) = - outO(k)
Next '
Incr deltaO(mv) 'deltaO(mv) = 1 - outO(mv)
For j = 1 To hiddens
outH = outH(j) '= Transfer(netH(j))
sum = 0
For k = 1 To %outputs
w = weightOH(k, j) 'save for sum
delta = deltaO(k)
' adjust weights for the output layer, used in computing netO()
weightOH(k, j) = w + delta * outH
' sum will be used to compute delta for the hidden layer
sum = sum + delta * w
Next
' compute delta for the hidden layer
#If %separableTD
delta = Arch(outH) * sum 'Arch(outH) = Arch(outH(j)) = Arch(Transfer(netH(j))) = TransferDeriv(netH(j))
#Else
delta = TransferDeriv(netH(j)) * sum
#EndIf
' adjust weights for the hidden layer
For i = 1 To %inputs
If pattern(i) Then 'either 0 or 1
weightHI(j, i) = weightHI(j, i) + delta '* pattern(i)
End If
Next
Next
Return
End Function
'========================================================================================
$inifile = "NN.ini"
Function PBMain
Local x0, y0 As Long
pd = 8 * Atn(1) '2 * pi, used in Function Bell
lowerlimit = Sigma(-%limit)
upperlimit = Sigma( %limit)
x0 = GetSystemMetrics(%SM_CXSCREEN) :y0 = GetSystemMetrics(%SM_CYSCREEN)
DefineColors
Dialog Font "", 0, 0 'for %YtrainTest sign below pattern at upper left
' get the options from last time
Try
Open $inifile For Input As #1
Input #1, updateScreenFlag, hiddensWObias, patternCount
Close #1
Catch 'use default options
Close #1
updateScreenFlag = 1 '0 or 1 .... update screen while training fast.
hiddensWObias = 8 '............ number of hidden nodes, higher numbers speed up convergnece.
patternCount = 300 '............ number of training patterns.
End Try
Do 'because must clear screen (done by ending the dialog) when change hiddensWObias
Dialog New Pixels, 0, "", (x0 - %dialogWidth) \ 2 - 3, (y0 - %dialogHeight) \ 2 - 3, %dialogWidth, %dialogHeight, %WS_Popup Or %DS_ModalFrame, 0 To hform
Dialog Show Modal hform, Call MainCallback 'all the work is done in this callback function
Loop Until exitFlag
' save the current options for next time
Try
Open $inifile For Output As #1
Write #1, updateScreenFlag, hiddensWObias, patternCount
Close #1
Catch
Close #1
Kill $inifile
End Try
End Function