Artificial neural network and back propagation

[The Jazz Man]

.

[bplus]

Looks good, if have trouble try -1 * x as I had to with my own plot program:

compare: https://en.wikipedia.org/wiki/Sigmoid_function

to

  [ You are not allowed to view this attachment ]  


Welcome to forum @The Jazz Man

[The Jazz Man]

.

[bplus]

I put your code up in IDE, immediately it red lines GOTO 453 on line 203.

Are all those arrays you are using 10 items or less? or maybe you will need to DIM a few arrays?

Also I don't see any values for variables for top limits of your For Loops.

[bplus]

OH hey are you translating a Morristown NJ program?

Programs written before there was an ELSE for IF... THEN...

They had to use GOTO every time you turn a corner! LOL

AND ALWAYS ALL CAPITALS :)

[The Jazz Man]

.

[The Jazz Man]

.

[bplus]

Well good luck here is my little foray into Neural Nets, pattern recognition:

Code: QB64: [Select]

1. Option _Explicit
2. _Title "NN 1" 'by B+ started 2018-09-08 my first attempt with training a Neural Net
3.  
4. '2018-09-09 retest this updating the Bias Weight with the others, though I suspect it will stir up a storm?
5.  
6. Const WW = 800
7. Const WH = 620
8. Screen _NewImage(WW, WH, 32)
9. _ScreenMove 300, 60
10.  
11. 'need a place to store inputs x, y, B for bias
12. 'well just use loops
13. 'dim and init weights
14. Const LR = .2 'Learning Rate don't overcorrect errors
15. Dim Shared BiasWeight As Single, Bias As Integer, ArrayStart As Integer, ArrayEnd As Integer, SQ As Integer, Mode As Integer
16. Dim i As Integer, rx As Integer, ry As Integer, colr As Long, cnt As Integer, x As Integer, y As Integer, correct As Single
17. Mode = 1
18. ArrayStart = 1 'Start range of x, y
19. ArrayEnd = 60 'End range of x, y
20. SQ = 10 'for graphic squares drawing to watch Perceptron Learn Y > X
21.  
22. 'setup weights
23. Dim Shared WX(ArrayStart To ArrayEnd) As Single, WY(ArrayStart To ArrayEnd) As Single
24. Bias = 1
25. BiasWeight = Rnd * 2 - 1
26. For i = ArrayStart To ArrayEnd
27.     WX(i) = Rnd * 2 - 1
28.     WY(i) = Rnd * 2 - 1
29. Next
30.  
31. '61 x 61 squares of side 10 pixels fit in 610 x 610 pixel area
32. 'train 1000 random points per frame 10 frames per second and show progress of learning hopefully
33. While _KeyDown(27) = 0
34.     Cls
35.     If Mode = 1 Then _Title "Training Pattern #1: Y >= X" Else _Title "Training Pattern #2: Framed!"
36.     cnt = 0
37.     For i = 1 To 1000 'train 10% of points at a time
38.         rx = Int(Rnd * ArrayEnd) + 1: ry = Int(Rnd * ArrayEnd) + 1 '60 x 60 field so can show circles of radius 10
39.         Train rx, ry
40.     Next
41.     For y = ArrayStart To ArrayEnd
42.         For x = ArrayStart To ArrayEnd
43.             If Mode = 1 Then
44.                 If TrainThis%(x, y) = -1 Then Line (x * SQ, y * SQ)-Step(SQ, SQ), _RGB32(0, 0, 255), B
45.                 If TrainThis%(x, y) = 1 Then Line (x * SQ, y * SQ)-Step(SQ, SQ), _RGB32(255, 255, 255), B
46.                 If TrainThis%(x, y) - Perceptron%(x, y) Then 'wrong! Perceptron
47.                     colr = _RGB32(255, 0, 0)
48.                 Else 'good job Perceptron!
49.                     colr = _RGB32(0, 200, 0): cnt = cnt + 1
50.                 End If
51.             Else
52.                 If TrainThat%(x, y) = -1 Then Line (x * SQ, y * SQ)-Step(SQ, SQ), _RGB32(0, 0, 255), B
53.                 If TrainThat%(x, y) = 1 Then Line (x * SQ, y * SQ)-Step(SQ, SQ), _RGB32(255, 255, 255), B
54.                 If TrainThat%(x, y) - Perceptron%(x, y) Then 'wrong! Perceptron
55.                     colr = _RGB32(255, 0, 0)
56.                 Else 'good job Perceptron!
57.                     colr = _RGB32(0, 200, 0): cnt = cnt + 1
58.                 End If
59.             End If
60.             Line (x * SQ + 2, y * SQ + 2)-Step(SQ - 3, SQ - 3), colr, BF
61.         Next
62.     Next
63.     correct = Int(cnt * 10000 / (61 * 61)) / 100
64.     _PrintString (650, 10), "Correct:" + Str$(correct) + "%"
65.     If Mode = 1 Then
66.         _PrintString (640, 30), "White Frame Y >= X"
67.         _PrintString (640, 50), " Blue Frame Y <  X"
68.     Else
69.         _PrintString (620, 30), "White Frame Train +1"
70.         _PrintString (620, 50), " Blue Frame Train -1"
71.         _PrintString (640, 180), "Wait for it... ;)"
72.     End If
73.     _PrintString (640, 70), "Green Fill Correct"
74.     _PrintString (640, 90), "Red Fill Incorrect"
75.     _PrintString (620, 130), "Training 1000 random"
76.     _PrintString (620, 146), "points in 10th second."
77.     If correct > 95.51 And Mode = 1 Then
78.         Mode = 2
79.         mBox "Hmm... there seems to be a real battle at the border. OK 95.5% has been exceeded, let's see how fast this retrains to a new pattern...", "OK Now Test New Training Set!"
80.     ElseIf Mode = 2 And correct > 96.5 Then
81.         mBox "Over a 96.5% chance you're pregnant!", "OMG!"
82.         System
83.     End If
84.     _Display
85.     _Limit 10
86. Wend
87.  
88. Function Perceptron% (x As Integer, y As Integer)
89.     Dim sum As Single
90.     sum = x * WX(x) + y * WY(y) + Bias * BiasWeight 'sum the inputs times weight
91.     Perceptron% = Sign%(sum) 'apply the activation function to the sum for output
92. End Function
93.  
94. Function Sign% (n As Single) 'very simple activation function
95.     If n < 0 Then Sign% = -1 Else Sign% = 1
96. End Function
97.  
98. 'this sub trains one randomly chosen Perceptron weight set
99. Sub Train (rx As Integer, ry As Integer)
100.     'adjust Perceptrons weights until get good results
101.     '1. provide Perceptron with Inputs for which the correct answer is known
102.     '2. have perceptron guess the answer
103.     '3. Compute the error
104.     '4. Adjust weights according to error
105.     '5. repeat until shaped up
106.  
107.     'so what are we going to train , oh there it is
108.     Dim Guess As Integer, Correct As Integer, Errror As Single, OK$
109.     Guess = Perceptron%(rx, ry)
110.     If Mode = 1 Then
111.         Correct = TrainThis%(rx, ry)
112.     Else
113.         Correct = TrainThat%(rx, ry)
114.     End If
115.     Errror = Correct - Guess 'either 0 when Guess = Correct  -2 or 2 when not
116.     If Errror Then
117.         WX(rx) = WX(rx) + rx * Errror * LR
118.         WY(ry) = WY(ry) + ry * Errror * LR
119.         BiasWeight = BiasWeight + 1 * Errror * LR
120.     End If
121. End Sub
122.  
123. Function TrainThis% (x As Integer, y As Integer)
124.     If y >= x Then TrainThis% = 1 Else TrainThis% = -1 'the x = y function is the line between true and false
125. End Function
126.  
127. Function TrainThat% (x As Integer, y As Integer) 'draw a frame
128.     If x = ArrayStart Or x = ArrayStart + 1 Or x = ArrayEnd - 1 Or x = ArrayEnd Then
129.         TrainThat% = 1
130.     ElseIf y = ArrayStart Or y = ArrayStart + 1 Or y = ArrayEnd - 1 Or y = ArrayEnd Then
131.         TrainThat% = 1
132.     ElseIf x >= 29 And x <= 32 And y >= 12 And y <= 49 Then
133.         TrainThat% = 1
134.     ElseIf y >= 29 And y <= 32 And x >= 12 And x <= 49 Then
135.         TrainThat% = 1
136.     Else
137.         TrainThat% = -1
138.     End If
139. End Function
140.  
141. 'title$ limit is 57 chars, all lines are 58 chars max
142. ' version bak 2018-09-07_10P
143. Sub mBox (m$, title$)
144.  
145.     'first screen dimensions items to restore at exit
146.     Dim sw As Integer, sh As Integer, fg As _Unsigned Long, bg As _Unsigned Long
147.     Dim curScrn As Long, backScrn As Long, mbx As Long 'some handles
148.     Dim ti As Integer, limit As Integer 'ti = text index for t$(), limit is number of chars per line
149.     Dim i As Integer, j As Integer, ff As _Bit, add As _Byte 'index, flag and
150.     Dim bxH As Integer, bxW As Integer 'first as cells then as pixels
151.     Dim mb As Integer, mx As Integer, my As Integer, mi As Integer, grabx As Integer, graby As Integer
152.     Dim tlx As Integer, tly As Integer 'top left corner of message box
153.     Dim lastx As Integer, lasty As Integer, r As Integer
154.     Dim b$, c$, tail$, d$
155.     sw = _Width
156.     sh = _Height
157.     fg = _DefaultColor
158.     bg = _BackgroundColor
159.     'screen snapshot
160.     curScrn = _Dest
161.     backScrn = _NewImage(sw, sh, 32)
162.     _PutImage , curScrn, backScrn
163.  
164.     'setup t$() to store strings with ti as index, linit 58 chars per line max, b$ is for build
165.     ReDim t$(0): ti = 0: limit = 58: b$ = ""
166.     For i = 1 To Len(m$)
167.         c$ = Mid$(m$, i, 1)
168.         'are there any new line signals, CR, LF or both? take CRLF or LFCR as one break but dbl LF or CR means blank line
169.         Select Case c$
170.             Case Chr$(13) 'load line
171.                 If Mid$(m$, i + 1, 1) = Chr$(10) Then i = i + 1
172.                 t$(ti) = b$: b$ = "": ti = ti + 1: ReDim _Preserve t$(ti)
173.             Case Chr$(10)
174.                 If Mid$(m$, i + 1, 1) = Chr$(13) Then i = i + 1
175.                 t$(ti) = b$: b$ = "": ti = ti + 1: ReDim _Preserve t$(ti)
176.             Case Else
177.                 If c$ = Chr$(9) Then c$ = Space$(4): add = 4 Else add = 1
178.                 If Len(b$) + add > limit Then
179.                     tail$ = "": ff = 0
180.                     For j = Len(b$) To 1 Step -1 'backup until find a space, save the tail end for next line
181.                         d$ = Mid$(b$, j, 1)
182.                         If d$ = " " Then
183.                             t$(ti) = Mid$(b$, 1, j - 1): b$ = tail$ + c$: ti = ti + 1: ReDim _Preserve t$(ti)
184.                             ff = 1 'found space flag
185.                             Exit For
186.                         Else
187.                             tail$ = d$ + tail$ 'the tail grows!
188.                         End If
189.                     Next
190.                     If ff = 0 Then 'no break? OK
191.                         t$(ti) = b$: b$ = c$: ti = ti + 1: ReDim _Preserve t$(ti)
192.                     End If
193.                 Else
194.                     b$ = b$ + c$ 'just keep building the line
195.                 End If
196.         End Select
197.     Next
198.     t$(ti) = b$
199.     bxH = ti + 3: bxW = limit + 2
200.  
201.     'draw message box
202.     mbx = _NewImage(60 * 8, (bxH + 1) * 16, 32)
203.     _Dest mbx
204.     Color _RGB32(60, 40, 25), _RGB32(225, 225, 255)
205.     Locate 1, 1: Print Left$(Space$((bxW - Len(title$) - 3) / 2) + title$ + Space$(bxW), bxW)
206.     Color _RGB32(225, 225, 255), _RGB32(200, 0, 0)
207.     Locate 1, bxW - 2: Print " X "
208.     Color _RGB32(60, 40, 25), _RGB32(255, 160, 90)
209.     Locate 2, 1: Print Space$(bxW);
210.     For r = 0 To ti
211.         Locate 1 + r + 2, 1: Print Left$(" " + t$(r) + Space$(bxW), bxW);
212.     Next
213.     Locate 1 + bxH, 1: Print Space$(limit + 2);
214.  
215.     'now for the action
216.     _Dest curScrn
217.  
218.     'convert to pixels the top left corner of box at moment
219.     bxW = bxW * 8: bxH = bxH * 16
220.     tlx = (sw - bxW) / 2: tly = (sh - bxH) / 2
221.     lastx = tlx: lasty = tly
222.     'now allow user to move it around or just read it
223.     While _KeyDown(27) = 0 And _KeyDown(13) = 0 And _KeyDown(32) = 0
224.         Cls
225.         _PutImage , backScrn
226.         _PutImage (tlx, tly), mbx, curScrn
227.         _Display
228.         While _MouseInput: Wend
229.         mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
230.         If mb Then
231.             If mx >= tlx And mx <= tlx + bxW And my >= tly And my <= tly + 16 Then 'mouse down on title bar
232.                 If mx >= tlx + bxW - 24 Then Exit While
233.                 grabx = mx - tlx: graby = my - tly
234.                 Do While mb 'wait for release
235.                     mi = _MouseInput: mb = _MouseButton(1)
236.                     mx = _MouseX: my = _MouseY
237.                     If mx - grabx >= 0 And mx - grabx <= sw - bxW And my - graby >= 0 And my - graby <= sh - bxH Then
238.                         'attempt to speed up with less updates
239.                         If ((lastx - (mx - grabx)) ^ 2 + (lasty - (my - graby)) ^ 2) ^ .5 > 10 Then
240.                             tlx = mx - grabx: tly = my - graby
241.                             Cls
242.                             _PutImage , backScrn
243.                             _PutImage (tlx, tly), mbx, curScrn
244.                             lastx = tlx: lasty = tly
245.                             _Display
246.                         End If
247.                     End If
248.                     _Limit 400
249.                 Loop
250.             End If
251.         End If
252.         _Limit 400
253.     Wend
254.     'put things back
255.     Color _RGB32(255, 255, 255), _RGB32(0, 0, 0): Cls
256.     _PutImage , backScrn
257.     _Display
258.     Color fg, bg
259.     _FreeImage backScrn
260.     _FreeImage mbx
261.     _AutoDisplay
262.     _KeyClear
263. End Sub
264.  
265.  

