@MSGID:
<8f99b90f-7f00-4544-8fa6-d258ee6f4ef2n@googlegroups.com> 9a79146b
@REPLY:
<51074ba9-ac74-49aa-8f12-28668d28171fn@googlegroups.com> 95dbd575
@REPLYADDR Marcel Hendrix <mhx@iae.nl>
@REPLYTO 2:5075/128 Marcel Hendrix
@CHRS: CP866 2
@RFC: 1 0
@RFC-References:
<55f30e3c-a6fe-428c-a95f-02bacf08c1een@googlegroups.com> <dbfca034-8ca9-4a9b-b563-3fa9da176386n@googlegroups.com>
<51074ba9-ac74-49aa-8f12-28668d28171fn@googlegroups.com>
@RFC-Message-ID:
<8f99b90f-7f00-4544-8fa6-d258ee6f4ef2n@googlegroups.com>
@TZUTC: -0700
@PID: G2/1.0
@TID: FIDOGATE-5.12-ge4e8b94
On Wednesday, September 27, 2023 at 8:31:20 PM UTC+2, minforth wrote:
> Only as side remark, an intro to genetic programming: 
 > https://www.researchgate.net/publication/326459163 Genetic algorithms in
Forth 
> (click on Download Pdf)

They forgot to quote Sergei Baranoff.

(*
 * LANGUAGE    : ANS Forth 
 * PROJECT     : Forth Environments
 * DESCRIPTION : Playing with genetic algorithms
 * CATEGORY    : Game
 * AUTHOR      : Marcel Hendrix 
  * LAST CHANGE : Sunday, February 24, 2013, 16:01, Marcel Hendrix,
needs (( and ))
 * LAST CHANGE : February 7th, 1993, Marcel Hendrix, ANSification
 * LAST CHANGE : October 28, 1992, Marcel Hendrix 
 *)



NEEDS -miscutil( defer is  random choose  exec: exec;  ?at )
NEEDS -arrays( array )
NEEDS -strings  ( $array new$array )

DECIMAL


( *
  Inspired by an impromptu talk of Sergei Baranoff at EuroForth `92.
  Sergei did not explain HOW his program worked, so I implemented an
  approximation to it -- mutated badly, no doubt.
* )



0 VALUE mill        

: .WINDMILLAT-XY  \\   --- <>
mill 3 AND CASE 
      0 OF ." | |" ENDOF
      1 OF ." \\ /" ENDOF
      2 OF ." - -" ENDOF
      3 OF ." / " ENDOF
ENDCASE
mill 1+ TO mill ;        


DEFER SHOULD

  5 CONSTANT max-words       
 24 CONSTANT max-tokens       

max-words   ARRAY program       
max-tokens $ARRAY names           


: NOP ;       
: FILL-STACK20 0 DO RANDOM LOOP ;       
: CHECK-STACKDEPTH 20 = ;       
: CLEAR-STACKDEPTH 0 ?DO DROP LOOP ;        


: /DUP IF /   ELSE 2DROP -1 THEN ;
: MODDUP IF MOD ELSE 2DROP -1 THEN ;


: EXECUTE-TOKENmax-tokens 1- MIN \\  --- <>
EXEC:
   NOP 
   DUP SWAP DROP ROT OVER 
   + -  1+ 1-  2+ 2-  2/ 
   ABS NEGATE MAX MIN 
   AND INVERT OR XOR
   * / MOD
EXEC; ;        


8 NEW$ARRAY names

S" NOP"    TO   0 names  S" DUP" TO   1 names   S" SWAP"   TO   2 names
S" DROP"   TO   3 names  S" ROT" TO   4 names S" OVER"   TO   5 names
S" +"      TO   6 names  S" -"   TO   7 names S" 1+"     TO   8 names
S" 1-"     TO   9 names  S" 2+"  TO  10 names S" 2-"     TO  11 names
S" 2/"     TO  12 names  S" ABS" TO  13 names S" NEGATE" TO  14 names
S" MAX"    TO  15 names  S" MIN" TO  16 names S" AND"    TO  17 names
S" INVERT" TO  18 names   S" OR"  TO  19 names S" XOR"    TO  20 names
S" *"      TO  21 names   S" /"   TO  22 names S" MOD"    TO  23 names


: .NAME?max-tokens 1- MIN DUP \\  --- 
  0= IF DROP FALSE EXIT 
   THEN \\ skip NOPs
names TYPE  2 SPACES  TRUE ;        


: DO-PROGRAMmax-words 0 DO I program  EXECUTE-TOKEN 
  LOOP ;        


: TEST0 0 0 0 seed \\ <> --- 
LOCALS| oldseed olddepth top second third |

CLEAR-STACK  FILL-STACK  SHOULD

DEPTH TO olddepth  oldseed TO seed
TO top TO second TO third\\ save three numbers

CLEAR-STACK  FILL-STACK  DO-PROGRAM

DEPTH olddepth <> IF CLEAR-STACK FALSE EXIT THEN
top =  SWAP second = AND  SWAP third = AND >R
CLEAR-STACK R> ;        


\\ The new program is tested 40 times

: TESTS 40 0 DO  \\ <> --- 
TEST 0= IF UNLOOP FALSE EXIT
      THEN
    LOOP 
TRUE ;


0 VALUE tries       

: MUTATECR 0 TO tries
max-words 0 DO  0 TO I program  LOOP
BEGIN
   TESTS 0=
WHILE
   max-tokens CHOOSE  TO (( max-words CHOOSE )) program 
   tries 1+ TO tries 
   tries 31 AND 31 = IF 0 ?AT NIP .WINDMILL THEN
   KBHIT?
UNTIL THEN
KEY? IF KEY DROP THEN 
CR tries . ." tries." ;        


: .TEXT3 LOCALS| #out |
CR ." : PROGRAM " 
max-words 0 DO  
#out 3 = IF  CR 4 SPACES 0  TO #out THEN
        I program .NAME? IF #out 1+ TO #out THEN
          LOOP
." ;" ;


: .PROGRAMMUTATE .TEXT ;



\\ Enter a goal function here -----------------------------------
\\ There may not be more than three (3) significant output values 

:NONAME1+ ;  IS SHOULD 



: .HELP 
    CR ." Fills an array with random Forth tokens and executes it in a"
    CR ." controlled environment. If the ``goal`` is not met, a random"
    CR ." substitution is made for one of the tokens (a mutation), and"
    CR ." we try again." 
    CR ." Enter  .PROGRAM  to find a program that meets the spec of ``1+``"
    CR ." :NONAME  2 + ; IS SHOULD   is the way to define other goals." ;

                .HELP

                              ( * End of Source * )
--- G2/1.0
 * Origin: usenet.network (2:5075/128)
SEEN-BY: 5001/100 5005/49 5015/255 5019/40 5020/715
848 1042 4441 12000
SEEN-BY: 5030/49 1081 5058/104 5075/128
@PATH: 5075/128 5020/1042 4441