(* * LANGUAGE : ANS Forth * PROJECT : Forth Environments * DESCRIPTION : neural net with backpropagation * CATEGORY : Example * AUTHOR : Marcel Hendrix, November 26 1989 * LAST CHANGE : October 13, 1991, Marcel Hendrix *) ?DEF Sensors [IF] FORGET Sensors [THEN] -- **** Define the layers. ****************************************** #140 =: Sensors -- Dyadic functions, note extra elements for dummies. #10 =: HiddenUnits -- set up 1-dimensional I/Hidden/O vectors 5 =: OutputUnits -- 5 outputs: bits 0..4 INCLUDE backprop.frt REVISION -ocr "ÄÄÄ Neural App: OCR Version 1.10 ÄÄÄ" -- **** End of layer defs. ****************************************** (* Application Level *) #14 =: SensorRows #10 =: HSensors :ABOUT CR CR ." ** OCR in Multi-layered Neural-Net using back-propagation **" CR ." This net classifies bitmaps to ASCII characters" CR CR ." ADD-PAIR -- The pattern is associated to ." CR ." î {bm:A .. bm:Z} î {ac:A .. ac:Z}" CR ." DRILL -- Learns all pairs added." CR ." NO-CONNECTIONS -- Forget all associations." CR ." REACT -- Test if pair is reproduced." CR ." .STATUS -- Prints inputs | outputs | targets." CR ." .WEIGHTS -- Prints all weights." CR ." TO LearningRate -- LearningRate, oscillates if too large (>1000)." CR ." TO Retries -- Retry Rate (normally 3000)." CR ." Noisy | Clean -- Select if input is noisy or not." CR ." TO Noise -- 1 out of pixels in is corrupted, if Noisy." CR ." FALSE | TRUE TO ?display -- See matrices during learning or not." CR ." DO-IT! -- Sets up defaults and learns the patterns." CR ." .ABOUT -ocr -- Print this info." CR CR ." Note: When running, '+' and '-' influence LearningRate," CR ." '/' switches between .STATUS and .WEIGHTS," CR ." 'd' turns display on and off," CR ." 'ESC' breaks." CR ." (Suggested: DO-IT! bm:A REACT Noisy bm:A REACT)" ; CREATE bm:A 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, CREATE bm:B 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, CREATE bm:C 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, CREATE bm:D 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, CREATE bm:E 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, CREATE bm:F 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, CREATE bm:G 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, CREATE bm:M 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, CREATE bm:S 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, -- Hors concours: displaced patterns, to test performance **** -- Backpropagation does NOT handle this as well as a BAM! CREATE bm:M' 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 -- Translated Right. 0 1 1 0 0 0 0 0 1 1 -- Will the network map this on M? 0 1 1 1 0 0 0 1 1 1 -- YES! 0 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, CREATE bm:M_ 1 1 0 0 0 0 0 1 1 0 -- shifted up 1 row 1 1 0 0 0 0 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, CREATE bm:S' 0 0 0 0 0 0 0 0 0 0 -- translated right 0 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, CREATE bm:S_ 0 1 1 1 1 1 1 0 0 0 -- shifted up 1 row 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, CREATE bm:G' 0 0 0 0 0 0 0 0 0 0 -- Horizontally displaced. Okay. 0 0 0 1 1 1 1 1 0 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, CREATE bm:G_ 0 0 1 1 1 1 1 0 0 0 -- shifted up 1 row 0 1 1 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 sensor, -- End test patterns ***************************************** CREATE ac:A 0 0 0 0 1 output, -- 1 CREATE ac:B 0 0 0 1 0 output, -- 2 CREATE ac:C 0 0 0 1 1 output, -- 3 CREATE ac:D 0 0 1 0 0 output, -- 4 CREATE ac:E 0 0 1 0 1 output, -- 5 CREATE ac:F 0 0 1 1 0 output, -- 6 CREATE ac:G 0 0 1 1 1 output, -- 7 CREATE ac:M 0 1 1 0 1 output, -- #13 CREATE ac:S 1 0 0 1 1 output, -- #19 /inputs VALUE #Temp /inputs ARRAY Temp One TO 0 Temp : bm:SHIFT 'OF Temp CELL+ \ <'input> <+pixels> --- <'ip> Sensors CELLS ERASE CELLS >S @+ 1- CELLS S> MIN >S CELL+ 'OF Temp CELL+ S + Sensors CELLS S> - CMOVE 'OF #Temp ; : .INPUTBIT \ --- <> "0.5" > IF 'Û' ELSE 'ú' ENDIF EMIT ; -- 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' --> : doOCRShow CR ." The net observes the following input bit pattern: " CR SensorRows 0 DO CR HSensors 0 DO J HSensors * I + 1+ InputValues .INPUTBIT LOOP LOOP CR ." That is why it outputs the binary string: %" 0 ( %error ) /outputs 0 DO I ActualOutputs .OUTPUTBIT + LOOP 0 /outputs 0 DO 1 LSHIFT I ActualOutputs "0.5" > IF 1 OR ENDIF LOOP ." , meaning: '" '@' + EMIT ." ', with " /outputs / 1 .R ." % error." CR ; : OCRShow ['] doOCRShow IS SHOW-NET ; : doMultiOCR TIMER-RESET NO-CONNECTIONS bm:A ac:A ADD-PAIR bm:B ac:B ADD-PAIR bm:C ac:C ADD-PAIR bm:D ac:D ADD-PAIR bm:E ac:E ADD-PAIR bm:F ac:F ADD-PAIR bm:G ac:G ADD-PAIR bm:M ac:M ADD-PAIR -- Define OCR functions bm:S ac:S ADD-PAIR DRILL .ELAPSED ; : MultiOCR ['] doMultiOCR IS DO-IT! ; OCRShow MultiOCR #200 TO LearningRate .ABOUT -ocr (* End of Application *)