Re: Neural networks from scratch in forth

On Mon, 2 Dec 2024 21:10:23 +0000, mhx wrote:

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
>

Here is the code using the neural_networks.fs program:
This code is saved as lrrh.fs
--------------the code begins here-----------------
include neural_networks.fs
\ data
\ inputs
0 value BigEars
1 value BigEyes
2 value BigTeeth
3 value Kindly
4 value Wrinkled
5 value Handsome
\ Outputs
0 value RunAway
1 value Scream
2 value Look?
3 value Kiss
4 value Approach
5 value OfferFood
6 value Flirt
\ training data
: X 1e f, ;
: _ 0e f, ;
: Grandma    _ X _ X X _ ;
: Wolf       X X X _ _ _ ;
: Woodcutter X _ _ X _ X ;
: Love _ _ _ X X X _ ;
: Hate X X X _ _ _ _ ;
: Sex  _ _ _ _ X X X ;
3 >n_samples
create data1
Grandma Love
Wolf Hate
Woodcutter Sex
data1 >data
\ neuralnet
7 2 6 1 neuralnet: net1
' net1 is net
net_layers
' dlatan is act_func
' dllinear is act_func_ol
\
1000000 >epochs
1e-1 >eta
0e >beta
1 >display_step
1e-4 >tol
0e >rtol
true >init_net
false >adapt_eta
\ learning
: 0_1_outputs
    n_outputs @ 0 do
      outputs i floats + f@
      fround
      outputs i floats + f!
    loop
;
: .fact
     0.5e f> if
       cr
       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
     then
;
: .action
     0.5e f> if
       cr
       case
         RunAway   of ." -- run away"                endof
         Scream    of ." -- scream"                  endof
         Look?     of ." -- look for the woodcutter" endof
         Kiss      of ." -- kiss on the cheek"       endof
         Approach  of ." -- approach"                endof
         OfferFood of ." -- offer food"              endof
         Flirt     of ." -- flirt"                   endof
                      ." -- it is something illegal?"
       endcase
     else
       drop
     then
;
: doLrrh-sensation
    cr ." The little girl digests the following facts :" cr
    n_inputs @ 0 do
      i inputs i floats + f@ .fact
    loop
    cr cr ." That is why she decides to: " cr
    n_outputs @ 0 do
      i outputs i floats + f@ .action
    loop
    cr
;
defer show-net
' doLrrh-sensation is show-net
defer do-it!
: doLrrh timer-reset
   learn
   cr .elapsed
;
' doLrrh is do-it!
\
: X 1e ;
: _ 0e ;
: person1   _ X _ X X _ ;
: person2    X X X _ _ _ ;
: person3   X _ _ X _ X ;
: Grandma_    _ X _ X X _ ;
: Wolf_       X X X _ _ _ ;
: Woodcutter_ X _ _ X _ X ;
: seen to_inputs forward_pass 0_1_outputs ;
\ do-it!
\ person seen show-net
-------the code ends here--------------
Here is a session for this program (with gfgorth):
include lrrh.fs
do-it!
Learning...
-----------
epochs| Cost
------+ ----
0    4.4188457512276
1    3.53222220254148
2    3.06114255073205
3    2.80622819639435
4    2.66162924195142
5    2.56800089024257
6    2.49016050909303
7    2.40496982172919
8    2.29464055287916
9    2.1441048550535
10    1.94269711717085
11    1.69027187896353
12    1.40430631490554
13    1.1190606012813
14    0.870894985775117
15    0.679777383963026
16    0.543995031957486
17    0.449275168744935
18    0.379986601054602
19    0.324695945315252
20    0.276816623400656
21    0.233339792513982
22    0.193391009200482
23    0.157134197427679
24    0.125050933150959
25    0.0975217531128389
26    0.0746387387740572
27    0.0561824514472255
28    0.0416947230420414
29    0.0305858793909606
30    0.0222337205931627
31    0.0160539496745273
32    0.0115391355450612
33    0.00827254819709797
34    0.00592577107731758
35    0.00424787278571643
36    0.00305156160479014
37    0.00219950142863882
38    0.00159232177966559
39    0.00115883013151037
40    0.000848383616732726
41    0.000625131744197768
42    0.00046377036443924
43    0.0003464626655083
44    0.000260634102035286
45    0.0001974076049767
46    0.000150500468205112
47    0.000115450242616698
48    0.0000890730757258027
 85.481600ms  ok
person1 seen show-net
The little girl digests the following facts :
-- Big eyes
-- A kindly appearance
-- A wrinkled complexion
That is why she decides to:
-- kiss on the cheek
-- approach
-- offer food
 ok
person2 seen show-net
The little girl digests the following facts :
-- Big ears
-- Big eyes
-- Big teeth
That is why she decides to:
-- run away
-- scream
-- look for the woodcutter
 ok
person3 seen show-net
The little girl digests the following facts :
-- Big ears
-- A kindly appearance
-- A handsome feller
That is why she decides to:
-- approach
-- offer food
-- flirt
 ok
grandma_ seen   ok
show-net
The little girl digests the following facts :
-- Big eyes
-- A kindly appearance
-- A wrinkled complexion
That is why she decides to:
-- kiss on the cheek
-- approach
-- offer food
 ok
Wolf_ seen   ok
show-net
The little girl digests the following facts :
-- Big ears
-- Big eyes
-- Big teeth
That is why she decides to:
-- run away
-- scream
-- look for the woodcutter
 ok
Woodcutter_ seen   ok
show-net
The little girl digests the following facts :
-- Big ears
-- A kindly appearance
-- A handsome feller
That is why she decides to:
-- approach
-- offer food
-- flirt
 ok
Notice that the learning took 85.481600ms
Thanks for this example.
Ahmed
--