(* * LANGUAGE : ANS Forth * PROJECT : Forth Environments * DESCRIPTION : Neural net with backpropagation, main module. * CATEGORY : Example * AUTHOR : Marcel Hendrix, November 26 1989 * LAST CHANGE : April 3rd, 1993, Marcel Hendrix, removed CURON / CUROFF * LAST CHANGE : March 2nd, 1992, Marcel Hendrix, dynamic array mods * LAST CHANGE : October 13, 1991, Marcel Hendrix *) CASESENSITIVE @ 0= [IF] CR .( Sorry, CASESENSITIVE ON necessary.) ABORT [THEN] (* ************************************************** *) (* *) (* NúEúUúRúAúL - NúEúT *) (* *) (* BACK-PROPAGATION *) (* CODE *) (* *) (* FC: Dave Parker, DDJ October '89 *) (* LC: Marcel Hendrix, November 18 1989 *) (* LC: November 22nd, fixed scaling bug *) (* LC: November 25th, IT WORKS! Removed SFP *) (* LC: June 20th, 1991 for tForth, MHX *) (* *) (* ************************************************** *) -- Expects constants: Sensors, HiddenUnits and OutputUnits NEEDS -terminal NEEDS -arrays REVISION -backprop "ÄÄÄ Backpropagation Version 2.15 ÄÄÄ" PRIVATES DOC ÄÄÄ (* This program uses BACKPROPAGATION. Parker's BackPropagationDemo is lucid, but it is obscure _how many_ hidden units are needed. I _assume_ one only links inputs to hidden units, then hidden units to outputs. The EXOR-example illustrates this (numbers in square boxes denote thresholds) : Xor (M,W) Xor (M,W) ÚÄÄÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄ¿ ÚÄÄÄÄ>³ 0.5 ³<ÄÄÄÄ¿ ÚÄÄÄÄ>³ 0.5 ³<ÄÄÄÄ¿ ³ ÀÄÄÄÄÄÄÄÄÙ ³ ³ ÀÄÄÄÄÄÄÄÄÙ ³ ³ /³\ ³ ³ /³\ ³ ³1 ³-2 1 ³ ³1 ³-2 1 ³ ³ And ³(M,W) ³ ³ And ³(M,W) ³ ³ ÚÄÄÄÁÄÄÄÄ¿ ³ ÚÄÁÄÄÄ¿ ÚÄÄÄÁÄÄÄÄ¿ ÚÄÄÁÄÄ¿ ³ÚÄÄÄ>³ 1.5 ³<ÄÄÄ¿³ ³ 0.5 ³ ³ 1.5 ³ ³ 0.5 ³ ³³ ÀÄÄÄÄÄÄÄÄÙ ³³ ÀÄÂÄÄÄÙ ÀÄÂÄÄÄÄÄÂÙ ÀÄÄÂÄÄÙ ³³1 1³³ 1³ÚÄÄÄÄÄÄÙ1 1ÀÄÄÄÄÄ¿³1 ÚÄÁÁÄÄ¿ ÚÄÄÁÁÄÄ¿ ÚÄÁÁÄ¿ ÚÄÁÁÄÄ¿ ³ ³ ³ ³ ³ ³ ³ ³ ÀÄÄÄÄÄÙ ÀÄÄÄÄÄÄÙ ÀÄÄÄÄÙ ÀÄÄÄÄÄÙ Monday Wednesday Monday Wednesday The solution to the left needs links directly from input to output. The left implementation does not (at the cost of lower performance?). I tend to regard this as two networks switched in series, each network needing LOCAL feedback when learning (output->hidden, hidden->input). NOTE: We ALWAYS need a dummy '1' input. Without it, we can not build negated outputs (NAND NOR NEXOR NOT etcetera.) Some researchers think this is obvious and neglect to mention it. It proved possible to build LRRH and ExorGate without inverters, but NandGate etcetera can not leave them out. Structure of a Neural Net with only two layers: Hiddenlayer Outputlayer ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ The logical structure of a two-layer neural net can be described as follows: - InputValues, the row vector of inputs (length n), serves as an input to the neurons in the hidden layer. A "complication" is that one element of InputValues, say InputValues[0], MUST be '1' at all times, to enable inverted outputs. Forward pass ÄÄÄÄÄÄÄÄÄÄÄÄ - An hidden neuron k has n weights, one for every component of InputValues, and an 'error' field. When its time has come, the hidden neuron multiplies InputValues with its WeightVector (by taking the dot product) and applies this number to the activation function SIGMOID. The result is left on the stack to be stored into the kth field of HiddenOutputs. (It is useful to save the result in an output field as we will need it to compute SIGMOID' on the backward pass). The neuron also clears its error field. - If the HiddenOutputs vector (length k) is complete, it can be used as input to the output layer. - An output neuron p has k weights, one for every component of HiddenOutputs, and an 'error' field. When its time has come, an output neuron multiplies HiddenOutputs with its WeightVector (dot product, remember) and applies this number to the activation function SIGMOID. The result is stored into the pth field of OutputValues, and the Error Field is cleared. Again we save the result for use on the backward pass. Except for different numbers and naming of indices, this is exactly the same procedure as for the Hiddenlayer. Teacher comes along ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ The difference between the wanted output and the output from the net after the forward pass is taken and stored in the error fields of the outputlayer. Backward pass ÄÄÄÄÄÄÄÄÄÄÄÄÄ - Outputlayer: 1] Every neuron multiplies its Error with SIGMOID'. Each neuron in the hidden layer that is connected to the output layer neuron in question via weight Wab, has its ErrorField incremented by error*SIGMOID'*Wab. This is the actual back propagation of error. 2] For all x: The weight 'x' of the output layer neuron p is incremented by Error(p)*SIGMOID'(p)*LearningRate*HiddenOutputs[x] - Hiddenlayer: ( Step 1] above is useless here ) 2] For all y: The weight 'y' of the hidden layer neuron h is incremented by Error(h)*SIGMOID'(h)*LearningRate*InputValues[y] We now repeat the forward and backward pass for all input vectors that have to be learned, until the error of the output layer is insignificant. LearningRate can be increased to make the learning faster, but this may cause oscillation. NOTE: You may very well wonder about SIGMOID': shouldn't that be inverse(SIGMOID) instead of the derivative? In fact, using SIGMOID' and prescribing an 'S'-like function for SIGMOID is the only way of getting some kind of permanent memory into the system. You could liken it to a form of hysteresis; once the output saturates, SIGMOID' approaches zero and VERY large errors are needed to back-change the weights corresponding to this output. The general effect is that once outputs stabilize to 'ON' or 'OFF', their weights more ore less lock into position, and the less certain outputs get a chance to optimize their firing. Graphical ÄÄÄÄÄÄÄÄÄ InputValues HiddenLayer HiddenOutputs Outputlayer OutputValues ÄÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄ Weights Weights ÚÄÄÄÄÄ¿ .. ÚÄÄÄÄÄ¿ .. Ai ÚÄÃÄÄÄÄÄ´ .. Sum -> SIGMOID Ä¿ ÚÄÄÃÄÄÄÄÄ´ .. Sum -> SIGMOIDÄ¿ ÚÄÄÄ¿ÄÙ ÀÄÄÄÄÄÙ .. . ³ Hk ³ ÀÄÄÄÄÄÙ .. . ³ Bj ÃÄÄÄ´ (n) . ÀÂÄÄÄÄÂÙ (h) . ÀÄÂÄÄÄÄ¿ ÀÄÄÄÙÄ¿ . . ÃÄÄÄÄ´ . . ÃÄÄÄÄ´ (n) ³ . . ÚÁÄÄÄÄÁÄ¿ . . ÚÄÁÄÄÄÄÙ ³ ÚÄÄÄÄÄ¿ .. . ³ (h) ÀÄÚÄÄÄÄÄ¿ .. . ³ (p) ÀÄÃÄÄÄÄÄ´ .. Sum -> SIGMOID ÄÙ ÃÄÄÄÄÄ´ .. Sum -> SIGMOIDÄÙ ÀÄÄÄÄÄÙ .. ÀÄÄÄÄÄÙ .. h * n p * h *) ENDDOC (* ************************************************** *) (* *) (* NúEúUúRúAúL - NúEúT *) (* *) (* BACK-PROPAGATION *) (* DATASTRUCTS *) (* *) (* FC: Dave Parker, DDJ October '89 *) (* LC: Marcel Hendrix, November 18 1989 *) (* LC: November 22nd, fixed scaling bug *) (* LC: November 25th, IT WORKS! Removed SFP *) (* LC: June 20th, 1991 for tForth, MHX *) (* *) (* ************************************************** *) -- General Utility ******************************************* DOC It was VERY DIFFICULT to find the right combination of the scale factor "1" and the proper way to round-off results. If this is done incorrectly, the network will not converge, but perform limit-cycling, especially when weights and/or inputs are low. ENDDOC ( **** Change "1" for different input range ********************** ) ?UNDEF "1" [IF] #2048 =: "1" -- 2048: POLLUTE likes it PRIVATE [THEN] ( **** End input range specification ***************************** ) DOC An output is considered: 'on' when it is >= One 'off' when it is <= Zero Whenever an output is > "0.5", but below One, or < "0.5" but greater than Zero, there is doubt: 0..........Zero.........0.5........One..........1 <-- 'Off' --><-- ?Off --> <-- ?On --><-- 'On' --> ENDDOC "1" 2/ =: "0.5" -- switch-over point "1" #10 / =: Zero -- Minimum .. "1" 9 #10 */ =: One -- .. maximum neuron output 8 =: MaxExp PRIVATE -- Range: 1/(1+exp(8)) to 1/(1+exp(-8)) #10 =: Zoom PRIVATE -- integer divisions between -8, 8 MaxExp Zoom * =: +maxix PRIVATE -- ABS(maximum index) +maxix NEGATE =: -maxix PRIVATE CREATE sigval PRIVATE DECIMAL ( NOTE: maxix 2* 1+ values ! ) 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 2 , 2 , 2 , 2 , 2 , 3 , 3 , 3 , 3 , 4 , 4 , 5 , 5 , 6 , 6 , 7 , 8 , 9 , 9 , 10 , 11 , 13 , 14 , 15 , 17 , 19 , 21 , 23 , 25 , 28 , 31 , 34 , 37 , 41 , 45 , 50 , 55 , 61 , 67 , 74 , 81 , 89 , 98 , 108 , 119 , 130 , 143 , 157 , 172 , 188 , 206 , 225 , 246 , 268 , 292 , 318 , 346 , 375 , 407 , 440 , 476 , 513 , 552 , 593 , 636 , 681 , 727 , 774 , 823 , 872 , 922 , 973 , 1024 , 1075 , 1126 , 1176 , 1225 , 1274 , 1321 , 1367 , 1412 , 1455 , 1496 , 1535 , 1572 , 1608 , 1641 , 1673 , 1702 , 1730 , 1756 , 1780 , 1802 , 1823 , 1842 , 1860 , 1876 , 1891 , 1905 , 1918 , 1929 , 1940 , 1950 , 1959 , 1967 , 1974 , 1981 , 1987 , 1993 , 1998 , 2003 , 2007 , 2011 , 2014 , 2017 , 2020 , 2023 , 2025 , 2027 , 2029 , 2031 , 2033 , 2034 , 2035 , 2037 , 2038 , 2039 , 2039 , 2040 , 2041 , 2042 , 2042 , 2043 , 2043 , 2044 , 2044 , 2045 , 2045 , 2045 , 2045 , 2046 , 2046 , 2046 , 2046 , 2046 , 2047 , 2047 , 2047 , 2047 , 2047 , 2047 , 2047 , 2047 , ( <= catches index = maxix ) "1" #2048 <> [IF] CR .( SIGMOID invalid!) QUIT [THEN] : SIGMOID \ -- <1/(1+exp(-x))> [ "1" Zoom / ] LITERAL / -maxix MAX +maxix MIN +maxix + CELLS sigval + @ ; PRIVATE DOC SIGMOID ÄÄÄ (* If you have floating point, you can use it to build the sigmoid function "1" S>F FCONSTANT "fone" PRIVATE : FSIGMOID "fone" \ --- <1/(1+exp(-x))> DNEGATE D>F "fone" F/ FEXP F1+ F/ FROUND F>S ; \ 0.."1" : !table +maxix -maxix DO I [ "1" Zoom / ] LITERAL M* FSIGMOID I -maxix MAX +maxix MIN +maxix + CELLS sigval + ! LOOP ; !table FORGET FSIGMOID *) ENDDOC -- Scaled division, using round-off (can't do without!) : DSCALE >S S DABS \ --- "1" UM/MOD SWAP "0.5" >= IF 1+ ENDIF S> 0< IF NEGATE ENDIF ; PRIVATE : *SCALE M* DSCALE ; PRIVATE \ --- DOC SIGMOID' (* SIGMOID' is the derivative of the Weber-Fechner activation function SIGMOID, or Opj, where Opj = 1 / ( 1 + exp(-Ei) ); Ei = ä WjiúOpi+éj, => Opj'= Opjú(1-Opj). So if we know SIGMOID, we do NOT need SIGMOID'. *) ENDDOC -- Data: <#weights> .... : SIGMOID' 2@ SWAP \ --- "1" OVER - *SCALE *SCALE ; PRIVATE DOC F-4TH compatibility (* Note1: The number of neurons is ONLY limited by available RAM. Note2: /inputs and /hidden are both one higher than requested; this accounts for the dummy "one" in these layers. *) ENDDOC Sensors 1+ VALUE /inputs -- #input values HiddenUnits 1+ VALUE /hidden -- #hidden values OutputUnits VALUE /outputs -- #output values /inputs ARRAY InputValues -- The arrays hold input (excitation), /hidden ARRAY HiddenOutputs -- hidden neuron output, /outputs ARRAY DesiredOutputs -- desired output, /outputs ARRAY ActualOutputs -- Temporary output (For .OUTPUT) 'OF InputValues =: 'InputValues 'OF HiddenOutputs =: 'HiddenOutputs 'OF DesiredOutputs =: 'DesiredOutputs 'OF ActualOutputs =: 'ActualOutputs One TO 0 HiddenOutputs -- Initialize dummy 0 VALUE |error| PRIVATE -- Measure how close we are to our goal. #40 VALUE LearningRate -- Adjusts how fast the net learns. #3000 VALUE Retries -- Retry if learning fails to converge. : BIT, 0> IF One \ --- <> ELSE Zero ENDIF , ; PRIVATE -- In case you forgot: 0 ROLL does nothing, 1 ROLL is SWAP, 2 ROLL is ROT etc. : sensor, \ .. --- <> /inputs , \ Note: danger if stack overflows! One , \ dummy, enables inverted outputs. 0 Sensors 1- DO I ROLL BIT, -1 +LOOP ; : output, /outputs , 0 /outputs 1- DO I ROLL BIT, -1 +LOOP ; DEFER DO-IT! -- This word will start the application DEFER SHOW-NET -- Display I/O patterns in text format. -- Noise Module ********************************************** DEFER POLLUTE PRIVATE -- Selectively pollute input vectors. #19 VALUE Noise 0 VALUE ?noise PRIVATE : doNoisy Noise CHOOSE \ <0|1> --- 0= IF "1" 1- XOR \ once in a Noise times ENDIF ; PRIVATE \ INCORRECT if "1" <> power-of-2 : Noisy ['] doNoisy IS POLLUTE TRUE TO ?noise ; : Clean 0 IS POLLUTE FALSE TO ?noise ; Clean -- End Noise Module ****************************************** : FILL-inputs CELL+ \ <'inputpattern> --- <> /inputs 0 ?DO @+ POLLUTE TO I InputValues LOOP DROP ; PRIVATE : FILL-outputs CELL+ \ <'outputpattern> --- <> 'DesiredOutputs /outputs CELLS MOVE ; PRIVATE (* Neuron and Layer Defining Words *) -- A neuron should have error/output/weightcount fields and a -- WeightsArea. Sort of like an OOP: -- Data: <#weights> .... 0 VALUE %action PRIVATE -- Dispatches messages : EXCITE 0 TO %action ; IMMEDIATE -- Neuron fires : TRIMWEIGHTS 1 TO %action ; IMMEDIATE -- Neuron adjusts its weights : ZEROWEIGHTS 2 TO %action ; IMMEDIATE -- Neuron randomly fills its weights : DELTA 3 TO %action ; IMMEDIATE -- Neuron computes Wab*Opj'*error : NEWERROR 4 TO %action ; IMMEDIATE -- Set a Neuron's error field : 'WEIGHTS 5 TO %action ; IMMEDIATE -- Address of a Neuron's WeightArea : CELL 6 TO %action ; IMMEDIATE -- Neuron's pfa 0. DVALUE excitement PRIVATE : (XTC) CLEAR excitement \ <'input> --- 0 OVER ! \ clear error field 2 CELLS + @+ SWAP >S \ 'weights and #weights \ == Update(Backward) == 0 ?DO @+ \ Get input value I S []CELL @ \ Get weight M* +TO excitement LOOP DROP \ remove 'input excitement DSCALE \ result is factor "1" too high SIGMOID \ square-off sum DUP S> 2 CELLS - ! ; \ update output field and leave result. PRIVATE : (ADJ) DUP 3 CELLS + >S \ <'input> --- <> SIGMOID' \ output*(1-output)*error.. LearningRate #100 */ >S \ ..times learning rate T CELL- @ \ #weights 0 ?DO @+ S *SCALE \ times input value I T []CELL +! \ increment weight LOOP DROP -S -S ; PRIVATE : (CLEAR) 2 CELLS + @+ \ --- <> 0 ?DO [ "0.5" 4 / 1+ ] LITERAL CHOOSE [ "0.5" 8 / ] LITERAL - OVER I CELLS + ! LOOP DROP ; PRIVATE : (DELTA) SWAP 3 + \ --- OVER []CELL @ \ get weight ("1"^2 too high) SWAP SIGMOID' M* ; \ (output)(1-output)*error*weight PRIVATE -- Data: <#weights> .... : LAYER CREATE 2DUP \ <#neurons> --- <> 3 + CELLS DUP , \ size of neuron structure in bytes * ALLOCATE ?ALLOCATE DUP , \ #neurons, inputwidth, address -ROT >S \ init length fields 0 ?DO S 3 + CELLS I * 2 CELLS + OVER + S SWAP ! LOOP -S One SWAP CELL+ ! \ Set output of (possibly dummy) to "1" IMMEDIATE DOES> 2@ \ <'{size,addr}> --- STATE @ IF SWAP \ --- <> | POSTPONE LITERAL POSTPONE LITERAL ENDIF EVAL" ROT * + " \ --- %action CLEAR %action CASE 0 OF EVAL" (XTC) " ENDOF ( excite ) 1 OF EVAL" (ADJ) " ENDOF ( trimweights ) 2 OF EVAL" (CLEAR) " ENDOF ( zeroweights ) 3 OF EVAL" (DELTA) " ENDOF ( delta ) 4 OF EVAL" ! " ENDOF ( newerror ) 5 OF EVAL" 3 CELLS + " ENDOF ( 'weights ) 6 OF ENDOF ( cell ) DUP ABORT" Invalid Layer Command" ENDCASE ; -- To aid clarity: : with ; IMMEDIATE : of ; IMMEDIATE : in ; IMMEDIATE : is ; IMMEDIATE : -th ; IMMEDIATE : -nd ; IMMEDIATE : -rd ; IMMEDIATE : -st ; IMMEDIATE DOC Examples: (* with 'InputValues EXCITE 5 -th in Hiddenlayer with 'HiddenOutputs TRIMWEIGHTS of 2 -nd in Outputlayer ZEROWEIGHTS of 5 -th in Outputlayer 9 -th DELTA of 3 -rd in Hiddenlayer *) ENDDOC -- **** Define the layers. ****************************************** /hidden ( #neurons ) /inputs ( inputs ) LAYER Hiddenlayer /outputs ( #neurons ) /hidden ( inputs ) LAYER Outputlayer (* End of Structures *) : Update(Forward) \ <'inputvector> --- <> FILL-inputs /hidden 1 ?DO with 'InputValues EXCITE I -th in Hiddenlayer TO I -th of HiddenOutputs LOOP One TO 0 -th of HiddenOutputs /outputs 0 ?DO with 'HiddenOutputs EXCITE I -th in Outputlayer TO I -th of ActualOutputs LOOP ; PRIVATE : Update(Backward) \ <'outputvector> --- <> FILL-outputs /outputs 0 ?DO I -th DesiredOutputs I -th ActualOutputs - is NEWERROR of I -th in Outputlayer LOOP /hidden 1 ?DO 0. /outputs 0 ?DO J -th DELTA of I -th in Outputlayer D+ LOOP DSCALE is NEWERROR of I -th in Hiddenlayer LOOP /outputs 0 ?DO with 'HiddenOutputs TRIMWEIGHTS of I -th in Outputlayer LOOP /hidden 1 ?DO with 'InputValues TRIMWEIGHTS of I -th in Hiddenlayer LOOP ; PRIVATE DOC Limits (* An output is considered 'on' when it is >= One-Criteria 'off' when it is <= Zero+Criteria Whenever an output is > "0.5", but below One-Criteria, or < "0.5" but greater than Zero+Criteria, there is doubt: 0........Zero+C.........0.5.......One-C.........1 <-- 'Off' --><-- ?Off --> <-- ?On --><-- 'On' --> *) ENDDOC ?DEF HighlyAccurate [IF] "1" #30 / ( not encouraged ) [ELSE] "1" #20 / ( works best ) [THEN] =: Criteria PRIVATE : DIFFERENCES \ <> --- <#errors> 0 /outputs 0 ?DO I -th DesiredOutputs I -th ActualOutputs OVER One = IF - Criteria > ELSE SWAP - Criteria > ENDIF 1 AND + LOOP ; PRIVATE 0 VALUE #Items PRIVATE CREATE Items PRIVATE #256 2 CELLS * ALLOT : CLEARLayers /outputs 0 ?DO ZEROWEIGHTS of I -th in Outputlayer LOOP /hidden 1 ?DO ZEROWEIGHTS of I -th in Hiddenlayer LOOP ; PRIVATE : NO-CONNECTIONS CLEAR #Items CLEARLayers ; : ADD-PAIR #Items 1+ \ <'inputs> <'outputs> --- <> DUP #256 >= ABORT" Layer overflow" TO #Items \ Increment #Items.. Items #Items 1- 2 CELLS * + 2! ; \ ..add pair to list : REMEMBER? CLEAR |error| \ <> --- #Items 0 ?DO Items I 2 CELLS * + 2@ SWAP Update(Forward) Update(Backward) DIFFERENCES +TO |error| LOOP |error| 0= ; PRIVATE (* Formatting and Querying *) : .BIT "0.5" >= 1 AND '0' + \ --- <> EMIT ; : .OUTPUTBIT DUP \ --- <%error> Zero Criteria + One Criteria - WITHIN >S S IF >INVERSE< ENDIF \ INVERSE if NOT sure about it. DUP "0.5" >= IF One - ABS #100 One */ SWAP '1' ELSE Zero - ABS #100 Zero */ SWAP '0' ENDIF EMIT S> IF >INVERSE< ENDIF ; : PRINT #1000 "1" */ \ --- <> S>D DUP >S DABS <# # # # '.' HOLD # S> 0< IF '-' ELSE BL ENDIF HOLD #> TYPE SPACE ; PRIVATE #22 VALUE itMAX PRIVATE 0 VALUE itMIN PRIVATE #10 VALUE ipMAX PRIVATE 1 VALUE ipMIN PRIVATE #10 VALUE opMAX PRIVATE 0 VALUE opMIN PRIVATE #10 VALUE hiMAX PRIVATE 1 VALUE hiMIN PRIVATE : ItemRANGE #Items itMAX MIN itMIN ; PRIVATE : InputRANGE /inputs ipMAX MIN ipMIN ; PRIVATE : OutputRANGE /outputs opMAX MIN opMIN ; PRIVATE : HiddenRANGE /hidden hiMAX MIN hiMIN ; PRIVATE : .STATUS CR ItemRANGE ?DO Items I 2 CELLS * + 2@ FILL-outputs Update(Forward) InputRANGE DO I InputValues .BIT LOOP SPACE '³' EMIT SPACE OutputRANGE DO I ActualOutputs PRINT LOOP '³' EMIT SPACE OutputRANGE DO I DesiredOutputs .BIT LOOP CR LOOP ; TRUE VALUE ?display FALSE VALUE ?status PRIVATE 0 VALUE ?dot PRIVATE 3 VALUE RefreshRate PRIVATE : .STATUS? ?dot RefreshRate MOD 0= 1 +TO ?dot ?status AND ?display AND IF .STATUS ENDIF ; PRIVATE : CONTAINS \ 3 -rd CELL of Hiddenlayer CONTAINS \ --- <> Diagnostic tool CR ." error ³ output ³ #weights ³ Weights " CR @+ 5 .R 3 SPACES @+ 6 .R 3 SPACES @+ >S S 6 .R 5 SPACES S> 0 ?DO @+ 6 .R SPACE LOOP DROP ; : .PARAMETERS \ --- ?noise IF >INVERSE< ." Corruptions : 1 in " Noise DEC. 5 SPACES >INVERSE< ENDIF ; PRIVATE : WHATIF? \ <'inputvector> --- <> Update(Forward) \ assume InputValues set. SHOW-NET .PARAMETERS ; : REACT WHATIF? ; \ <'inputvector> --- <> : .HEADER ?display 0= IF EXIT ENDIF HOME ?status 0= IF CR EXIT ENDIF >INVERSE< ." Input ³ Output ³ Target (LearningRate = " LearningRate 4 .R ')' EMIT >INVERSE< CR CR ; PRIVATE : .WEIGHTS CR ." --- Hidden layer : Weights ---" CR HiddenRANGE DO CR I -th 'WEIGHTS of Hiddenlayer InputRANGE DO @+ PRINT LOOP DROP LOOP CR CR ." --- Output layer : Weights ---" CR OutputRANGE DO CR I -th 'WEIGHTS of Outputlayer HiddenRANGE DO @+ PRINT LOOP DROP LOOP ; : .WEIGHTS? ?display ?status 0= AND ?dot RefreshRate MOD 0= AND 1 +TO ?dot IF .WEIGHTS ENDIF ; PRIVATE : STOP-NET ?display IF 0 #20 AT-XY ENDIF TRUE ABORT" user interrupt" ; PRIVATE : TEST-USER BEGIN EKEY? WHILE EKEY CASE ESC OF STOP-NET ENDOF '+' OF 2 +TO LearningRate ENDOF '-' OF LearningRate 2- 0 MAX TO LearningRate ENDOF '/' OF ?status 0= TO ?status CLS CR ENDOF 'D' OF ?display 0= TO ?display CLS ENDOF ENDCASE REPEAT ; PRIVATE : DISPLAY TEST-USER \ <> --- <> .HEADER .STATUS? .WEIGHTS? ; PRIVATE (* Words to BUILD the net *) : LEARNED-ALL? \ <> --- 0 >S \ return TRUE if successful Retries 0 DO DISPLAY \ Rehearse old pairs REMEMBER? IF LEAVE ENDIF S> 1+ >S 0 L/SCR 1- AT-XY S DEC. ." pass.." LOOP ?display IF 0 L/SCR 5 - AT-XY ELSE CR ENDIF S> Retries = IF ." Problems..." CR FALSE ELSE TRUE ENDIF ; PRIVATE -- ?converged could have been local, but then monitoring -- progress is impossible: 0 VALUE ?converged PRIVATE : EXAM-OK? CLEAR ?converged \ <> --- 4 0 DO LEARNED-ALL? IF 1 +TO ?converged ELSE CLEAR ?converged LEAVE ENDIF LOOP ?converged 4 = ; PRIVATE : DRILL ?display IF CLS \ <> --- <> ELSE ." .. working .. " ENDIF BEGIN EXAM-OK? 0= WHILE CLEARLayers REPEAT ; DEPRIVE (* End of Source *)