include myrandom.fs

\ Define character-set length as constant
27 constant charsetlength 
\ Define target string length
28 constant targetstringlength
\ define how many copies will be made on each iteration
100 constant numberofcopies \ bestes ergebnis mit 1000
\ define percentag on which one character will mutate
5 constant chancemutationcharacter



\ evaluate a solution and return a score for it (fitnessfunction) 
: evaluate-solution ( a -- a n )
	dup s" METHINKS IT IS LIKE A WEASEL" 0 >r >r
	begin
		r@
	while
		over c@ over c@ = r> r> rot 
		if 
			1+ 
		endif 
		>r 1- >r char+ swap char+ swap 
	repeat
	drop drop r> r>

	swap drop \ cleanup so that output is a n
	;

\ select the best mutation based on the score
: select-best-mutation ( string score string score string score ... -- string )
	>r >r numberofcopies >r
	begin
		r> -rot dup r> r> dup 2swap -rot < 
		if 
			2drop >r >r 
		else 
			swap >r >r 2drop 
		endif
		1 - dup >r 0 =
	until
	r> r> r> drop swap drop
	;

\ returns random character from the charset range A-Z + space
: get-random-character ( -- c)
	\ charsetlength random
	get-random-number charsetlength mod
	dup 26 = 
	if 
		drop bl
	else
		[CHAR] A +
	endif
	;


\ change each character by change of x percent
 : mutate ( string -- string )
	dup targetstringlength 0 u+do
		get-random-number 100 mod chancemutationcharacter < 
		if
			\ x percent chance to change the character
			dup get-random-character swap c!	
		endif
		char+
	loop	
	drop
 	;

\ creates new mutations based on one and evaluate each
: create-mutations-evaluated ( string -- string score string score string score ... )
	numberofcopies 0 u+do 
		dup targetstringlength allot here dup >r 
		targetstringlength cmove r> mutate evaluate-solution rot 
	loop 	
	evaluate-solution
	;

\ makes a completely new 28 character string randomly
: make-random-string ( -- string)
	here targetstringlength 0 u+do
		get-random-character c,
	loop
	;

: findweasel
	initrandom	
	cr
	\ set step counter
	0 >r
	\ Initialize the population
	make-random-string
	
	\ check if it is already the solution
	evaluate-solution targetstringlength = 
	if
		s" Solution found on making initialization: " type 28 type
	else 
		begin
	 		\ generate new mutations based on current solution which are already evaluated
	 		create-mutations-evaluated

			\ select mutation with highest score
			select-best-mutation

	 		\ Evaluate solutions in the population
	 		evaluate-solution
			
			\ do some output and increase step counter			
			s" Step " type
			r> 1+ dup >r . s" : " type 
			swap dup targetstringlength type s"  Score: " type swap dup . cr
			
			\ check if all 28 characters are right
			targetstringlength = 
		until
		r>
		s" Found solution after " type . s" steps" type cr drop
	endif
	;