[The Jazz Man]

.

[bplus]

@bplus
cheers for the example Bplus.
it appears that you are a much more advance programmer than me, it will take me a while to wrap my brain around this.
thank you for trying to help.
cheers

Yes there is a fine mBox (message box) subroutine in there, but the results of my experiment with neural nets was dismal (the code originally attempted digit recognition) but hated to see all that code go to waste so I tried for a funny. :)

[Dimster]

Hello Jazz Man

May I ask a few questions on the overall flow of your program? No problem if you'd prefer not to go into anything that you may wish not to get into.

- I gather the user of your game would not only pick which horse will win but also is there $$$$ bet which determines an ultimate value of money won?
- It would appear the program is a horse race of 3 horses(?), the winner is ??? the one which won the race or the one with the most value or prize money won by the person who bet??
- If the horse winning and value of the win are the same thing, then is the "Back Propagation" and Leaning Rate directed at improving the results of the two losing horses and higher winnings?
- Does each horse start the race with an equal weighting, then in hidden layer 2 a random weight is placed on each of them???
- Hidden Layer 3, The Error Layer, is determining if the horse picked to win did in fact win, or is it monitoring a pattern in the random values?

I apologize in advance for these naive questions. I am interested in AI and have absolutely zero back ground in either programming or calculus. I've been to a horse race track only once in my life and I did bet and , beginners luck, I did bet on the right horse to win. But there was one guy in our group who made more money on the horse that came in third than I did for the win.

I have tried to follow your code for the calculation and application of Back Propagation and Leaning Rate. Both of these, I believe are triggered by the Error but not sure of that or what actually constitutes an error. 

I'll be following this tread - who knows you may find a real life application.

[The Jazz Man]

.

[bplus]

and I hope that somebody will help me out with my plain math calculus request.

@The Jazz Man
What?

[The Jazz Man]

.

[bplus]

Well all I can say for sure is the formula is correct as per my first reply and I my attempts with neural nets had not been satisfactory either.

You keep referring to math or calculus, it's really a matter of getting the algorithm for the training the neural net correct, more a computer science problem than a math one though Logic is foundation of both.