Re: Neural networks from scratch in forth

Interesting ... I last looked at neural nets some 40 years ago (iForth
full distribution dfwforth/examples/neural). At that time Jack Woehr
was also busy it with it. There should be Forth files floating around.
Here's my Little Red Riding Hood application, I think it can fit your
framework.
-marcel
(*
 * 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. ******************************************
6 =: Sensors -- Inputs
2 =: HiddenUnits -- set up 1-dimensional I/Hidden/O vectors
-- NOTE that this is ONE unit less than WJ&JH
                        -- used!
-- (We have a Hidden HiddenUnit though (dummy)).
7 =: OutputUnits -- 7 outputs
     INCLUDE backprop.frt
REVISION -lrrh "--- Neural Applications: LRRH   1.11 ---"
-- **** End of layer defs. ******************************************
(* Application Level *)
:ABOUT
CR
CR ."        ** Little Red Riding Hood Learns the Facts of Life II **"
CR ."             A Neural Net Application using Backpropagation     "
CR
CR ." <l> <s> ADD-PAIR          -- Pattern <l> primed for linking <s>."
CR ."                                 <l> î {Grandma Wolf Woodcutter}"
CR ."                                 <s> î {Love Hate Sex}."
CR ." DRILL                     -- All primed pairs are coded-in."
CR ." NO-CONNECTIONS            -- Forget all associations."
CR ." <l> REACT                 -- Test if <l> <s> pair is reproduced."
CR ." .STATUS                   -- Prints inputs | outputs | targets."
CR ." .WEIGHTS                  -- Prints all weights."
CR ." <z> TO LearningRate       -- LearningRate, oscillates > 1000)."
CR ." <w> TO Retries            -- Retry Rate (normally 3000)."
CR ." Noisy | Clean             -- Select if input is noisy or not."
CR ." <y> TO Noise              -- 1 out of <y> relations in <l> is CR"
"                              -- corrupted, if Noisy."
CR ." FALSE | TRUE TO ?display  -- See matrices during learning or not."
CR ." DO-IT!                    -- Sets up default and learn patterns."
CR ." .ABOUT -lrrh              -- Print this info." CR
CR ." Note1: When running,      '+'  and  '-' influence LearningRate,"
CR ."                           '/'  switch .STATUS and .WEIGHTS,"
CR ."                           'd'  turns display on and off,"
CR ."                           'ESC' breaks."
CR ." Note2: <list> PERSON WHATIF? "
CR ."        where <list> is ORed members of the following set: "
CR ."          {BigEars BigEyes BigTeeth Kindly Wrinkled Handsome}"
CR ."        Example: BigEars BigTeeth OR PERSON WHATIF? " ;
-- Bitpatterns: (only 16 characteristics
-- are possible ==> n <= 16)
0 2^x =: BigEars 1 2^x =: BigEyes 2 2^x =: BigTeeth
3 2^x =: Kindly 4 2^x =: Wrinkled 5 2^x =: Handsome
-- Likewise, number of actions (p) limited to 16.
0 2^x =: RunAway 1 2^x =: Scream 2 2^x =: Look?
3 2^x =: Kiss 4 2^x =: Approach 5 2^x =: OfferFood
6 2^x =: Flirt
CREATE Grandma 0 1 0 1 1 0   sensor,   -- BigEyes Kindly  Wrinkled
CREATE Wolf 1 1 1 0 0 0   sensor,   -- BigEars BigEyes BigTeeth
CREATE Woodcutter 1 0 0 1 0 1   sensor,   -- BigEars Kindly  Handsome
-- Output patterns
CREATE Love 0 0 0 1 1 1 0 output, -- Kiss     Approach  OfferFood
CREATE Hate 1 1 1 0 0 0 0 output, -- RunAway  Scream    Look?
CREATE Sex 0 0 0 0 1 1 1 output, -- Approach OfferFood Flirt
-- PERSON only works if n <= 32
Sensors 2+ ARRAY aperson
Sensors 1+ TO 0 aperson
       One TO 1 aperson
: PERSON DEPTH 0= ABORT" Describe!" \ <bp1>..<bpn> --- <'input>
DEPTH 1- 0 ?DO OR LOOP \ BigEars PERSON  WHATIF?
#32 Sensors - LSHIFT
Sensors 0 DO DUP 0< IF One ELSE Zero ENDIF
     Sensors 1- I - 2+ TO aperson
             1 LSHIFT
        LOOP DROP
'OF aperson ;
: .FACT "0.5" \ <n> <bool> --- <>
> IF CR 1- 2^x
CASE
  BigEars  OF ." -- Big ears"              ENDOF
  BigEyes  OF ." -- Big eyes"              ENDOF
  BigTeeth OF ." -- Big teeth"             ENDOF
  Kindly   OF ." -- A kindly appearance"   ENDOF
  Wrinkled OF ." -- A wrinkled complexion" ENDOF
  Handsome OF ." -- A handsome feller"     ENDOF
        ." -- something illegal?"
ENDCASE
ELSE DROP
ENDIF ;
: .ACTION \ <n> <bool> --- <>
"0.5"
> IF CR 2^x
CASE
  RunAway   OF ." -- run away"      ENDOF
  Scream    OF ." -- scream"      ENDOF
  Look?     OF ." -- woodcutter?"    ENDOF
  Kiss     OF ." -- kiss on cheek"  ENDOF
  Approach  OF ." -- approach"      ENDOF
  OfferFood OF ." -- offer food"     ENDOF
  Flirt     OF ." -- flirt"      ENDOF
         ." -- it is something illegal?"
ENDCASE
ELSE DROP
ENDIF ;
: doLrrh-sensation
CR ." The little girl digests the following facts :" CR
/inputs
    1 DO
I I InputValues .FACT
    LOOP
CR CR ." That is why she decides to: " CR
/outputs
    0 DO
I I ActualOutputs .ACTION
    LOOP CR ;
: Lrrh-sensation ['] doLrrh-sensation [IS] SHOW-NET ;
: doLrrh TIMER-RESET
NO-CONNECTIONS
Grandma Love ADD-PAIR
Wolf Hate ADD-PAIR
Woodcutter Sex ADD-PAIR
DRILL
.ELAPSED ;
: Lrrh ['] doLrrh [IS] DO-IT! ;
Lrrh-sensation Lrrh  #900 TO LearningRate
.ABOUT -lrrh
(* End of Application *)