How to resolve the algorithm Evolutionary algorithm step by step in the Forth programming language

Published on 12 May 2024 09:40 PM

How to resolve the algorithm Evolutionary algorithm step by step in the Forth programming language

Table of Contents

Problem Statement

Starting with:

Note: to aid comparison, try and ensure the variables and functions mentioned in the task description appear in solutions

A cursory examination of a few of the solutions reveals that the instructions have not been followed rigorously in some solutions. Specifically, Note that some of the the solutions given retain characters in the mutated string that are correct in the target string. However, the instruction above does not state to retain any of the characters while performing the mutation. Although some may believe to do so is implied from the use of "converges" Strictly speaking, the new parent should be selected from the new pool of mutations, and then the new parent used to generate the next set of mutations with parent characters getting retained only by not being mutated. It then becomes possible that the new set of mutations has no member that is fitter than the parent! As illustration of this error, the code for 8th has the following remark. NOTE: this has been changed, the 8th version is completely random now Clearly, this algo will be applying the mutation function only to the parent characters that don't match to the target characters! To ensure that the new parent is never less fit than the prior parent, both the parent and all of the latest mutations are subjected to the fitness test to select the next parent.

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Evolutionary algorithm step by step in the Forth programming language

Source code in the forth programming language

include lib/choose.4th
                                       \ target string
s" METHINKS IT IS LIKE A WEASEL" sconstant target

27 constant /charset                   \ size of characterset
29 constant /target                    \ size of target string
32 constant #copies                    \ number of offspring

/target string charset                 \ characterset
/target string this-generation         \ current generation and offspring
/target #copies [*] string new-generation

:this new-generation does> swap /target chars * + ;
                                       \ generate a mutation
: mutation charset /charset choose chars + c@ ;
                                       \ print the current candidate
: .candidate                           ( n1 n2 -- n1 f)
  ." Generation " over 2 .r ." : " this-generation count type cr /target -1 [+] =
;                                      \ test a candidate on 
                                       \ THE NUMBER of correct genes
: test-candidate                       ( a -- a n) 
  dup target 0 >r >r                   ( a1 a2)
  begin                                ( a1 a2)
    r@                                 ( a1 a2 n)
  while                                ( a1 a2)               
    over c@ over c@ =                  ( a1 a2 n)
    r> r> rot if 1+ then >r 1- >r      ( a1 a2)
    char+ swap char+ swap              ( a1+1 a2+1)
  repeat                               ( a1+1 a2+1)
  drop drop r> drop r>                 ( a n)
;
                                       \ find the best candidate
: get-candidate                        ( -- n)
  #copies 0 >r >r                      ( --)
  begin                                ( --)
    r@                                 ( n)
  while                                ( --)
    r@ 1- new-generation               ( a)
    test-candidate r'@ over <          ( a n f)
    if swap count this-generation place r> 1- swap r> drop >r >r
    else drop drop r> 1- >r then       ( --)
  repeat                               ( --)
  r> drop r>                           ( n)
;
                                       \ generate a new candidate
: make-candidate                       ( a --)
  dup charset count rot place          ( a1)
  this-generation target >r            ( a1 a2 a3)
  begin                                ( a1 a2 a3)
    r@                                 ( a1 a2 a3 n)
  while                                ( a1 a2 a3)
    over c@ over c@ =                  ( a1 a2 a3 f)
    swap >r >r over r>                 ( a1 a2 a1 f)
    if over c@ else mutation then      ( a1 a2 a1 c)
    swap c! r> r> 1- >r                ( a1 a2 a3)
    char+ rot char+ rot char+ rot      ( a1+1 a2+1 a3+1)
  repeat                               ( a1+1 a2+1 a3+1)
  drop drop drop r> drop               ( --)
;
                                       \ make a whole new generation
: make-generation #copies 0 do i new-generation make-candidate loop ;
                                       \ weasel program
: weasel
  s"  ABCDEFGHIJKLMNOPQRSTUVWXYZ " 2dup
  charset place                        \ initialize the characterset
  this-generation place 0              \ initialize the first generation
  begin                                \ start the program
    1+ make-generation                 \ make a new generation
    get-candidate .candidate           \ select the best candidate
  until drop                           \ stop when we've found perfection
;

weasel


  

You may also check:How to resolve the algorithm Twin primes step by step in the EasyLang programming language
You may also check:How to resolve the algorithm Image convolution step by step in the Maple programming language
You may also check:How to resolve the algorithm Word search step by step in the BASIC programming language
You may also check:How to resolve the algorithm Filter step by step in the AppleScript programming language
You may also check:How to resolve the algorithm N'th step by step in the Babel programming language