aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Task/Evolutionary-algorithm/00-META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Evolutionary_algorithm

41
Task/Evolutionary-algorithm/00-TASK.txt Normal file
View file

@ -0,0 +1,41 @@
Starting with:
* The <code>target</code> string: <code>"METHINKS IT IS LIKE A WEASEL"</code>.
* An array of random characters chosen from the set of upper-case letters together with the space, and of the same length as the target string. (Call it the <code>parent</code>).
* A <code>fitness</code> function that computes the ‘closeness’ of its argument to the target string.
* A <code>mutate</code> function that given a string and a mutation rate returns a copy of the string, with some characters probably mutated.
* While the <code>parent</code> is not yet the <code>target</code>:
:* copy the <code>parent</code> C times, each time allowing some random probability that another character might be substituted using <code>mutate</code>.
:* Assess the <code>fitness</code> of the parent and all the copies to the <code>target</code> and make the most fit string the new <code>parent</code>, discarding the others.
:* repeat until the parent converges, (hopefully), to the target.
;See also:
* &nbsp; Wikipedia entry: &nbsp; [[wp:Weasel_program#Weasel_algorithm|Weasel algorithm]].
* &nbsp; Wikipedia entry: &nbsp; [[wp:Evolutionary algorithm|Evolutionary algorithm]].
<br>
<small>Note: to aid comparison, try and ensure the variables and functions mentioned in the task description appear in solutions</small>
<br>
A cursory examination of a few of the solutions reveals that the instructions have not been followed rigorously in some solutions. Specifically,
* While the <code>parent</code> is not yet the <code>target</code>:
:* copy the <code>parent</code> C times, each time allowing some random probability that another character might be substituted using <code>mutate</code>.
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"
(:* repeat until the parent converges, (hopefully), to the target.
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.
Create a new string based on the TOS, '''changing randomly any characters which
don't already match the target''':
''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.
<br><br>

19
Task/Evolutionary-algorithm/11l/evolutionary-algorithm.11l Normal file
View file

@ -0,0 +1,19 @@
V target = Array(‘METHINKS IT IS LIKE A WEASEL’)
V alphabet = ‘ ABCDEFGHIJLKLMNOPQRSTUVWXYZ’
V p = 0.05
V c = 100
F neg_fitness(trial)
R sum(zip(trial, :target).map((t, h) -> Int(t != h)))
F mutate(parent)
R parent.map(ch -> (I random:() < :p {random:choice(:alphabet)} E ch))
V parent = (0 .< target.len).map(_ -> random:choice(:alphabet))
V i = 0
print((‘#3’.format(i))‘ ’parent.join(‘’))
L parent != target
V copies = ((0 .< c).map(_ -> mutate(:parent)))
parent = min(copies, key' x -> neg_fitness(x))
print((‘#3’.format(i))‘ ’parent.join(‘’))
i++

162
Task/Evolutionary-algorithm/8080-Assembly/evolutionary-algorithm.8080 Normal file
View file

@ -0,0 +1,162 @@
MRATE: equ 26 ; Chance of mutation (MRATE/256)
COPIES: equ 100 ; Amount of copies to make
fname1: equ 5Dh ; First filename on command line (used for RNG seed)
fname2: equ 6Dh ; Second filename (also used for RNG seed)
org 100h
;;; Make random seed from the two CP/M 'filenames'
lxi b,rnddat
lxi h,fname1
xra a
call seed ; First four bytes from fn1 make X
call seed ; Second four bytes from fn1 make A
mvi l,fname2
call seed ; First four bytes from fn2 make B
call seed ; Second four bytes from fn2 make C
;;; Create the first parent (random string)
lxi h,parent
mvi e,tgtsz-1
genchr: call rndchr ; Get random character
mov m,a ; Store it
inx h
dcr e
jnz genchr
mvi m,'$' ; CP/M string terminator
;;; Main loop
loop: lxi d,parent
push d
call puts ; Print current parent
pop h ; Calculate fitness
call fitnes
xra a ; If it is 0, all characters match,
ora d
rz ; So we stop.
lxi h,kids ; Otherwise, set HL to start of children,
mvi a,0FFh ; Initialize maximum fitness value
sta maxfit
mvi a,COPIES ; Initialize copy counter
sta copies
;;; Make copies
copy: push h ; Store the place where the copy will go
call mutcpy ; Make a mutated copy of the parent
pop h ; Get the place where the copy went
push h ; But keep it on the stack
call fitnes ; Calculate the fitness of that copy
pop h ; Get place where copy went
lda maxfit ; Get current best fitness
cmp d ; Compare to fitness of current copy
jc next ; If it wasn't better, next copy
shld maxptr ; If it was better, store pointer
mov a,d
sta maxfit ; And new max fitness
next: lxi b,tgtsz ; Get place for next copy
dad b
xchg ; Keep in DE
lxi h,copies
dcr m ; Any copies left to make?
xchg
jnz copy ; Then make another copy
lhld maxptr ; Otherwise, get location of copy with best fitness
lxi b,parent ; Make that the new parent
pcopy: mov a,m ; Get character from copy
inx h
stax b ; Store into location of parent
inx b
cpi '$' ; Check for string terminator
jnz pcopy ; If it isn't, copy next character
jmp loop ; Otherwise, mutate new parent
;;; Make a copy of the parent, mutate it, and store it at [HL].
mutcpy: lxi b,parent
mcloop: ldax b ; Get current character
inx b
mov m,a ; Write it to new location
inx h
cpi '$' ; Was it the string terminator?
rz ; Then stop
call rand ; Otherwise, get random value
cpi MRATE ; Should we mutate this character?
jnc mcloop ; If not, just copy next character
call rndchr ; Otherwise, get a random character
dcx h ; And store it instead of the character we had
mov m,a
inx h
jmp mcloop
;;; Calculate fitness of candidate under [HL], fitness is
;;; returned in D. Fitness is "inverted", i.e. a fitness of 0
;;; means everything matches.
fitnes: lxi b,target
lxi d,tgtsz ; E=counter, D=fitness
floop: dcr e ; Done yet?
rz ; If so, return.
ldax b ; Get target character
inx b
cmp m ; Compare to current character
inx h
jz floop ; If they match, don't do anything
inr d ; If they don't match, count this
jmp floop
;;; Generate a random uppercase letter, or a space
;;; Return in A, other registers preserved
rndchr: call rand ; Get a random value
ani 31 ; from 0 to 31
cpi 28 ; If 28 or higher,
jnc rndchr ; get another value
adi 'A' ; Make uppercase letter
cpi 'Z'+1 ; If the result is 'Z' or lower,
rc ; then return it,
mvi a,' ' ; otherwise return a space
ret
;;; Load 4 bytes from [HL] and use them, plus A, as part of seed
;;; in [BC]
seed: mvi e,4 ; 4 bytes
sloop: xra m
inx h
dcr e
jnz sloop
stax b
inx b
ret
;;; Random number generator using XABC algorithm
rand: push h
lxi h,rnddat
inr m ; X++
mov a,m ; X
inx h
xra m ; ^ C
inx h
xra m ; ^ A
mov m,a ; -> A
inx h
add m ; + B
mov m,a ; -> B
rar ; >>1 (ish)
dcx h
xra m ; ^ A
dcx h
add m ; + C
mov m,a ; -> C
pop h
ret
;;; Print string to console using CP/M, saving all registers
puts: push h
push d
push b
push psw
mvi c,9 ; CP/M print string
call 5
lxi d,nl ; Print a newline as well
mvi c,9
call 5
pop b
pop d
pop h
pop psw
ret
nl: db 13,10,'$'
target: db 'METHINKS IT IS LIKE A WEASEL$'
tgtsz: equ $-target
rnddat: ds 4 ; RNG state
copies: ds 1 ; Copies left to make
maxfit: ds 1 ; Best fitness seen
maxptr: ds 2 ; Pointer to copy with best fitness
parent: equ $ ; Store current parent here
kids: equ $+tgtsz ; Store mutated copies here

123
Task/Evolutionary-algorithm/8086-Assembly/evolutionary-algorithm.8086 Normal file
View file

@ -0,0 +1,123 @@
bits 16
cpu 8086
MRATE: equ 26 ; Mutation rate (MRATE/256)
COPIES: equ 100 ; Amount of copies to make
gettim: equ 02Ch ; MS-DOS get time function
pstr: equ 9 ; MS-DOS print string
section .text
org 100h
;;; Use MS-DOS time to set random seed
mov ah,gettim
int 21h
mov [rnddat],cx
mov [rnddat+2],dx
;;; Make first parent (random characters)
mov di,parent
mov cx,target.size-1
getchr: call rndchr ; Get random character
stosb ; Store in parent
loop getchr
mov al,'$' ; Write string terminator
stosb
;;; Main loop.
loop: mov bx,parent ; Print current parent
mov dx,bx
call puts
call fitnes ; Check fitness
test cl,cl ; If zero, we're done
jnz nxmut ; If not, do another mutation
ret ; Quit to DOS
nxmut: mov dl,0FFh ; DL = best fitness yet
mov di,kids ; Set DI to start of memory for children
mov ch,COPIES ; CH = amount of copies to make
xor bp,bp
;;; Make copy, mutate, and test fitness
copy: mov bx,di ; Let BX = where next copy will go
call mutcpy ; Make the copy (and adjust DI)
call fitnes ; Check fitness
cmp cl,dl ; Is it better than the previous best one?
ja next ; If not, just do the next one,
mov dl,cl ; Otherwise, this is now the best one
lea bp,[di-target.size] ; Store a pointer to it in BP
next: dec ch ; One copy less
jnz copy ; Make another copy if we need to
mov si,bp ; We're done, the best child becomes
mov di,parent ; the parent for the next generation
mov cx,target.size
rep movsb
jmp loop ; Next generation
;;; Make copy of parent, mutating as we go, and store at [DI]
mutcpy: mov si,parent
.loop: lodsb ; Get byte from parent
stosb ; Store in copy
cmp al,'$' ; Is it '$'?
je .out ; Then we're done
call rand ; Otherwise, should we mutate?
cmp al,MRATE
ja .loop ; If not, do next character
call rndchr ; But if so, get random character,
mov [di-1],al ; and overwrite the current character.
jmp .loop ; Then do the next character.
.out: ret
;;; Get fitness of character in [BX]
fitnes: mov si,target
xor cl,cl ; Fitness
.loop: lodsb ; Get target character
cmp al,'$' ; Done?
je .out ; Then stop
cmp al,[bx] ; Equal to character under [BX]?
lahf ; Keep flags
inc bx ; Increment BX
sahf ; Restore flags (was al=[bx]?)
je .loop ; If equal, do next character
inc cx ; Otherwise, count this as a mismatch
jmp .loop
.out: ret
;;; Generate random character, [A-Z] or space.
rndchr: call rand ; Get random number
and al,31 ; Lower five bits
cmp al,27 ; One of 27 characters?
jae rndchr ; If not, get new random number
add al,'A' ; Make uppercase letter
cmp al,'Z' ; More than 'Z'?
jbe .out ; If not, it's OK
mov al,' ' ; Otherwise, give a space
.out: ret
;;; Random number generator using XABC algorithm
;;; Returns random byte in AL
rand: push cx
push dx
mov cx,[rnddat] ; CH=X CL=A
mov dx,[rnddat+2] ; DH=B DL=C
inc ch ; X++
xor cl,ch ; A ^= X
xor cl,dl ; A ^= C
add dh,cl ; B += A
mov al,dh ; C' = B
shr al,1 ; C' >>= 1
xor al,cl ; C' ^= A
add al,dl ; C' += C
mov dl,al ; C = C'
mov [rnddat],cx
mov [rnddat+2],dx
pop dx
pop cx
ret
;;; Print string in DX, plus a newline, saving registers
puts: push ax
push dx
mov ah,pstr
int 21h
mov dx,nl
int 21h
pop dx
pop ax
ret
section .data
nl: db 13,10,'$'
target: db 'METHINKS IT IS LIKE A WEASEL$'
.size: equ $-target
section .bss
rnddat: resb 4 ; RNG state
parent: resb target.size ; Place to store current parent
kids: resb COPIES*target.size ; Place to store children

94
Task/Evolutionary-algorithm/8th/evolutionary-algorithm.8th Normal file
View file

@ -0,0 +1,94 @@
\ RosettaCode challenge http://rosettacode.org/wiki/Evolutionary_algorithm
\ Responding to the criticism that the implementation was too directed, this
\ version does a completely random selection of chars to mutate
var gen
\ Convert a string of valid chars into an array of char-strings:
"ABCDEFGHIJKLMNOPQRSTUVWXYZ " null s:/ var, valid-chars
\ How many mutations each generation will handle; the larger, the slower each
\ generation but the fewer generations required:
300 var, #mutations
23 var, mutability
: get-random-char
valid-chars @
27 rand-pcg n:abs swap n:mod
a:@ nip ;
: mutate-string \ s -- s'
(
rand-pcg mutability @ n:mod not if
drop get-random-char
then
) s:map ;
: mutate \ s n -- a
\ iterate 'n' times over the initial string, mutating it each time
\ save the original string, as the best of the previous generation:
>r [] over a:push swap
(
tuck mutate-string
a:push swap
) r> times drop ;
\ compute Hamming distance of two strings:
: hamming \ s1 s2 -- n
0 >r
s:len n:1-
(
2 pick over s:@ nip
2 pick rot s:@ nip
n:- n:abs r> n:+ >r
) 0 rot loop
2drop r> ;
var best
: fitness-check \ s a -- s t
10000 >r
-1 best !
(
\ ix s ix s'
2 pick hamming
r@
over n:> if
rdrop >r
best !
else
2drop
then
)
a:each
rdrop best @ a:@ nip ;
: add-random-char \ s -- s'
get-random-char s:+ ;
\ take the target and make a random string of the same length
: initial-string \ s -- s
s:len "" swap
' add-random-char
swap times ;
: done? \ s1 s2 -- s1 s2 | bye
2dup s:= if
"Done in " . gen @ . " generations" . cr ;;;
then ;
: setup-random
rand rand rand-pcg-seed ;
: evolve
1 gen n:+!
\ create an array of #mutations strings mutated from the random string, drop the random
#mutations @ mutate
\ iterate over the array and pick the closest fit:
fitness-check
\ show this generation's best match:
dup . cr
\ check for end condition and continue if not done:
done? evolve ;
"METHINKS IT IS LIKE A WEASEL"
setup-random initial-string evolve bye

70
Task/Evolutionary-algorithm/ALGOL-68/evolutionary-algorithm.alg Normal file
View file

@ -0,0 +1,70 @@
STRING target := "METHINKS IT IS LIKE A WEASEL";
PROC fitness = (STRING tstrg)REAL:
(
INT sum := 0;
FOR i FROM LWB tstrg TO UPB tstrg DO
sum +:= ABS(ABS target[i] - ABS tstrg[i])
OD;
# fitness := # 100.0*exp(-sum/10.0)
);
PROC rand char = CHAR:
(
#STATIC# []CHAR ucchars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";
# rand char := # ucchars[ENTIER (random*UPB ucchars)+1]
);
PROC mutate = (REF STRING kid, parent, REAL mutate rate)VOID:
(
FOR i FROM LWB parent TO UPB parent DO
kid[i] := IF random < mutate rate THEN rand char ELSE parent[i] FI
OD
);
PROC kewe = ( STRING parent, INT iters, REAL fits, REAL mrate)VOID:
(
printf(($"#"4d" fitness: "g(-6,2)"% "g(-6,4)" '"g"'"l$, iters, fits, mrate, parent))
);
PROC evolve = VOID:
(
FLEX[UPB target]CHAR parent;
REAL fits;
[100]FLEX[UPB target]CHAR kid;
INT iters := 0;
kid[LWB kid] := LOC[UPB target]CHAR;
REAL mutate rate;
# initialize #
FOR i FROM LWB parent TO UPB parent DO
parent[i] := rand char
OD;
fits := fitness(parent);
WHILE fits < 100.0 DO
INT j;
REAL kf;
mutate rate := 1.0 - exp(- (100.0 - fits)/400.0);
FOR j FROM LWB kid TO UPB kid DO
mutate(kid[j], parent, mutate rate)
OD;
FOR j FROM LWB kid TO UPB kid DO
kf := fitness(kid[j]);
IF fits < kf THEN
fits := kf;
parent := kid[j]
FI
OD;
IF iters MOD 100 = 0 THEN
kewe( parent, iters, fits, mutate rate )
FI;
iters+:=1
OD;
kewe( parent, iters, fits, mutate rate )
);
main:
(
evolve
)

17
Task/Evolutionary-algorithm/APL/evolutionary-algorithm.apl Normal file
View file

@ -0,0 +1,17 @@
evolve←{
⍺←0.1
target←'METHINKS IT IS LIKE A WEASEL'
charset←27↑⎕A
fitness←{target+.=⍵}
mutate←⍺∘{
(⍺>?(⍴target)/0){
⍺:(?⍴charset)⊃charset
⍵
}¨⍵
}
⍵{
target≡⎕←⍵:⍵
next←mutate¨⍺/⊂⍵
⍺∇(⊃⍒fitness¨next)⊃next
}charset[?(⍴target)/⍴charset]
}

62
Task/Evolutionary-algorithm/AWK/evolutionary-algorithm.awk Normal file
View file

@ -0,0 +1,62 @@
#!/bin/awk -f
function randchar(){
return substr(charset,randint(length(charset)+1),1)
}
function mutate(gene,rate ,l,newgene){
newgene = ""
for (l=1; l < 1+length(gene); l++){
if (rand() < rate)
newgene = newgene randchar()
else
newgene = newgene substr(gene,l,1)
}
return newgene
}
function fitness(gene,target ,k,fit){
fit = 0
for (k=1;k<1+length(gene);k++){
if (substr(gene,k,1) == substr(target,k,1)) fit = fit + 1
}
return fit
}
function randint(n){
return int(n * rand())
}
function evolve(){
maxfit = fitness(parent,target)
oldfit = maxfit
maxj = 0
for (j=1; j < D; j++){
child[j] = mutate(parent,mutrate)
fit[j] = fitness(child[j],target)
if (fit[j] > maxfit) {
maxfit = fit[j]
maxj = j
}
}
if (maxfit > oldfit) parent = child[maxj]
}
BEGIN{
target = "METHINKS IT IS LIKE A WEASEL"
charset = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
mutrate = 0.10
if (ARGC > 1) mutrate = ARGV[1]
lenset = length(charset)
C = 100
D = C + 1
parent = ""
for (j=1; j < length(target)+1; j++) {
parent = parent randchar()
}
print "target: " target
print "fitness of target: " fitness(target,target)
print "initial parent: " parent
gens = 0
while (parent != target){
evolve()
gens = gens + 1
if (gens % 10 == 0) print "after " gens " generations,","new parent: " parent," with fitness: " fitness(parent,target)
}
print "after " gens " generations,"," evolved parent: " parent
}

124
Task/Evolutionary-algorithm/Ada/evolutionary-algorithm.ada Normal file
View file

@ -0,0 +1,124 @@
with Ada.Text_IO;
with Ada.Numerics.Discrete_Random;
with Ada.Numerics.Float_Random;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
procedure Evolution is
-- only upper case characters allowed, and space, which uses '@' in
-- internal representation (allowing subtype of Character).
subtype DNA_Char is Character range '@' .. 'Z';
-- DNA string is as long as target string.
subtype DNA_String is String (1 .. 28);
-- target string translated to DNA_Char string
Target : constant DNA_String := "METHINKS@IT@IS@LIKE@A@WEASEL";
-- calculate the 'closeness' to the target DNA.
-- it returns a number >= 0 that describes how many chars are correct.
-- can be improved much to make evolution better, but keep simple for
-- this example.
function Fitness (DNA : DNA_String) return Natural is
Result : Natural := 0;
begin
for Position in DNA'Range loop
if DNA (Position) = Target (Position) then
Result := Result + 1;
end if;
end loop;
return Result;
end Fitness;
-- output the DNA using the mapping
procedure Output_DNA (DNA : DNA_String; Prefix : String := "") is
use Ada.Strings.Maps;
Output_Map : Character_Mapping;
begin
Output_Map := To_Mapping
(From => To_Sequence (To_Set (('@'))),
To => To_Sequence (To_Set ((' '))));
Ada.Text_IO.Put (Prefix);
Ada.Text_IO.Put (Ada.Strings.Fixed.Translate (DNA, Output_Map));
Ada.Text_IO.Put_Line (", fitness: " & Integer'Image (Fitness (DNA)));
end Output_DNA;
-- DNA_Char is a discrete type, use Ada RNG
package Random_Char is new Ada.Numerics.Discrete_Random (DNA_Char);
DNA_Generator : Random_Char.Generator;
-- need generator for floating type, too
Float_Generator : Ada.Numerics.Float_Random.Generator;
-- returns a mutated copy of the parent, applying the given mutation rate
function Mutate (Parent : DNA_String;
Mutation_Rate : Float)
return DNA_String
is
Result : DNA_String := Parent;
begin
for Position in Result'Range loop
if Ada.Numerics.Float_Random.Random (Float_Generator) <= Mutation_Rate
then
Result (Position) := Random_Char.Random (DNA_Generator);
end if;
end loop;
return Result;
end Mutate;
-- genetic algorithm to evolve the string
-- could be made a function returning the final string
procedure Evolve (Child_Count : Positive := 100;
Mutation_Rate : Float := 0.2)
is
type Child_Array is array (1 .. Child_Count) of DNA_String;
-- determine the fittest of the candidates
function Fittest (Candidates : Child_Array) return DNA_String is
The_Fittest : DNA_String := Candidates (1);
begin
for Candidate in Candidates'Range loop
if Fitness (Candidates (Candidate)) > Fitness (The_Fittest)
then
The_Fittest := Candidates (Candidate);
end if;
end loop;
return The_Fittest;
end Fittest;
Parent, Next_Parent : DNA_String;
Children : Child_Array;
Loop_Counter : Positive := 1;
begin
-- initialize Parent
for Position in Parent'Range loop
Parent (Position) := Random_Char.Random (DNA_Generator);
end loop;
Output_DNA (Parent, "First: ");
while Parent /= Target loop
-- mutation loop
for Child in Children'Range loop
Children (Child) := Mutate (Parent, Mutation_Rate);
end loop;
Next_Parent := Fittest (Children);
-- don't allow weaker children as the parent
if Fitness (Next_Parent) > Fitness (Parent) then
Parent := Next_Parent;
end if;
-- output every 20th generation
if Loop_Counter mod 20 = 0 then
Output_DNA (Parent, Integer'Image (Loop_Counter) & ": ");
end if;
Loop_Counter := Loop_Counter + 1;
end loop;
Output_DNA (Parent, "Final (" & Integer'Image (Loop_Counter) & "): ");
end Evolve;
begin
-- initialize the random number generators
Random_Char.Reset (DNA_Generator);
Ada.Numerics.Float_Random.Reset (Float_Generator);
-- evolve!
Evolve;
end Evolution;

68
Task/Evolutionary-algorithm/Aime/evolutionary-algorithm.aime Normal file
View file

@ -0,0 +1,68 @@
integer
fitness(data t, data b)
{
integer c, f, i;
f = 0;
for (i, c in b) {
f += sign(t[i] ^ c);
}
f;
}
void
mutate(data e, data b, data u)
{
integer c;
for (, c in b) {
e.append(drand(15) ? c : u[drand(26)]);
}
}
integer
main(void)
{
data b, t, u;
integer f, i;
t = "METHINK IT IS LIKE A WEASEL";
u = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";
i = ~t;
while (i) {
i -= 1;
b.append(u[drand(26)]);
}
f = fitness(t, b);
while (f) {
data n;
integer a;
o_form("/lw4/~\n", f, b);
n = b;
i = 32;
while (i) {
data c;
i -= 1;
mutate(c, b, u);
a = fitness(t, c);
if (a < f) {
f = a;
n = c;
}
}
b = n;
}
o_form("/lw4/~\n", f, b);
return 0;
}

40
Task/Evolutionary-algorithm/Arturo/evolutionary-algorithm.arturo Normal file
View file

@ -0,0 +1,40 @@
target: "METHINKS IT IS LIKE A WEASEL"
alphabet: [` `] ++ @`A`..`Z`
p: 0.05
c: 100
negFitness: function [trial][
result: 0
loop 0..dec size trial 'i ->
if target\[i] <> trial\[i] -> inc 'result
return result
]
mutate: function [parent][
result: ""
loop parent 'c ->
'result ++ (p > random 0.0 1.0)? -> sample alphabet -> c
return result
]
parent: ""
do.times: size target ->
'parent ++ sample alphabet
j: 0
copies: []
while [parent <> target][
'copies ++ map c 'i -> mutate parent
best: first copies
loop 1..dec size copies 'i [
if (negFitness copies\[i]) < negFitness best ->
best: copies\[i]
]
parent: best
print [pad to :string j 2 parent]
inc 'j
]

56
Task/Evolutionary-algorithm/AutoHotkey/evolutionary-algorithm.ahk Normal file
View file

@ -0,0 +1,56 @@
output := ""
target := "METHINKS IT IS LIKE A WEASEL"
targetLen := StrLen(target)
Loop, 26
possibilities_%A_Index% := Chr(A_Index+64) ; A-Z
possibilities_27 := " "
C := 100
parent := ""
Loop, %targetLen%
{
Random, randomNum, 1, 27
parent .= possibilities_%randomNum%
}
Loop,
{
If (target = parent)
Break
If (Mod(A_Index,10) = 0)
output .= A_Index ": " parent ", fitness: " fitness(parent, target) "`n"
bestFit := 0
Loop, %C%
If ((fitness := fitness(spawn := mutate(parent), target)) > bestFit)
bestSpawn := spawn , bestFit := fitness
parent := bestFit > fitness(parent, target) ? bestSpawn : parent
iter := A_Index
}
output .= parent ", " iter
MsgBox, % output
ExitApp
mutate(parent) {
local output, replaceChar, newChar
output := ""
Loop, %targetLen%
{
Random, replaceChar, 0, 9
If (replaceChar != 0)
output .= SubStr(parent, A_Index, 1)
else
{
Random, newChar, 1, 27
output .= possibilities_%newChar%
}
}
Return output
}
fitness(string, target) {
totalFit := 0
Loop, % StrLen(string)
If (SubStr(string, A_Index, 1) = SubStr(target, A_Index, 1))
totalFit++
Return totalFit
}

39
Task/Evolutionary-algorithm/BBC-BASIC/evolutionary-algorithm.basic Normal file
View file

@ -0,0 +1,39 @@
target$ = "METHINKS IT IS LIKE A WEASEL"
parent$ = "IU RFSGJABGOLYWF XSMFXNIABKT"
mutation_rate = 0.5
children% = 10
DIM child$(children%)
REPEAT
bestfitness = 0
bestindex% = 0
FOR index% = 1 TO children%
child$(index%) = FNmutate(parent$, mutation_rate)
fitness = FNfitness(target$, child$(index%))
IF fitness > bestfitness THEN
bestfitness = fitness
bestindex% = index%
ENDIF
NEXT index%
parent$ = child$(bestindex%)
PRINT parent$
UNTIL parent$ = target$
END
DEF FNfitness(text$, ref$)
LOCAL I%, F%
FOR I% = 1 TO LEN(text$)
IF MID$(text$, I%, 1) = MID$(ref$, I%, 1) THEN F% += 1
NEXT
= F% / LEN(text$)
DEF FNmutate(text$, rate)
LOCAL C%
IF rate > RND(1) THEN
C% = 63+RND(27)
IF C% = 64 C% = 32
MID$(text$, RND(LEN(text$)), 1) = CHR$(C%)
ENDIF
= text$

88
Task/Evolutionary-algorithm/Batch-File/evolutionary-algorithm.bat Normal file
View file

@ -0,0 +1,88 @@
@echo off
setlocal enabledelayedexpansion
set target=M E T H I N K S @ I T @ I S @ L I K E @ A @ W E A S E L
set chars=A B C D E F G H I J K L M N O P Q R S T U V W X Y Z @
set tempcount=0
for %%i in (%target%) do (
set /a tempcount+=1
set target!tempcount!=%%i
)
call:parent
echo %target%
echo --------------------------------------------------------
:loop
call:fitness parent
set currentfit=%errorlevel%
if %currentfit%==28 goto end
echo %parent% - %currentfit% [%attempts%]
set attempts=0
:innerloop
set /a attempts+=1
title Attemps - %attempts%
call:mutate %parent%
call:fitness tempparent
set newfit=%errorlevel%
if %newfit% gtr %currentfit% (
set tempcount=0
set "parent="
for %%i in (%tempparent%) do (
set /a tempcount+=1
set parent!tempcount!=%%i
set parent=!parent! %%i
)
goto loop
)
goto innerloop
:end
echo %parent% - %currentfit% [%attempts%]
echo Done.
exit /b
:parent
set "parent="
for /l %%i in (1,1,28) do (
set /a charchosen=!random! %% 27 + 1
set tempcount=0
for %%j in (%chars%) do (
set /a tempcount+=1
if !charchosen!==!tempcount! (
set parent%%i=%%j
set parent=!parent! %%j
)
)
)
exit /b
:fitness
set fitness=0
set array=%1
for /l %%i in (1,1,28) do if !%array%%%i!==!target%%i! set /a fitness+=1
exit /b %fitness%
:mutate
set tempcount=0
set returnarray=tempparent
set "%returnarray%="
for %%i in (%*) do (
set /a tempcount+=1
set %returnarray%!tempcount!=%%i
set %returnarray%=!%returnarray%! %%i
)
set /a tomutate=%random% %% 28 + 1
set /a mutateto=%random% %% 27 + 1
set tempcount=0
for %%i in (%chars%) do (
set /a tempcount+=1
if %mutateto%==!tempcount! (
set %returnarray%!tomutate!=%%i
)
)
set "%returnarray%="
for /l %%i in (1,1,28) do set %returnarray%=!%returnarray%! !%returnarray%%%i!
exit /b

110
Task/Evolutionary-algorithm/C++/evolutionary-algorithm.cpp Normal file
View file

@ -0,0 +1,110 @@
#include <string>
#include <cstdlib>
#include <iostream>
#include <cassert>
#include <algorithm>
#include <vector>
#include <ctime>
std::string allowed_chars = " ABCDEFGHIJKLMNOPQRSTUVWXYZ";
// class selection contains the fitness function, encapsulates the
// target string and allows access to it's length. The class is only
// there for access control, therefore everything is static. The
// string target isn't defined in the function because that way the
// length couldn't be accessed outside.
class selection
{
public:
// this function returns 0 for the destination string, and a
// negative fitness for a non-matching string. The fitness is
// calculated as the negated sum of the circular distances of the
// string letters with the destination letters.
static int fitness(std::string candidate)
{
assert(target.length() == candidate.length());
int fitness_so_far = 0;
for (int i = 0; i < target.length(); ++i)
{
int target_pos = allowed_chars.find(target[i]);
int candidate_pos = allowed_chars.find(candidate[i]);
int diff = std::abs(target_pos - candidate_pos);
fitness_so_far -= std::min(diff, int(allowed_chars.length()) - diff);
}
return fitness_so_far;
}
// get the target string length
static int target_length() { return target.length(); }
private:
static std::string target;
};
std::string selection::target = "METHINKS IT IS LIKE A WEASEL";
// helper function: cyclically move a character through allowed_chars
void move_char(char& c, int distance)
{
while (distance < 0)
distance += allowed_chars.length();
int char_pos = allowed_chars.find(c);
c = allowed_chars[(char_pos + distance) % allowed_chars.length()];
}
// mutate the string by moving the characters by a small random
// distance with the given probability
std::string mutate(std::string parent, double mutation_rate)
{
for (int i = 0; i < parent.length(); ++i)
if (std::rand()/(RAND_MAX + 1.0) < mutation_rate)
{
int distance = std::rand() % 3 + 1;
if(std::rand()%2 == 0)
move_char(parent[i], distance);
else
move_char(parent[i], -distance);
}
return parent;
}
// helper function: tell if the first argument is less fit than the
// second
bool less_fit(std::string const& s1, std::string const& s2)
{
return selection::fitness(s1) < selection::fitness(s2);
}
int main()
{
int const C = 100;
std::srand(time(0));
std::string parent;
for (int i = 0; i < selection::target_length(); ++i)
{
parent += allowed_chars[std::rand() % allowed_chars.length()];
}
int const initial_fitness = selection::fitness(parent);
for(int fitness = initial_fitness;
fitness < 0;
fitness = selection::fitness(parent))
{
std::cout << parent << ": " << fitness << "\n";
double const mutation_rate = 0.02 + (0.9*fitness)/initial_fitness;
std::vector<std::string> childs;
childs.reserve(C+1);
childs.push_back(parent);
for (int i = 0; i < C; ++i)
childs.push_back(mutate(parent, mutation_rate));
parent = *std::max_element(childs.begin(), childs.end(), less_fit);
}
std::cout << "final string: " << parent << "\n";
}

54
Task/Evolutionary-algorithm/C-sharp/evolutionary-algorithm.cs Normal file
View file

@ -0,0 +1,54 @@
using System;
using System.Collections.Generic;
using System.Linq;
static class Program {
static Random Rng = new Random((int)DateTime.Now.Ticks);
static char NextCharacter(this Random self) {
const string AllowedChars = " ABCDEFGHIJKLMNOPQRSTUVWXYZ";
return AllowedChars[self.Next() % AllowedChars.Length];
}
static string NextString(this Random self, int length) {
return String.Join("", Enumerable.Repeat(' ', length)
.Select(c => Rng.NextCharacter()));
}
static int Fitness(string target, string current) {
return target.Zip(current, (a, b) => a == b ? 1 : 0).Sum();
}
static string Mutate(string current, double rate) {
return String.Join("", from c in current
select Rng.NextDouble() <= rate ? Rng.NextCharacter() : c);
}
static void Main(string[] args) {
const string target = "METHINKS IT IS LIKE A WEASEL";
const int C = 100;
const double P = 0.05;
// Start with a random string the same length as the target.
string parent = Rng.NextString(target.Length);
Console.WriteLine("START: {0,20} fitness: {1}",
parent, Fitness(target, parent));
int i = 0;
while (parent != target) {
// Create C mutated strings + the current parent.
var candidates = Enumerable.Range(0, C + 1)
.Select(n => n > 0 ? Mutate(parent, P) : parent);
// select the fittest
parent = candidates.OrderByDescending(c => Fitness(target, c)).First();
++i;
Console.WriteLine(" #{0,6} {1,20} fitness: {2}",
i, parent, Fitness(target, parent));
}
Console.WriteLine("END: #{0,6} {1,20}", i, parent);
}
}

67
Task/Evolutionary-algorithm/C/evolutionary-algorithm-1.c Normal file
View file

@ -0,0 +1,67 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
const char target[] = "METHINKS IT IS LIKE A WEASEL";
const char tbl[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";
#define CHOICE (sizeof(tbl) - 1)
#define MUTATE 15
#define COPIES 30
/* returns random integer from 0 to n - 1 */
int irand(int n)
{
int r, rand_max = RAND_MAX - (RAND_MAX % n);
while((r = rand()) >= rand_max);
return r / (rand_max / n);
}
/* number of different chars between a and b */
int unfitness(const char *a, const char *b)
{
int i, sum = 0;
for (i = 0; a[i]; i++)
sum += (a[i] != b[i]);
return sum;
}
/* each char of b has 1/MUTATE chance of differing from a */
void mutate(const char *a, char *b)
{
int i;
for (i = 0; a[i]; i++)
b[i] = irand(MUTATE) ? a[i] : tbl[irand(CHOICE)];
b[i] = '\0';
}
int main()
{
int i, best_i, unfit, best, iters = 0;
char specimen[COPIES][sizeof(target) / sizeof(char)];
/* init rand string */
for (i = 0; target[i]; i++)
specimen[0][i] = tbl[irand(CHOICE)];
specimen[0][i] = 0;
do {
for (i = 1; i < COPIES; i++)
mutate(specimen[0], specimen[i]);
/* find best fitting string */
for (best_i = i = 0; i < COPIES; i++) {
unfit = unfitness(target, specimen[i]);
if(unfit < best || !i) {
best = unfit;
best_i = i;
}
}
if (best_i) strcpy(specimen[0], specimen[best_i]);
printf("iter %d, score %d: %s\n", iters++, best, specimen[0]);
} while (best);
return 0;
}

8
Task/Evolutionary-algorithm/C/evolutionary-algorithm-2.c Normal file
View file

@ -0,0 +1,8 @@
iter 0, score 26: WKVVYFJUHOMQJNZYRTEQAGDVXKYC
iter 1, score 25: WKVVTFJUHOMQJN YRTEQAGDVSKXC
iter 2, score 25: WKVVTFJUHOMQJN YRTEQAGDVSKXC
iter 3, score 24: WKVVTFJUHOMQJN YRTEQAGDVAKFC
...
iter 221, score 1: METHINKSHIT IS LIKE A WEASEL
iter 222, score 1: METHINKSHIT IS LIKE A WEASEL
iter 223, score 0: METHINKS IT IS LIKE A WEASEL

51
Task/Evolutionary-algorithm/CLU/evolutionary-algorithm.clu Normal file
View file

@ -0,0 +1,51 @@
fitness = proc (s, t: string) returns (int)
f: int := 0
for i: int in int$from_to(1,string$size(s)) do
if s[i] ~= t[i] then f := f-1 end
end
return(f)
end fitness
mutate = proc (mut: int, s: string) returns (string)
own charset: string := " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
out: array[char] := array[char]$predict(1,string$size(s))
for c: char in string$chars(s) do
if random$next(10000) < mut then
c := charset[1+random$next(string$size(charset))]
end
array[char]$addh(out,c)
end
return(string$ac2s(out))
end mutate
weasel = iter (mut, c: int, tgt: string) yields (string)
own charset: string := " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
start: array[char] := array[char]$[]
for i: int in int$from_to(1,string$size(tgt)) do
array[char]$addh(start,charset[1+random$next(string$size(charset))])
end
cur: string := string$ac2s(start)
while true do
yield(cur)
if cur = tgt then break end
best: string := cur
best_fitness: int := fitness(cur, tgt)
for i: int in int$from_to(2,c) do
next: string := mutate(mut, cur)
next_fitness: int := fitness(next, tgt)
if best_fitness <= next_fitness then
best, best_fitness := next, next_fitness
end
end
cur := best
end
end weasel
start_up = proc ()
d: date := now()
random$seed(d.second + 60*(d.minute + 60*d.hour))
po: stream := stream$primary_output()
for m: string in weasel(100, 1000, "METHINKS IT IS LIKE A WEASEL") do
stream$putl(po, m)
end
end start_up

88
Task/Evolutionary-algorithm/COBOL/evolutionary-algorithm.cobol Normal file
View file

@ -0,0 +1,88 @@
identification division.
program-id. evolutionary-program.
data division.
working-storage section.
01 evolving-strings.
05 target pic a(28)
value 'METHINKS IT IS LIKE A WEASEL'.
05 parent pic a(28).
05 offspring-table.
10 offspring pic a(28)
occurs 50 times.
01 fitness-calculations.
05 fitness pic 99.
05 highest-fitness pic 99.
05 fittest pic 99.
01 parameters.
05 character-set pic a(27)
value 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '.
05 size-of-generation pic 99
value 50.
05 mutation-rate pic 99
value 5.
01 counters-and-working-variables.
05 character-position pic 99.
05 randomization.
10 random-seed pic 9(8).
10 random-number pic 99.
10 random-letter pic 99.
05 generation pic 999.
05 child pic 99.
05 temporary-string pic a(28).
procedure division.
control-paragraph.
accept random-seed from time.
move function random(random-seed) to random-number.
perform random-letter-paragraph,
varying character-position from 1 by 1
until character-position is greater than 28.
move temporary-string to parent.
move zero to generation.
perform output-paragraph.
perform evolution-paragraph,
varying generation from 1 by 1
until parent is equal to target.
stop run.
evolution-paragraph.
perform mutation-paragraph varying child from 1 by 1
until child is greater than size-of-generation.
move zero to highest-fitness.
move 1 to fittest.
perform check-fitness-paragraph varying child from 1 by 1
until child is greater than size-of-generation.
move offspring(fittest) to parent.
perform output-paragraph.
output-paragraph.
display generation ': ' parent.
random-letter-paragraph.
move function random to random-number.
divide random-number by 3.80769 giving random-letter.
add 1 to random-letter.
move character-set(random-letter:1)
to temporary-string(character-position:1).
mutation-paragraph.
move parent to temporary-string.
perform character-mutation-paragraph,
varying character-position from 1 by 1
until character-position is greater than 28.
move temporary-string to offspring(child).
character-mutation-paragraph.
move function random to random-number.
if random-number is less than mutation-rate
then perform random-letter-paragraph.
check-fitness-paragraph.
move offspring(child) to temporary-string.
perform fitness-paragraph.
fitness-paragraph.
move zero to fitness.
perform character-fitness-paragraph,
varying character-position from 1 by 1
until character-position is greater than 28.
if fitness is greater than highest-fitness
then perform fittest-paragraph.
character-fitness-paragraph.
if temporary-string(character-position:1) is equal to
target(character-position:1) then add 1 to fitness.
fittest-paragraph.
move fitness to highest-fitness.
move child to fittest.

49
Task/Evolutionary-algorithm/Ceylon/evolutionary-algorithm.ceylon Normal file
View file

@ -0,0 +1,49 @@
import ceylon.random {
DefaultRandom
}
shared void run() {
value mutationRate = 0.05;
value childrenPerGeneration = 100;
value target = "METHINKS IT IS LIKE A WEASEL";
value alphabet = {' ', *('A'..'Z')};
value random = DefaultRandom();
value randomLetter => random.nextElement(alphabet);
function fitness(String a, String b) =>
count {for([c1, c2] in zipPairs(a, b)) c1 == c2};
function mutate(String string) =>
String {
for(letter in string)
if(random.nextFloat() < mutationRate)
then randomLetter
else letter
};
function makeCopies(String string) =>
{for(i in 1..childrenPerGeneration) mutate(string)};
function chooseFittest(String+ children) =>
children
.map((String element) => element->fitness(element, target))
.max(increasingItem)
.key;
variable value parent = String {for(i in 1..target.size) randomLetter};
variable value generationCount = 0;
function display() => print("``generationCount``: ``parent``");
display();
while(parent != target) {
parent = chooseFittest(parent, *makeCopies(parent));
generationCount++;
display();
}
print("mutated into target in ``generationCount`` generations!");
}

7
Task/Evolutionary-algorithm/Clojure/evolutionary-algorithm-1.clj Normal file
View file

@ -0,0 +1,7 @@
(def c 100) ;number of children in each generation
(def p 0.05) ;mutation probability
(def target "METHINKS IT IS LIKE A WEASEL")
(def tsize (count target))
(def alphabet " ABCDEFGHIJLKLMNOPQRSTUVWXYZ")

5
Task/Evolutionary-algorithm/Clojure/evolutionary-algorithm-2.clj Normal file
View file

@ -0,0 +1,5 @@
(defn fitness [s] (count (filter true? (map = s target))))
(defn perfectly-fit? [s] (= (fitness s) tsize))
(defn randc [] (rand-nth alphabet))
(defn mutate [s] (map #(if (< (rand) p) (randc) %) s))

6
Task/Evolutionary-algorithm/Clojure/evolutionary-algorithm-3.clj Normal file
View file

@ -0,0 +1,6 @@
(loop [generation 1, parent (repeatedly tsize randc)]
(println generation, (apply str parent), (fitness parent))
(if-not (perfectly-fit? parent)
(let [children (repeatedly c #(mutate parent))
fittest (apply max-key fitness parent children)]
(recur (inc generation), fittest))))

67
Task/Evolutionary-algorithm/ColdFusion/evolutionary-algorithm.cfm Normal file
View file

@ -0,0 +1,67 @@
<Cfset theString = 'METHINKS IT IS LIKE A WEASEL'>
<cfparam name="parent" default="">
<Cfset theAlphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ">
<Cfset fitness = 0>
<Cfset children = 3>
<Cfset counter = 0>
<Cfloop from="1" to="#children#" index="child">
<Cfparam name="child#child#" default="">
<Cfparam name="fitness#child#" default=0>
</Cfloop>
<Cfloop condition="fitness lt 1">
<Cfset oldparent = parent>
<Cfset counter = counter + 1>
<cfloop from="1" to="#children#" index="child">
<Cfset thischild = ''>
<Cfloop from="1" to="#len(theString)#" index="i">
<cfset Mutate = Mid(theAlphabet, RandRange(1, 28), 1)>
<cfif fitness eq 0>
<Cfset thischild = thischild & mutate>
<Cfelse>
<Cfif Mid(theString, i, 1) eq Mid(variables["child" & child], i, 1)>
<Cfset thischild = thischild & Mid(variables["child" & child], i, 1)>
<Cfelse>
<cfset MutateChance = 1/fitness>
<Cfset MutateChanceRand = rand()>
<Cfif MutateChanceRand lte MutateChance>
<Cfset thischild = thischild & mutate>
<Cfelse>
<Cfset thischild = thischild & Mid(variables["child" & child], i, 1)>
</Cfif>
</Cfif>
</cfif>
</Cfloop>
<Cfset variables["child" & child] = thischild>
</cfloop>
<cfloop from="1" to="#children#" index="child">
<Cfset thisChildFitness = 0>
<Cfloop from="1" to="#len(theString)#" index="i">
<Cfif Mid(variables["child" & child], i, 1) eq Mid(theString, i, 1)>
<Cfset thisChildFitness = thisChildFitness + 1>
</Cfif>
</Cfloop>
<Cfset variables["fitness" & child] = (thisChildFitness)/len(theString)>
<Cfif variables["fitness" & child] gt fitness>
<Cfset fitness = variables["fitness" & child]>
<Cfset parent = variables["child" & child]>
</Cfif>
</cfloop>
<Cfif parent neq oldparent>
<Cfoutput>###counter# #numberformat(fitness*100, 99)#% fit: #parent#<br></Cfoutput><cfflush>
</Cfif>
</Cfloop>

31
Task/Evolutionary-algorithm/Commodore-BASIC/evolutionary-algorithm.basic Normal file
View file

@ -0,0 +1,31 @@
10 N=100:P=0.05:TI$="000000"
20 Z$="METHINKS IT IS LIKE A WEASEL"
30 L=LEN(Z$)
40 DIMX(N,L)
50 FORI=1TOL
60 IFMID$(Z$,I,1)=" "THENX(0,I)=0:GOTO80
70 X(0,I)=ASC(MID$(Z$,I))-64
80 NEXT
90 FORK=1TON:FORI=1TOL:X(K,I)=INT(RND(0)*27):NEXT:NEXT
100 S=-100:B=0
110 K=B:GOSUB300
120 FORK=1TON:IFK=BTHEN150
130 FORI=1TOL:IFRND(.)<PTHENX(K,I)=INT(RND(0)*27)
140 NEXT
150 NEXT
160 S=-100:B=0
170 FORK=1TON
180 F=0:FORI=1TOL:IFX(K,I)<>X(0,I)THENF=F-1:IFF<STHENI=L
190 NEXT:IFF>STHENS=F:B=K
200 NEXT
210 PRINT"BEST:"B;"SCORE:"S
220 IFS=0THEN270
230 FORK=1TON:IFK=BTHEN250
240 FORI=1TOL:X(K,I)=X(B,I):NEXT
250 NEXT
260 GOTO110
270 PRINT"WE HAVE A WEASEL!":K=B:GOSUB300
280 PRINT"TIME:"TI$:END
300 FORI=1TOL:IFX(K,I)THENPRINTCHR$(64+X(K,I));:GOTO320
310 PRINT" ";
320 NEXT:PRINT"<":RETURN

39
Task/Evolutionary-algorithm/Common-Lisp/evolutionary-algorithm-1.lisp Normal file
View file

@ -0,0 +1,39 @@
(defun fitness (string target)
"Closeness of string to target; lower number is better"
(loop for c1 across string
for c2 across target
count (char/= c1 c2)))
(defun mutate (string chars p)
"Mutate each character of string with probablity p using characters from chars"
(dotimes (n (length string))
(when (< (random 1.0) p)
(setf (aref string n) (aref chars (random (length chars))))))
string)
(defun random-string (chars length)
"Generate a new random string consisting of letters from char and specified length"
(do ((n 0 (1+ n))
(str (make-string length)))
((= n length) str)
(setf (aref str n) (aref chars (random (length chars))))))
(defun evolve-string (target string chars c p)
"Generate new mutant strings, and choose the most fit string"
(let ((mutated-strs (list string)))
(dotimes (n c)
(push (mutate (copy-seq string) chars p) mutated-strs))
(reduce #'(lambda (s0 s1)
(if (< (fitness s0 target)
(fitness s1 target))
s0
s1))
mutated-strs)))
(defun evolve-gens (target c p)
(let ((chars " ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
(do ((parent (random-string chars (length target))
(evolve-string target parent chars c p))
(n 0 (1+ n)))
((string= target parent) (format t "Generation ~A: ~S~%" n parent))
(format t "Generation ~A: ~S~%" n parent))))

23
Task/Evolutionary-algorithm/Common-Lisp/evolutionary-algorithm-2.lisp Normal file
View file

@ -0,0 +1,23 @@
(defun unfit (s1 s2)
(loop for a across s1
for b across s2 count(char/= a b)))
(defun mutate (str alp n) ; n: number of chars to mutate
(let ((out (copy-seq str)))
(dotimes (i n) (setf (char out (random (length str)))
(char alp (random (length alp)))))
out))
(defun evolve (changes alpha target)
(loop for gen from 1
with f2 with s2
with str = (mutate target alpha 100)
with fit = (unfit target str)
while (plusp fit) do
(setf s2 (mutate str alpha changes)
f2 (unfit target s2))
(when (> fit f2)
(setf str s2 fit f2)
(format t "~5d: ~a (~d)~%" gen str fit))))
(evolve 1 " ABCDEFGHIJKLMNOPQRSTUVWXYZ" "METHINKS IT IS LIKE A WEASEL")

27
Task/Evolutionary-algorithm/Common-Lisp/evolutionary-algorithm-3.lisp Normal file
View file

@ -0,0 +1,27 @@
44: DYZTOREXDML ZCEUCSHRVHBEPGJE (26)
57: DYZTOREXDIL ZCEUCSHRVHBEPGJE (25)
83: DYZTOREX IL ZCEUCSHRVHBEPGJE (24)
95: MYZTOREX IL ZCEUCSHRVHBEPGJE (23)
186: MYZTOREX IL ZCEUISHRVHBEPGJE (22)
208: MYZTOREX IL ZCEUISH VHBEPGJE (21)
228: MYZTOREX IL ZCEUISH VHBEPGEE (20)
329: MYZTOREX IL ZCEUIKH VHBEPGEE (19)
330: MYTTOREX IL ZCEUIKH VHBEPGEE (18)
354: MYTHOREX IL ZCEUIKH VHBEPGEE (17)
365: MYTHOREX IL ICEUIKH VHBEPGEE (16)
380: MYTHOREX IL ISEUIKH VHBEPGEE (15)
393: METHOREX IL ISEUIKH VHBEPGEE (14)
407: METHORKX IL ISEUIKH VHBEPGEE (13)
443: METHORKX IL ISEUIKH VHBEPSEE (12)
455: METHORKX IL ISEUIKE VHBEPSEE (11)
477: METHIRKX IL ISEUIKE VHBEPSEE (10)
526: METHIRKS IL ISEUIKE VHBEPSEE (9)
673: METHIRKS IL ISEUIKE VHBEPSEL (8)
800: METHINKS IL ISEUIKE VHBEPSEL (7)
875: METHINKS IL ISEUIKE AHBEPSEL (6)
941: METHINKS IL ISEUIKE AHBEASEL (5)
1175: METHINKS IT ISEUIKE AHBEASEL (4)
1214: METHINKS IT ISELIKE AHBEASEL (3)
1220: METHINKS IT IS LIKE AHBEASEL (2)
1358: METHINKS IT IS LIKE AHWEASEL (1)
2610: METHINKS IT IS LIKE A WEASEL (0)

18
Task/Evolutionary-algorithm/D/evolutionary-algorithm.d Normal file
View file

@ -0,0 +1,18 @@
import std.stdio, std.random, std.algorithm, std.range, std.ascii;
enum target = "METHINKS IT IS LIKE A WEASEL"d;
enum C = 100; // Number of children in each generation.
enum P = 0.05; // Mutation probability.
enum fitness = (dchar[] s) => target.zip(s).count!q{ a[0] != a[1] };
dchar rnd() { return (uppercase ~ " ")[uniform(0, $)]; }
enum mut = (dchar[] s) => s.map!(a => uniform01 < P ? rnd : a).array;
void main() {
auto parent = generate!rnd.take(target.length).array;
for (auto gen = 1; parent != target; gen++) {
// parent = parent.repeat(C).map!mut.array.max!fitness;
parent = parent.repeat(C).map!mut.array
.minPos!((a, b) => a.fitness < b.fitness)[0];
writefln("Gen %2d, dist=%2d: %s", gen, parent.fitness, parent);
}
}

44
Task/Evolutionary-algorithm/E/evolutionary-algorithm.e Normal file
View file

@ -0,0 +1,44 @@
pragma.syntax("0.9")
pragma.enable("accumulator")
def target := "METHINKS IT IS LIKE A WEASEL"
def alphabet := "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
def C := 100
def RATE := 0.05
def randomCharString() {
return E.toString(alphabet[entropy.nextInt(alphabet.size())])
}
def fitness(string) {
return accum 0 for i => ch in string {
_ + (ch == target[i]).pick(1, 0)
}
}
def mutate(string, rate) {
return accum "" for i => ch in string {
_ + (entropy.nextDouble() < rate).pick(randomCharString(), E.toString(ch))
}
}
def weasel() {
var parent := accum "" for _ in 1..(target.size()) { _ + randomCharString() }
var generation := 0
while (parent != target) {
println(`$generation $parent`)
def copies := accum [] for _ in 1..C { _.with(mutate(parent, RATE)) }
var best := parent
for c in copies {
if (fitness(c) > fitness(best)) {
best := c
}
}
parent := best
generation += 1
}
println(`$generation $parent`)
}
weasel()

38
Task/Evolutionary-algorithm/EchoLisp/evolutionary-algorithm.l Normal file
View file

@ -0,0 +1,38 @@
(require 'sequences)
(define ALPHABET (list->vector ["A" .. "Z"] ))
(vector-push ALPHABET " ")
(define (fitness source target) ;; score >=0, best is 0
(for/sum [(s source)(t target)]
(if (= s t) 0 1)))
(define (mutate source rate)
(for/string [(s source)]
(if (< (random) rate) [ALPHABET (random 27)] s)))
(define (select parent target rate copies (copy) (score))
(define best (fitness parent target))
(define selected parent)
(for [(i copies)]
(set! copy (mutate parent rate))
(set! score (fitness copy target))
(when (< score best)
(set! selected copy)
(set! best score)))
selected )
(define MUTATION_RATE 0.05) ;; 5% chances to change
(define COPIES 100)
(define TARGET "METHINKS IT IS LIKE A WEASEL")
(define (task (rate MUTATION_RATE) (copies COPIES) (target TARGET) (score))
(define parent ;; random source
(for/string
[(i (string-length target))] [ALPHABET (random 27)]))
(for [(i (in-naturals))]
(set! score (fitness parent target))
(writeln i parent 'score score)
#:break (zero? score)
(set! parent (select parent target rate copies))
))

76
Task/Evolutionary-algorithm/Elena/evolutionary-algorithm.elena Normal file
View file

@ -0,0 +1,76 @@
import system'routines;
import extensions;
import extensions'text;
const string Target = "METHINKS IT IS LIKE A WEASEL";
const string AllowedCharacters = " ABCDEFGHIJKLMNOPQRSTUVWXYZ";
const int C = 100;
const real P = 0.05r;
rnd = randomGenerator;
randomChar
= AllowedCharacters[rnd.nextInt(AllowedCharacters.Length)];
extension evoHelper
{
randomString()
= 0.repeatTill(self).selectBy:(x => randomChar).summarize(new StringWriter());
fitnessOf(s)
= self.zipBy(s, (a,b => a==b ? 1 : 0)).summarize(new Integer()).toInt();
mutate(p)
= self.selectBy:(ch => rnd.nextReal() <= p ? randomChar : ch).summarize(new StringWriter());
}
class EvoAlgorithm : Enumerator
{
object theTarget;
object theCurrent;
object theVariantCount;
constructor new(s,count)
{
theTarget := s;
theVariantCount := count.toInt();
}
get() = theCurrent;
bool next()
{
if (nil == theCurrent)
{ theCurrent := theTarget.Length.randomString(); ^ true };
if (theTarget == theCurrent)
{ ^ false };
auto variants := Array.allocate(theVariantCount).populate:(x => theCurrent.mutate:P );
theCurrent := variants.sort:(a,b => a.fitnessOf:Target > b.fitnessOf:Target ).at:0;
^ true
}
reset()
{
theCurrent := nil
}
enumerable() => theTarget;
}
public program()
{
var attempt := new Integer();
EvoAlgorithm.new(Target,C).forEach:(current)
{
console
.printPaddingLeft(10,"#",attempt.append(1))
.printLine(" ",current," fitness: ",current.fitnessOf(Target))
};
console.readChar()
}

64
Task/Evolutionary-algorithm/Elixir/evolutionary-algorithm.elixir Normal file
View file

@ -0,0 +1,64 @@
defmodule Log do
def show(offspring,i) do
IO.puts "Generation: #{i}, Offspring: #{offspring}"
end
def found({target,i}) do
IO.puts "#{target} found in #{i} iterations"
end
end
defmodule Evolution do
# char list from A to Z; 32 is the ord value for space.
@chars [32 | Enum.to_list(?A..?Z)]
def select(target) do
(1..String.length(target)) # Creates parent for generation 0.
|> Enum.map(fn _-> Enum.random(@chars) end)
|> mutate(to_charlist(target),0)
|> Log.found
end
# w is used to denote fitness in population genetics.
defp mutate(parent,target,i) when target == parent, do: {parent,i}
defp mutate(parent,target,i) do
w = fitness(parent,target)
prev = reproduce(target,parent,mu_rate(w))
# Check if the most fit member of the new gen has a greater fitness than the parent.
if w < fitness(prev,target) do
Log.show(prev,i)
mutate(prev,target,i+1)
else
mutate(parent,target,i+1)
end
end
# Generate 100 offspring and select the one with the greatest fitness.
defp reproduce(target,parent,rate) do
[parent | (for _ <- 1..100, do: mutation(parent,rate))]
|> Enum.max_by(fn n -> fitness(n,target) end)
end
# Calculate fitness by checking difference between parent and offspring chars.
defp fitness(t,r) do
Enum.zip(t,r)
|> Enum.reduce(0, fn {tn,rn},sum -> abs(tn - rn) + sum end)
|> calc
end
# Generate offspring based on parent.
defp mutation(p,r) do
# Copy the parent chars, then check each val against the random mutation rate
Enum.map(p, fn n -> if :rand.uniform <= r, do: Enum.random(@chars), else: n end)
end
defp calc(sum), do: 100 * :math.exp(sum/-10)
defp mu_rate(n), do: 1 - :math.exp(-(100-n)/400)
end
Evolution.select("METHINKS IT IS LIKE A WEASEL")

60
Task/Evolutionary-algorithm/Erlang/evolutionary-algorithm.erl Normal file
View file

@ -0,0 +1,60 @@
-module(evolution).
-export([run/0]).
-define(MUTATE, 0.05).
-define(POPULATION, 100).
-define(TARGET, "METHINKS IT IS LIKE A WEASEL").
-define(MAX_GENERATIONS, 1000).
run() -> evolve_gens().
evolve_gens() ->
Initial = random_string(length(?TARGET)),
evolve_gens(Initial,0,fitness(Initial)).
evolve_gens(Parent,Generation,0) ->
io:format("Generation[~w]: Achieved the target: ~s~n",[Generation,Parent]);
evolve_gens(Parent,Generation,_Fitness) when Generation == ?MAX_GENERATIONS ->
io:format("Reached Max Generations~nFinal string is ~s~n",[Parent]);
evolve_gens(Parent,Generation,Fitness) ->
io:format("Generation[~w]: ~s, Fitness: ~w~n",
[Generation,Parent,Fitness]),
Child = evolve_string(Parent),
evolve_gens(Child,Generation+1,fitness(Child)).
fitness(String) -> fitness(String, ?TARGET).
fitness([],[]) -> 0;
fitness([H|Rest],[H|Target]) -> fitness(Rest,Target);
fitness([_H|Rest],[_T|Target]) -> 1+fitness(Rest,Target).
mutate(String) -> mutate(String,[]).
mutate([],Acc) -> lists:reverse(Acc);
mutate([H|T],Acc) ->
case random:uniform() < ?MUTATE of
true ->
mutate(T,[random_character()|Acc]);
false ->
mutate(T,[H|Acc])
end.
evolve_string(String) ->
evolve_string(String,?TARGET,?POPULATION,String).
evolve_string(_,_,0,Child) -> Child;
evolve_string(Parent,Target,Population,Best_Child) ->
Child = mutate(Parent),
case fitness(Child) < fitness(Best_Child) of
true ->
evolve_string(Parent,Target,Population-1,Child);
false ->
evolve_string(Parent,Target,Population-1,Best_Child)
end.
random_character() ->
case random:uniform(27)-1 of
26 -> $ ;
R -> $A+R
end.
random_string(Length) -> random_string(Length,[]).
random_string(0,Acc) -> Acc;
random_string(N,Acc) when N > 0 ->
random_string(N-1,[random_character()|Acc]).

51
Task/Evolutionary-algorithm/Euphoria/evolutionary-algorithm.euphoria Normal file
View file

@ -0,0 +1,51 @@
constant table = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
function random_generation(integer len)
sequence s
s = rand(repeat(length(table),len))
for i = 1 to len do
s[i] = table[s[i]]
end for
return s
end function
function mutate(sequence s, integer n)
for i = 1 to length(s) do
if rand(n) = 1 then
s[i] = table[rand(length(table))]
end if
end for
return s
end function
function fitness(sequence probe, sequence target)
atom sum
sum = 0
for i = 1 to length(target) do
sum += power(find(target[i], table) - find(probe[i], table), 2)
end for
return sqrt(sum/length(target))
end function
constant target = "METHINKS IT IS LIKE A WEASEL", C = 30, MUTATE = 15
sequence parent, specimen
integer iter, best
atom fit, best_fit
parent = random_generation(length(target))
iter = 0
while not equal(parent,target) do
best_fit = fitness(parent, target)
printf(1,"Iteration: %3d, \"%s\", deviation %g\n", {iter, parent, best_fit})
specimen = repeat(parent,C+1)
best = C+1
for i = 1 to C do
specimen[i] = mutate(specimen[i], MUTATE)
fit = fitness(specimen[i], target)
if fit < best_fit then
best_fit = fit
best = i
end if
end for
parent = specimen[best]
iter += 1
end while
printf(1,"Finally, \"%s\"\n",{parent})

10
Task/Evolutionary-algorithm/F-Sharp/evolutionary-algorithm.fs Normal file
View file

@ -0,0 +1,10 @@
//A functional implementation of Evolutionary algorithm
//Nigel Galloway February 7th., 2018
let G=System.Random 23
let fitness n=Array.fold2(fun a n g->if n=g then a else a+1) 0 n ("METHINKS IT IS LIKE A WEASEL".ToCharArray())
let alphabet="QWERTYUIOPASDFGHJKLZXCVBNM ".ToCharArray()
let mutate (n:char[]) g=Array.iter(fun g->n.[g]<-alphabet.[G.Next()%27]) (Array.init g (fun _->G.Next()%(Array.length n)));n
let nextParent n g=List.init 500 (fun _->mutate (Array.copy n) g)|>List.minBy fitness
let evolution n=let rec evolution n g=match fitness n with |0->(0,n)::g |l->evolution (nextParent n ((l/2)+1)) ((l,n)::g)
evolution n []
let n = evolution (Array.init 28 (fun _->alphabet.[G.Next()%27]))

37
Task/Evolutionary-algorithm/Factor/evolutionary-algorithm.factor Normal file
View file

@ -0,0 +1,37 @@
USING: arrays formatting io kernel literals math prettyprint
random sequences strings ;
FROM: math.extras => ... ;
IN: rosetta-code.evolutionary-algorithm
CONSTANT: target "METHINKS IT IS LIKE A WEASEL"
CONSTANT: mutation-rate 0.1
CONSTANT: num-children 25
CONSTANT: valid-chars
$[ CHAR: A ... CHAR: Z >array { 32 } append ]
: rand-char ( -- n )
valid-chars random ;
: new-parent ( -- str )
target length [ rand-char ] replicate >string ;
: fitness ( str -- n )
target [ = ] { } 2map-as sift length ;
: mutate ( str rate -- str/str' )
[ random-unit > [ drop rand-char ] when ] curry map ;
: next-parent ( str -- str/str' )
dup [ mutation-rate mutate ] curry num-children 1 - swap
replicate [ 1array ] dip append [ fitness ] supremum-by ;
: print-parent ( str -- )
[ fitness pprint bl ] [ print ] bi ;
: main ( -- )
0 new-parent
[ dup target = ]
[ next-parent dup print-parent [ 1 + ] dip ] until drop
"Finished in %d generations." printf ;
MAIN: main

56
Task/Evolutionary-algorithm/Fantom/evolutionary-algorithm.fantom Normal file
View file

@ -0,0 +1,56 @@
class Main
{
static const Str target := "METHINKS IT IS LIKE A WEASEL"
static const Int C := 100 // size of population
static const Float p := 0.1f // chance any char is mutated
// compute distance of str from target
static Int fitness (Str str)
{
Int sum := 0
str.each |Int c, Int index|
{
if (c != target[index]) sum += 1
}
return sum
}
// mutate given parent string
static Str mutate (Str str)
{
Str result := ""
str.size.times |Int index|
{
result += ((Float.random < p) ? randomChar() : str[index]).toChar
}
return result
}
// return a random char
static Int randomChar ()
{
"ABCDEFGHIJKLMNOPQRSTUVWXYZ "[Int.random(0..26)]
}
// make population by mutating parent and sorting by fitness
static Str[] makePopulation (Str parent)
{
Str[] result := [,]
C.times { result.add (mutate(parent)) }
result.sort |Str a, Str b -> Int| { fitness(a) <=> fitness(b) }
return result
}
public static Void main ()
{
Str parent := ""
target.size.times { parent += randomChar().toChar }
while (parent != target)
{
echo (parent)
parent = makePopulation(parent).first
}
echo (parent)
}
}

73
Task/Evolutionary-algorithm/Forth/evolutionary-algorithm.fth Normal file
View file

@ -0,0 +1,73 @@
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

135
Task/Evolutionary-algorithm/Fortran/evolutionary-algorithm-1.f Normal file
View file

@ -0,0 +1,135 @@
!***************************************************************************************************
module evolve_routines
!***************************************************************************************************
implicit none
!the target string:
character(len=*),parameter :: targ = 'METHINKS IT IS LIKE A WEASEL'
contains
!***************************************************************************************************
!********************************************************************
pure elemental function fitness(member) result(n)
!********************************************************************
! The fitness function. The lower the value, the better the match.
! It is zero if they are identical.
!********************************************************************
implicit none
integer :: n
character(len=*),intent(in) :: member
integer :: i
n=0
do i=1,len(targ)
n = n + abs( ichar(targ(i:i)) - ichar(member(i:i)) )
end do
!********************************************************************
end function fitness
!********************************************************************
!********************************************************************
pure elemental subroutine mutate(member,factor)
!********************************************************************
! mutate a member of the population.
!********************************************************************
implicit none
character(len=*),intent(inout) :: member !population member
real,intent(in) :: factor !mutation factor
integer,parameter :: n_chars = 27 !number of characters in set
character(len=n_chars),parameter :: chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '
real :: rnd_val
integer :: i,j,n
n = len(member)
do i=1,n
rnd_val = rand()
if (rnd_val<=factor) then !mutate this element
rnd_val = rand()
j = int(rnd_val*n_chars)+1 !an integer between 1 and n_chars
member(i:i) = chars(j:j)
end if
end do
!********************************************************************
end subroutine mutate
!********************************************************************
!***************************************************************************************************
end module evolve_routines
!***************************************************************************************************
!***************************************************************************************************
program evolve
!***************************************************************************************************
! The main program
!***************************************************************************************************
use evolve_routines
implicit none
!Tuning parameters:
integer,parameter :: seed = 12345 !random number generator seed
integer,parameter :: max_iter = 10000 !maximum number of iterations
integer,parameter :: population_size = 200 !size of the population
real,parameter :: factor = 0.04 ![0,1] mutation factor
integer,parameter :: iprint = 5 !print every iprint iterations
!local variables:
integer :: i,iter
integer,dimension(1) :: i_best
character(len=len(targ)),dimension(population_size) :: population
!initialize random number generator:
call srand(seed)
!create initial population:
! [the first element of the population will hold the best member]
population(1) = 'PACQXJB CQPWEYKSVDCIOUPKUOJY' !initial guess
iter=0
write(*,'(A10,A30,A10)') 'iter','best','fitness'
write(*,'(I10,A30,I10)') iter,population(1),fitness(population(1))
do
iter = iter + 1 !iteration counter
!write the iteration:
if (mod(iter,iprint)==0) write(*,'(I10,A30,I10)') iter,population(1),fitness(population(1))
!check exit conditions:
if ( iter>max_iter .or. fitness(population(1))==0 ) exit
!copy best member and mutate:
population = population(1)
do i=2,population_size
call mutate(population(i),factor)
end do
!select the new best population member:
! [the best has the lowest value]
i_best = minloc(fitness(population))
population(1) = population(i_best(1))
end do
!write the last iteration:
if (mod(iter,iprint)/=0) write(*,'(I10,A30,I10)') iter,population(1),fitness(population(1))
if (iter>max_iter) then
write(*,*) 'No solution found.'
else
write(*,*) 'Solution found.'
end if
!***************************************************************************************************
end program evolve
!***************************************************************************************************

17
Task/Evolutionary-algorithm/Fortran/evolutionary-algorithm-2.f Normal file
View file

@ -0,0 +1,17 @@
iter best fitness
0 PACQXJB CQPWEYKSVDCIOUPKUOJY 459
5 PACDXJBRCQP EYKSVDK OAPKGOJY 278
10 PAPDJJBOCQP EYCDKDK A PHGQJF 177
15 PAUDJJBO FP FY VKBL A PEGQJF 100
20 PEUDJMOO KP FY IKLD A YECQJF 57
25 PEUHJMOT KU FS IKLD A YECQJL 35
30 PEUHJMIT KU GS LKJD A YEAQFL 23
35 MERHJMIT KT IS LHJD A YEASFL 15
40 MERHJMKS IT IS LIJD A WEASFL 7
45 MERHINKS IT IS LIJD A WEASFL 5
50 MERHINKS IT IS LIJD A WEASEL 4
55 MERHINKS IT IS LIKD A WEASEL 3
60 MESHINKS IT IS LIKD A WEASEL 2
65 MESHINKS IT IS LIKD A WEASEL 2
70 MESHINKS IT IS LIKE A WEASEL 1
75 METHINKS IT IS LIKE A WEASEL 0

84
Task/Evolutionary-algorithm/FreeBASIC/evolutionary-algorithm.basic Normal file
View file

@ -0,0 +1,84 @@
' version 01-07-2018
' compile with: fbc -s console
Randomize Timer
Const As UInteger children = 100
Const As Double mutate_rate = 0.05
Function fitness(target As String, tmp As String) As UInteger
Dim As UInteger x, f
For x = 0 To Len(tmp) -1
If tmp[x] = target[x] Then f += 1
Next
Return f
End Function
Sub mutate(tmp As String, chars As String, mute_rate As Double)
If Rnd <= mute_rate Then
tmp[Int(Rnd * Len(tmp))] = chars[Int(Rnd * Len(chars))]
End If
End Sub
' ------=< MAIN >=------
Dim As String target = "METHINKS IT IS LIKE A WEASEL"
Dim As String chars = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim As String parent, mutation()
Dim As UInteger x, iter, f, fit(), best_fit, parent_fit
For x = 1 To Len(target)
parent += Chr(chars[Int(Rnd * Len(chars))])
Next
f = fitness(target, parent)
parent_fit = f
best_fit = f
Print "iteration best fit Parent"
Print "========= ======== ============================"
Print Using " #### #### ";iter; best_fit;
Print parent
Do
iter += 1
ReDim mutation(1 To children),fit(1 To children)
For x = 1 To children
mutation(x) = parent
mutate(mutation(x), chars, mutate_rate)
Next
For x = 1 To children
If mutation(x) <> parent Then
f = fitness(target, mutation(x))
If best_fit < f Then
best_fit = f
fit(x) = f
Else
fit(x) = parent_fit
End If
End If
Next
If best_fit > parent_fit Then
For x = 1 To children
If fit(x) = best_fit Then
parent = mutation(x)
Print Using " #### #### ";iter; best_fit;
Print parent
End If
Next
End If
Loop Until parent = target
' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End

65
Task/Evolutionary-algorithm/Go/evolutionary-algorithm.go Normal file
View file

@ -0,0 +1,65 @@
package main
import (
"fmt"
"math/rand"
"time"
)
var target = []byte("METHINKS IT IS LIKE A WEASEL")
var set = []byte("ABCDEFGHIJKLMNOPQRSTUVWXYZ ")
var parent []byte
func init() {
rand.Seed(time.Now().UnixNano())
parent = make([]byte, len(target))
for i := range parent {
parent[i] = set[rand.Intn(len(set))]
}
}
// fitness: 0 is perfect fit. greater numbers indicate worse fit.
func fitness(a []byte) (h int) {
// (hamming distance)
for i, tc := range target {
if a[i] != tc {
h++
}
}
return
}
// set m to mutation of p, with each character of p mutated with probability r
func mutate(p, m []byte, r float64) {
for i, ch := range p {
if rand.Float64() < r {
m[i] = set[rand.Intn(len(set))]
} else {
m[i] = ch
}
}
}
func main() {
const c = 20 // number of times to copy and mutate parent
copies := make([][]byte, c)
for i := range copies {
copies[i] = make([]byte, len(parent))
}
fmt.Println(string(parent))
for best := fitness(parent); best > 0; {
for _, cp := range copies {
mutate(parent, cp, .05)
}
for _, cp := range copies {
fm := fitness(cp)
if fm < best {
best = fm
copy(parent, cp)
fmt.Println(string(parent))
}
}
}
}

48
Task/Evolutionary-algorithm/Haskell/evolutionary-algorithm-1.hs Normal file
View file

@ -0,0 +1,48 @@
import System.Random
import Control.Monad
import Data.List
import Data.Ord
import Data.Array
showNum :: (Num a, Show a) => Int -> a -> String
showNum w = until ((>w-1).length) (' ':) . show
replace :: Int -> a -> [a] -> [a]
replace n c ls = take (n-1) ls ++ [c] ++ drop n ls
target = "METHINKS IT IS LIKE A WEASEL"
pfit = length target
mutateRate = 20
popsize = 100
charSet = listArray (0,26) $ ' ': ['A'..'Z'] :: Array Int Char
fitness = length . filter id . zipWith (==) target
printRes i g = putStrLn $
"gen:" ++ showNum 4 i ++ " "
++ "fitn:" ++ showNum 4 (round $ 100 * fromIntegral s / fromIntegral pfit ) ++ "% "
++ show g
where s = fitness g
mutate :: [Char] -> Int -> IO [Char]
mutate g mr = do
let r = length g
chances <- replicateM r $ randomRIO (1,mr)
let pos = elemIndices 1 chances
chrs <- replicateM (length pos) $ randomRIO (bounds charSet)
let nchrs = map (charSet!) chrs
return $ foldl (\ng (p,c) -> replace (p+1) c ng) g (zip pos nchrs)
evolve :: [Char] -> Int -> Int -> IO ()
evolve parent gen mr = do
when ((gen-1) `mod` 20 == 0) $ printRes (gen-1) parent
children <- replicateM popsize (mutate parent mr)
let child = maximumBy (comparing fitness) (parent:children)
if fitness child == pfit then printRes gen child
else evolve child (succ gen) mr
main = do
let r = length target
genes <- replicateM r $ randomRIO (bounds charSet)
let parent = map (charSet!) genes
evolve parent 1 mutateRate

35
Task/Evolutionary-algorithm/Haskell/evolutionary-algorithm-2.hs Normal file
View file

@ -0,0 +1,35 @@
import System.Random
import Data.List
import Data.Ord
import Data.Array
import Control.Monad
import Control.Arrow
target = "METHINKS IT IS LIKE A WEASEL"
mutateRate = 0.1
popSize = 100
printEvery = 10
alphabet = listArray (0,26) (' ':['A'..'Z'])
randomChar = (randomRIO (0,26) :: IO Int) >>= return . (alphabet !)
origin = mapM createChar target
where createChar c = randomChar
fitness = length . filter id . zipWith (==) target
mutate = mapM mutateChar
where mutateChar c = do
r <- randomRIO (0.0,1.0) :: IO Double
if r < mutateRate then randomChar else return c
converge n parent = do
if n`mod`printEvery == 0 then putStrLn fmtd else return ()
if target == parent
then putStrLn $ "\nFinal: " ++ fmtd
else mapM mutate (replicate (popSize-1) parent) >>=
converge (n+1) . fst . maximumBy (comparing snd) . map (id &&& fitness) . (parent:)
where fmtd = parent ++ ": " ++ show (fitness parent) ++ " (" ++ show n ++ ")"
main = origin >>= converge 0

51
Task/Evolutionary-algorithm/Icon/evolutionary-algorithm.icon Normal file
View file

@ -0,0 +1,51 @@
global target, chars, parent, C, M, current_fitness
procedure fitness(s)
fit := 0
#Increment the fitness for every position in the string s that matches the target
every i := 1 to *target & s[i] == target[i] do fit +:= 1
return fit
end
procedure mutate(s)
#If a random number between 0 and 1 is inside the bounds of mutation randomly alter a character in the string
if (?0 <= M) then ?s := ?chars
return s
end
procedure generation()
population := [ ]
next_parent := ""
next_fitness := -1
#Create the next population
every 1 to C do push(population, mutate(parent))
#Find the member of the population with highest fitness, or use the last one inspected
every x := !population & (xf := fitness(x)) > next_fitness do {
next_parent := x
next_fitness := xf
}
parent := next_parent
return next_fitness
end
procedure main()
target := "METHINKS IT IS LIKE A WEASEL" #Our target string
chars := &ucase ++ " " #Set of usable characters
parent := "" & every 1 to *target do parent ||:= ?chars #The universal common ancestor!
current_fitness := fitness(parent) #The best fitness we have so far
C := 50 #Population size in each generation
M := 0.5 #Mutation rate per individual in a generation
gen := 1
#Until current fitness reaches a score of perfect match with the target string keep generating new populations
until ((current_fitness := generation()) = *target) do {
write(gen || " " || current_fitness || " " || parent)
gen +:= 1
}
write("At generation " || gen || " we found a string with perfect fitness at " || current_fitness || " reading: " || parent)
end

14
Task/Evolutionary-algorithm/J/evolutionary-algorithm-1.j Normal file
View file

@ -0,0 +1,14 @@
CHARSET=: 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '
NPROG=: 100 NB. number of progeny (C)
MRATE=: 0.05 NB. mutation rate
create =: (?@$&$ { ])&CHARSET NB. creates random list from charset of same shape as y
fitness =: +/@:~:"1
copy =: # ,:
mutate =: &(>: $ ?@$ 0:)(`(,: create))} NB. adverb
select =: ] {~ (i. <./)@:fitness NB. select fittest member of population
nextgen =: select ] , [: MRATE mutate NPROG copy ]
while =: conjunction def '(] , (u {:))^:(v {:)^:_ ,:'
evolve=: nextgen while (0 < fitness) create

6
Task/Evolutionary-algorithm/J/evolutionary-algorithm-2.j Normal file
View file

@ -0,0 +1,6 @@
filter=: {: ,~ ({~ i.@>.&.(%&20)@#) NB. take every 20th and last item
filter evolve 'METHINKS IT IS LIKE A WEASEL'
XXURVQXKQXDLCGFVICCUA NUQPND
MEFHINVQQXT IW LIKEUA WEAPEL
METHINVS IT IW LIKEUA WEAPEL
METHINKS IT IS LIKE A WEASEL

27
Task/Evolutionary-algorithm/J/evolutionary-algorithm-3.j Normal file
View file

@ -0,0 +1,27 @@
CHARSET=: 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '
NPROG=: 100 NB. "C" from specification
fitness=: +/@:~:"1
select=: ] {~ (i. <./)@:fitness NB. select fittest member of population
populate=: (?@$&# { ])&CHARSET NB. get random list from charset of same length as y
log=: [: smoutput [: ;:inv (('#';'fitness: ';'; ') ,&.> ":&.>)
mutate=: dyad define
idxmut=. I. x >: (*/$y) ?@$ 0
(populate idxmut) idxmut"_} y
)
evolve=: monad define
target=. y
parent=. populate y
iter=. 0
mrate=. %#y
while. 0 < val=. target fitness parent do.
if. 0 = 50|iter do. log iter;val;parent end.
iter=. iter + 1
progeny=. mrate mutate NPROG # ,: parent NB. create progeny by mutating parent copies
parent=. target select parent,progeny NB. select fittest parent for next generation
end.
log iter;val;parent
parent
)

5
Task/Evolutionary-algorithm/J/evolutionary-algorithm-4.j Normal file
View file

@ -0,0 +1,5 @@
evolve 'METHINKS IT IS LIKE A WEASEL'
#0 fitness: 27 ; YGFDJFTBEDB FAIJJGMFKDPYELOA
#50 fitness: 2 ; MEVHINKS IT IS LIKE ADWEASEL
#76 fitness: 0 ; METHINKS IT IS LIKE A WEASEL
METHINKS IT IS LIKE A WEASEL

58
Task/Evolutionary-algorithm/Java/evolutionary-algorithm.java Normal file
View file

@ -0,0 +1,58 @@
import java.util.Random;
public class EvoAlgo {
static final String target = "METHINKS IT IS LIKE A WEASEL";
static final char[] possibilities = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ".toCharArray();
static int C = 100; //number of spawn per generation
static double minMutateRate = 0.09;
static int perfectFitness = target.length();
private static String parent;
static Random rand = new Random();
private static int fitness(String trial){
int retVal = 0;
for(int i = 0;i < trial.length(); i++){
if (trial.charAt(i) == target.charAt(i)) retVal++;
}
return retVal;
}
private static double newMutateRate(){
return (((double)perfectFitness - fitness(parent)) / perfectFitness * (1 - minMutateRate));
}
private static String mutate(String parent, double rate){
String retVal = "";
for(int i = 0;i < parent.length(); i++){
retVal += (rand.nextDouble() <= rate) ?
possibilities[rand.nextInt(possibilities.length)]:
parent.charAt(i);
}
return retVal;
}
public static void main(String[] args){
parent = mutate(target, 1);
int iter = 0;
while(!target.equals(parent)){
double rate = newMutateRate();
iter++;
if(iter % 100 == 0){
System.out.println(iter +": "+parent+ ", fitness: "+fitness(parent)+", rate: "+rate);
}
String bestSpawn = null;
int bestFit = 0;
for(int i = 0; i < C; i++){
String spawn = mutate(parent, rate);
int fitness = fitness(spawn);
if(fitness > bestFit){
bestSpawn = spawn;
bestFit = fitness;
}
}
parent = bestFit > fitness(parent) ? bestSpawn : parent;
}
System.out.println(parent+", "+iter);
}
}

230
Task/Evolutionary-algorithm/JavaScript/evolutionary-algorithm.js Normal file
View file

@ -0,0 +1,230 @@
// ------------------------------------- Cross-browser Compatibility -------------------------------------
/* Compatibility code to reduce an array
* Source: https://developer.mozilla.org/en/JavaScript/Reference/Global_Objects/Array/Reduce
*/
if (!Array.prototype.reduce) {
Array.prototype.reduce = function (fun /*, initialValue */ ) {
"use strict";
if (this === void 0 || this === null) throw new TypeError();
var t = Object(this);
var len = t.length >>> 0;
if (typeof fun !== "function") throw new TypeError();
// no value to return if no initial value and an empty array
if (len == 0 && arguments.length == 1) throw new TypeError();
var k = 0;
var accumulator;
if (arguments.length >= 2) {
accumulator = arguments[1];
} else {
do {
if (k in t) {
accumulator = t[k++];
break;
}
// if array contains no values, no initial value to return
if (++k >= len) throw new TypeError();
}
while (true);
}
while (k < len) {
if (k in t) accumulator = fun.call(undefined, accumulator, t[k], k, t);
k++;
}
return accumulator;
};
}
/* Compatibility code to map an array
* Source: https://developer.mozilla.org/en/JavaScript/Reference/Global_Objects/Array/Map
*/
if (!Array.prototype.map) {
Array.prototype.map = function (fun /*, thisp */ ) {
"use strict";
if (this === void 0 || this === null) throw new TypeError();
var t = Object(this);
var len = t.length >>> 0;
if (typeof fun !== "function") throw new TypeError();
var res = new Array(len);
var thisp = arguments[1];
for (var i = 0; i < len; i++) {
if (i in t) res[i] = fun.call(thisp, t[i], i, t);
}
return res;
};
}
/* ------------------------------------- Generator -------------------------------------
* Generates a fixed length gene sequence via a gene strategy object.
* The gene strategy object must have two functions:
* - "create": returns create a new gene
* - "mutate(existingGene)": returns mutation of an existing gene
*/
function Generator(length, mutationRate, geneStrategy) {
this.size = length;
this.mutationRate = mutationRate;
this.geneStrategy = geneStrategy;
}
Generator.prototype.spawn = function () {
var genes = [],
x;
for (x = 0; x < this.size; x += 1) {
genes.push(this.geneStrategy.create());
}
return genes;
};
Generator.prototype.mutate = function (parent) {
return parent.map(function (char) {
if (Math.random() > this.mutationRate) {
return char;
}
return this.geneStrategy.mutate(char);
}, this);
};
/* ------------------------------------- Population -------------------------------------
* Helper class that holds and spawns a new population.
*/
function Population(size, generator) {
this.size = size;
this.generator = generator;
this.population = [];
// Build initial popuation;
for (var x = 0; x < this.size; x += 1) {
this.population.push(this.generator.spawn());
}
}
Population.prototype.spawn = function (parent) {
this.population = [];
for (var x = 0; x < this.size; x += 1) {
this.population.push(this.generator.mutate(parent));
}
};
/* ------------------------------------- Evolver -------------------------------------
* Attempts to converge a population based a fitness strategy object.
* The fitness strategy object must have three function
* - "score(individual)": returns a score for an individual.
* - "compare(scoreA, scoreB)": return true if scoreA is better (ie more fit) then scoreB
* - "done( score )": return true if score is acceptable (ie we have successfully converged).
*/
function Evolver(size, generator, fitness) {
this.done = false;
this.fitness = fitness;
this.population = new Population(size, generator);
}
Evolver.prototype.getFittest = function () {
return this.population.population.reduce(function (best, individual) {
var currentScore = this.fitness.score(individual);
if (best === null || this.fitness.compare(currentScore, best.score)) {
return {
score: currentScore,
individual: individual
};
} else {
return best;
}
}, null);
};
Evolver.prototype.doGeneration = function () {
this.fittest = this.getFittest();
this.done = this.fitness.done(this.fittest.score);
if (!this.done) {
this.population.spawn(this.fittest.individual);
}
};
Evolver.prototype.run = function (onCheckpoint, checkPointFrequency) {
checkPointFrequency = checkPointFrequency || 10; // Default to Checkpoints every 10 generations
var generation = 0;
while (!this.done) {
this.doGeneration();
if (generation % checkPointFrequency === 0) {
onCheckpoint(generation, this.fittest);
}
generation += 1;
}
onCheckpoint(generation, this.fittest);
return this.fittest;
};
// ------------------------------------- Exports -------------------------------------
window.Generator = Generator;
window.Evolver = Evolver;
// helper utitlity to combine elements of two arrays.
Array.prototype.zip = function (b, func) {
var result = [],
max = Math.max(this.length, b.length),
x;
for (x = 0; x < max; x += 1) {
result.push(func(this[x], b[x]));
}
return result;
};
var target = "METHINKS IT IS LIKE A WEASEL", geneStrategy, fitness, target, generator, evolver, result;
geneStrategy = {
// The allowed character set (as an array)
characterSet: "ABCDEFGHIJKLMNOPQRSTUVWXYZ ".split(""),
/*
Pick a random character from the characterSet
*/
create: function getRandomGene() {
var randomNumber = Math.floor(Math.random() * this.characterSet.length);
return this.characterSet[randomNumber];
}
};
geneStrategy.mutate = geneStrategy.create; // Our mutation stragtegy is to simply get a random gene
fitness = {
// The target (as an array of characters)
target: target.split(""),
equal: function (geneA, geneB) {
return (geneA === geneB ? 0 : 1);
},
sum: function (runningTotal, value) {
return runningTotal + value;
},
/*
We give one point to for each corect letter
*/
score: function (genes) {
var diff = genes.zip(this.target, this.equal); // create an array of ones and zeros
return diff.reduce(this.sum, 0); // Sum the array values together.
},
compare: function (scoreA, scoreB) {
return scoreA <= scoreB; // Lower scores are better
},
done: function (score) {
return score === 0; // We have matched the target string.
}
};
generator = new Generator(target.length, 0.05, geneStrategy);
evolver = new Evolver(100, generator, fitness);
function showProgress(generation, fittest) {
document.write("Generation: " + generation + ", Best: " + fittest.individual.join("") + ", fitness:" + fittest.score + "<br>");
}
result = evolver.run(showProgress);

24
Task/Evolutionary-algorithm/Julia/evolutionary-algorithm.julia Normal file
View file

@ -0,0 +1,24 @@
fitness(a::AbstractString, b::AbstractString) = count(l == t for (l, t) in zip(a, b))
function mutate(str::AbstractString, rate::Float64)
L = collect(Char, " ABCDEFGHIJKLMNOPQRSTUVWXYZ")
return map(str) do c
if rand() < rate rand(L) else c end
end
end
function evolve(parent::String, target::String, mutrate::Float64, nchild::Int)
println("Initial parent is $parent, its fitness is $(fitness(parent, target))")
gens = 0
while parent != target
children = collect(mutate(parent, mutrate) for i in 1:nchild)
bestfit, best = findmax(fitness.(children, target))
parent = children[best]
gens += 1
if gens % 10 == 0
println("After $gens generations, the new parent is $parent and its fitness is $(fitness(parent, target))")
end
end
println("After $gens generations, the parent evolved into the target $target")
end
evolve("IU RFSGJABGOLYWF XSMFXNIABKT", "METHINKS IT IS LIKE A WEASEL", 0.08998, 100)

34
Task/Evolutionary-algorithm/Kotlin/evolutionary-algorithm.kotlin Normal file
View file

@ -0,0 +1,34 @@
import java.util.*
val target = "METHINKS IT IS LIKE A WEASEL"
val validChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
val random = Random()
fun randomChar() = validChars[random.nextInt(validChars.length)]
fun hammingDistance(s1: String, s2: String) =
s1.zip(s2).map { if (it.first == it.second) 0 else 1 }.sum()
fun fitness(s1: String) = target.length - hammingDistance(s1, target)
fun mutate(s1: String, mutationRate: Double) =
s1.map { if (random.nextDouble() > mutationRate) it else randomChar() }
.joinToString(separator = "")
fun main(args: Array<String>) {
val initialString = (0 until target.length).map { randomChar() }.joinToString(separator = "")
println(initialString)
println(mutate(initialString, 0.2))
val mutationRate = 0.05
val childrenPerGen = 50
var i = 0
var currVal = initialString
while (currVal != target) {
i += 1
currVal = (0..childrenPerGen).map { mutate(currVal, mutationRate) }.maxBy { fitness(it) }!!
}
println("Evolution found target after $i generations")
}

69
Task/Evolutionary-algorithm/Liberty-BASIC/evolutionary-algorithm.basic Normal file
View file

@ -0,0 +1,69 @@
C = 10
'mutaterate has to be greater than 1 or it will not mutate
mutaterate = 2
mutationstaken = 0
generations = 0
Dim parentcopies$((C - 1))
Global targetString$ : targetString$ = "METHINKS IT IS LIKE A WEASEL"
Global allowableCharacters$ : allowableCharacters$ = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
currentminFitness = Len(targetString$)
For i = 1 To Len(targetString$)
parent$ = parent$ + Mid$(allowableCharacters$, Int(Rnd(1) + 1 * Len(allowableCharacters$)), 1) 'corrected line
Next i
Print "Parent = " + parent$
While parent$ <> targetString$
generations = (generations + 1)
For i = 0 To (C - 1)
parentcopies$(i) = mutate$(parent$, mutaterate)
mutationstaken = (mutationstaken + 1)
Next i
For i = 0 To (C - 1)
currentFitness = Fitness(targetString$, parentcopies$(i))
If currentFitness = 0 Then
parent$ = parentcopies$(i)
Exit For
Else
If currentFitness < currentminFitness Then
currentminFitness = currentFitness
parent$ = parentcopies$(i)
End If
End If
Next i
CLS
Print "Generation - " + str$(generations)
Print "Parent - " + parent$
Scan
Wend
Print
Print "Congratulations to me; I finished!"
Print "Final Mutation: " + parent$
'The ((i + 1) - (C)) reduces the total number of mutations that it took by one generation
'minus the perfect child mutation since any after that would not have been required.
Print "Total Mutations Taken - " + str$(mutationstaken - ((i + 1) - (C)))
Print "Total Generations Taken - " + str$(generations)
Print "Child Number " + str$(i) + " has perfect similarities to your target."
End
Function mutate$(mutate$, mutaterate)
If (Rnd(1) * mutaterate) > 1 Then
'The mutatingcharater randomizer needs 1 more than the length of the string
'otherwise it will likely take forever to get exactly that as a random number
mutatingcharacter = Int(Rnd(1) * (Len(targetString$) + 1))
mutate$ = Left$(mutate$, (mutatingcharacter - 1)) + Mid$(allowableCharacters$, Int(Rnd(1) * Len(allowableCharacters$)), 1) _
+ Mid$(mutate$, (mutatingcharacter + 1))
End If
End Function
Function Fitness(parent$, offspring$)
For i = 1 To Len(targetString$)
If Mid$(parent$, i, 1) <> Mid$(offspring$, i, 1) Then
Fitness = (Fitness + 1)
End If
Next i
End Function

44
Task/Evolutionary-algorithm/Logo/evolutionary-algorithm.logo Normal file
View file

@ -0,0 +1,44 @@
make "target "|METHINKS IT IS LIKE A WEASEL|
to distance :w
output reduce "sum (map.se [ifelse equal? ?1 ?2 [0][1]] :w :target)
end
to random.letter
output pick "| ABCDEFGHIJKLMNOPQRSTUVWXYZ|
end
to mutate :parent :rate
output map [ifelse random 100 < :rate [random.letter] [?]] :parent
end
make "C 100
make "mutate.rate 10 ; percent
to breed :parent
make "parent.distance distance :parent
localmake "best.child :parent
repeat :C [
localmake "child mutate :parent :mutate.rate
localmake "child.distance distance :child
if greater? :parent.distance :child.distance [
make "parent.distance :child.distance
make "best.child :child
]
]
output :best.child
end
to progress
output (sentence :trials :parent "distance: :parent.distance)
end
to evolve
make "parent cascade count :target [lput random.letter ?] "||
make "trials 0
while [not equal? :parent :target] [
make "parent breed :parent
print progress
make "trials :trials + 1
]
end

52
Task/Evolutionary-algorithm/Lua/evolutionary-algorithm.lua Normal file
View file

@ -0,0 +1,52 @@
local target = "METHINKS IT IS LIKE A WEASEL"
local alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
local c, p = 100, 0.06
local function fitness(s)
local score = #target
for i = 1,#target do
if s:sub(i,i) == target:sub(i,i) then score = score - 1 end
end
return score
end
local function mutate(s, rate)
local result, idx = ""
for i = 1,#s do
if math.random() < rate then
idx = math.random(#alphabet)
result = result .. alphabet:sub(idx,idx)
else
result = result .. s:sub(i,i)
end
end
return result, fitness(result)
end
local function randomString(len)
local result, idx = ""
for i = 1,len do
idx = math.random(#alphabet)
result = result .. alphabet:sub(idx,idx)
end
return result
end
local function printStep(step, s, fit)
print(string.format("%04d: ", step) .. s .. " [" .. fit .."]")
end
math.randomseed(os.time())
local parent = randomString(#target)
printStep(0, parent, fitness(parent))
local step = 0
while parent ~= target do
local bestFitness, bestChild, child, fitness = #target + 1
for i = 1,c do
child, fitness = mutate(parent, p)
if fitness < bestFitness then bestFitness, bestChild = fitness, child end
end
parent, step = bestChild, step + 1
printStep(step, parent, bestFitness)
end

57
Task/Evolutionary-algorithm/M2000-Interpreter/evolutionary-algorithm-1.m2000 Normal file
View file

@ -0,0 +1,57 @@
Module WeaselAlgorithm {
Print "Evolutionary Algorithm"
\\ Weasel Algorithm
\\ Using dynamic array, which expand if no fitness change,
\\ and reduce to minimum when fitness changed
\\ Abandon strings when fitness change
\\ Also lambda function Mutate$ change when topscore=10, to change only one character
l$="ABCDEFGHIJKLMNOPQRSTUVWXYZ "
randomstring$=lambda$ l$ ->{
res$=""
For i=1 to 28: res$+=Mid$(L$,Random(1,27),1):next i
=res$
}
m$="METHINKS IT IS LIKE A WEASEL"
lm=len(m$)
fitness=lambda m$, lm (this$)-> {
score=0 : For i=1 to lm {score+=If(mid$(m$,i,1)=mid$(this$, i, 1)->1,0)} : =score
}
Mutate$=lambda$ l$ (w$)-> {
a=random(1,28) : insert a, 1 w$=mid$(l$, random(1,27),1)
If random(3)=1 Then b=a:while b=a {b=random(1,28)} : insert b, 1 w$=mid$(l$, random(1,27),1)
=w$
}
Mutate1$=lambda$ l$ (w$)-> {
insert random(1,28), 1 w$=mid$(l$, random(1,27),1) : =w$
}
f$=randomstring$()
topscore=0
last=0
Pen 11 {Print "Fitness |Target:", @(16),m$, @(47),"|Total Strings"}
Print Over $(3,8), str$(topscore/28,"##0.0%"),"",$(0),f$, 0
count=0
gen=30
mut=0
{
last=0
Dim a$(1 to gen)<<mutate$(f$)
mut+=gen
oldscore=topscore
For i=1 to gen {
topscore=max.data(topscore, fitness(a$(i)))
If oldscore<topscore Then last=i:Exit
}
If last>0 Then {
f$=a$(last) : gen=30 : If topscore=10 Then mutate$=mutate1$
} Else gen+=50
Print Over $(3,8), str$(topscore/28,"##0.0%"), "",$(0),f$, mut : refresh
count+=min(gen,i)
If topscore<28 Then loop
}
Print
Print "Results"
Print "I found this:"; a$(i)
Print "Total strings which evalute fitness:"; count
Print "Done"
}
WeaselAlgorithm

53
Task/Evolutionary-algorithm/M2000-Interpreter/evolutionary-algorithm-2.m2000 Normal file
View file

@ -0,0 +1,53 @@
Module WeaselAlgorithm2 {
Print "Evolutionary Algorithm"
\\ Weasel Algorithm
\\ Using dynamic array, which expand if no fitness change,
\\ and reduce to minimum when fitness changed
l$="ABCDEFGHIJKLMNOPQRSTUVWXYZ "
randomstring$=lambda$ l$ ->{
res$=""
For i=1 to 28: res$+=Mid$(L$,Random(1,27),1):next i
=res$
}
m$="METHINKS IT IS LIKE A WEASEL"
lm=len(m$)
fitness=lambda m$, lm (this$)-> {
score=0 : For i=1 to lm {score+=If(mid$(m$,i,1)=mid$(this$, i, 1)->1,0)} : =score
}
Mutate$=lambda$ l$ (w$)-> {
for i=1 to len(w$) {
if random(1,100)<=5 then { insert i, 1 w$=mid$(l$, random(1,27),1) }
}
=w$
}
f$=randomstring$()
topscore=0
last=0
Pen 11 {Print "Fitness |Target:", @(16),m$, @(47),"|Total Strings"}
Print Over $(3,8), str$(topscore/28,"##0.0%"),"",$(0),f$, 0
count=0
gen=30
mut=0
{
last=0
Dim a$(1 to gen)<<mutate$(f$)
mut+=gen
oldscore=topscore
For i=1 to gen {
topscore=max.data(topscore, fitness(a$(i)))
If oldscore<topscore Then last=i: oldscore=topscore
}
If last>0 Then {
f$=a$(last) : gen=30
} Else gen+=50
Print Over $(3,8), str$(topscore/28,"##0.0%"), "",$(0),f$, mut : refresh
count+=min(gen,i)
If topscore<28 Then loop
}
Print
Print "Results"
Print "I found this:"; a$(last)
Print "Total strings which evalute fitness:"; count
Print "Done"
}
WeaselAlgorithm2

92
Task/Evolutionary-algorithm/M4/evolutionary-algorithm.m4 Normal file
View file

@ -0,0 +1,92 @@
divert(-1)
# Get a random number from 0 to one less than $1.
# (Note that this is not a very good RNG. Also it writes a file.)
#
# Usage: randnum(N) (Produces a random integer in 0..N-1)
#
define(`randnum',
`syscmd(`echo $RANDOM > __random_number__')eval(include(__random_number__) % ( $1 ))')
# The *target* specified in the Rosetta Code task.
define(`target',`METHINKS IT IS LIKE A WEASEL')
define(`alphabet',`ABCDEFGHIJKLMNOPQRSTUVWXYZ ')
define(`random_letter',`substr(alphabet,randnum(len(alphabet)),1)')
define(`create_primogenitor',`_$0(`')')
define(`_create_primogenitor',`ifelse(len(`$1'),len(target),`$1',
`$0(`$1'random_letter)')')
# The *parent* specified in the Rosetta Code task.
define(`parent',`'create_primogenitor)
#
# Usage: mutate_letter(STRING,INDEX)
#
define(`mutate_letter',
`substr(`$1',0,`$2')`'random_letter`'substr(`$1',incr(`$2'))')
#
# Usage: mutate_letter_at_rate(STRING,INDEX,MUTATION_RATE)
#
define(`mutate_letter_at_rate',
`ifelse(eval(randnum(100) < ($3)),1,`mutate_letter(`$1',`$2')',`$1')')
# The *mutate* procedure specified in the Rosetta Code task. The
# mutation rate is given in percents.
#
# Usage: mutate(STRING,MUTATION_RATE)
#
define(`mutate',`_$0(`$1',`$2',len(`$1'))')
define(`_mutate',
`ifelse($3,0,`$1',
`$0(mutate_letter_at_rate(`$1',decr($3),`$2'),`$2',decr($3))')')
# The *fitness* procedure specified in the Rosetta Code
# task. "Fitness" here is simply how many letters match.
#
# Usage: fitness(STRING)
#
define(`fitness',`_$0(`$1',target,0)')
define(`_fitness',
`ifelse(`$1',`',$3,
`ifelse(`'substr(`$1',0,1),`'substr(`$2',0,1),
`$0(`'substr(`$1',1),`'substr(`$2',1),incr($3))',
`$0(`'substr(`$1',1),`'substr(`$2',1),$3)')')')
#
# Usage: have_child(PARENT,MUTATION_RATE)
#
# The result is either the parent or the child: whichever has the
# greater fitness. If they are equally fit, one is chosen arbitrarily.
# (Note that, in the current implementation, fitnesses are not
# memoized.)
#
define(`have_child',
`pushdef(`_child_',mutate(`$1',`$2'))`'dnl
ifelse(eval(fitness(`'_child_) < fitness(`$1')),1,`$1',`_child_')`'dnl
popdef(`_child_')')
#
# Usage: next_parent(PARENT,NUM_CHILDREN,MUTATION_RATE)
#
# Note that a string is discarded as soon as it is known it will not
# be in the next generation. If some strings have the same highest
# fitness, one of them is chosen arbitrarily.
#
define(`next_parent',`_$0(`$1',`$2',`$3',`$1')')
define(`_next_parent',
`ifelse(`$2',0,`$1',
`$0(`'have_child(`$4',`$3'),decr(`$2'),`$3',`$4')')')
define(`repeat_until_equal',
`ifelse(`$1',`'target,`[$1]',
`pushdef(`_the_horta_',`'next_parent(`$1',`$2',`$3'))`'dnl
[_the_horta_]
$0(`'_the_horta_,`$2',`$3')`'dnl
popdef(`_the_horta_')')')
divert`'dnl
[parent]
repeat_until_equal(parent,10,10)

220
Task/Evolutionary-algorithm/MATLAB/evolutionary-algorithm-1.m Normal file
View file

@ -0,0 +1,220 @@
%This class impliments a string that mutates to a target
classdef EvolutionaryAlgorithm
properties
target;
parent;
children = {};
validAlphabet;
%Constants
numChildrenPerIteration;
maxIterations;
mutationRate;
end
methods
%Class constructor
function family = EvolutionaryAlgorithm(target,mutationRate,numChildren,maxIterations)
family.validAlphabet = char([32 (65:90)]); %Space char and A-Z
family.target = target;
family.children = cell(numChildren,1);
family.numChildrenPerIteration = numChildren;
family.maxIterations = maxIterations;
family.mutationRate = mutationRate;
initialize(family);
end %class constructor
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%Helper functions and class get/set functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%setAlphabet() - sets the valid alphabet for the current instance
%of the EvolutionaryAlgorithm class.
function setAlphabet(family,alphabet)
if(ischar(alphabet))
family.validAlphabet = alphabet;
%Makes change permanent
assignin('caller',inputname(1),family);
else
error 'New alphabet must be a string or character array';
end
end
%setTarget() - sets the target for the current instance
%of the EvolutionaryAlgorithm class.
function setTarget(family,target)
if(ischar(target))
family.target = target;
%Makes change permanent
assignin('caller',inputname(1),family);
else
error 'New target must be a string or character array';
end
end
%setMutationRate() - sets the mutation rate for the current instance
%of the EvolutionaryAlgorithm class.
function setMutationRate(family,mutationRate)
if(isnumeric(mutationRate))
family.mutationRate = mutationRate;
%Makes change permanent
assignin('caller',inputname(1),family);
else
error 'New mutation rate must be a double precision number';
end
end
%setMaxIterations() - sets the maximum number of iterations during
%evolution for the current instance of the EvolutionaryAlgorithm class.
function setMaxIterations(family,maxIterations)
if(isnumeric(maxIterations))
family.maxIterations = maxIterations;
%Makes change permanent
assignin('caller',inputname(1),family);
else
error 'New maximum amount of iterations must be a double precision number';
end
end
%display() - overrides the built-in MATLAB display() function, to
%display the important class variables
function display(family)
disp([sprintf('Target: %s\n',family.target)...
sprintf('Parent: %s\n',family.parent)...
sprintf('Valid Alphabet: %s\n',family.validAlphabet)...
sprintf('Number of Children: %d\n',family.numChildrenPerIteration)...
sprintf('Mutation Rate [0,1]: %d\n',family.mutationRate)...
sprintf('Maximum Iterations: %d\n',family.maxIterations)]);
end
%disp() - overrides the built-in MATLAB disp() function, to
%display the important class variables
function disp(family)
display(family);
end
%randAlphabetElement() - Generates a random character from the
%valid alphabet for the current instance of the class.
function elements = randAlphabetElements(family,numChars)
%Sample the valid alphabet randomly from the uniform
%distribution
N = length(family.validAlphabet);
choices = ceil(N*rand(1,numChars));
elements = family.validAlphabet(choices);
end
%initialize() - Sets the parent to a random string of length equal
%to the length of the target
function parent = initialize(family)
family.parent = randAlphabetElements(family,length(family.target));
parent = family.parent;
%Makes changes to the instance of EvolutionaryAlgorithm permanent
assignin('caller',inputname(1),family);
end %initialize
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%Functions required by task specification
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%mutate() - generates children from the parent and mutates them
function mutate(family)
sizeParent = length(family.parent);
%Generate mutatant children sequentially
for child = (1:family.numChildrenPerIteration)
parentCopy = family.parent;
for charIndex = (1:sizeParent)
if (rand(1) < family.mutationRate)
parentCopy(charIndex) = randAlphabetElements(family,1);
end
end
family.children{child} = parentCopy;
end
%Makes changes to the instance of EvolutionaryAlgorithm permanent
assignin('caller',inputname(1),family);
end %mutate
%fitness() - Computes the Hamming distance between the target
%string and the string input as the familyMember argument
function theFitness = fitness(family,familyMember)
if not(ischar(familyMember))
error 'The second argument must be a string';
end
theFitness = sum(family.target == familyMember);
end
%evolve() - evolves the family until the target is reached or it
%exceeds the maximum amount of iterations
function [iteration,mostFitFitness] = evolve(family)
iteration = 0;
mostFitFitness = 0;
targetFitness = fitness(family,family.target);
disp(['Target fitness is ' num2str(targetFitness)]);
while (mostFitFitness < targetFitness) && (iteration < family.maxIterations)
iteration = iteration + 1;
mutate(family);
parentFitness = fitness(family,family.parent);
mostFit = family.parent;
mostFitFitness = parentFitness;
for child = (1:family.numChildrenPerIteration)
childFitness = fitness(family,family.children{child});
if childFitness > mostFitFitness
mostFit = family.children{child};
mostFitFitness = childFitness;
end
end
family.parent = mostFit;
disp([num2str(iteration) ': ' mostFit ' - Fitness: ' num2str(mostFitFitness)]);
end
%Makes changes to the instance of EvolutionaryAlgorithm permanent
assignin('caller',inputname(1),family);
end %evolve
end %methods
end %classdef

27
Task/Evolutionary-algorithm/MATLAB/evolutionary-algorithm-2.m Normal file
View file

@ -0,0 +1,27 @@
>> instance = EvolutionaryAlgorithm('METHINKS IT IS LIKE A WEASEL',.08,50,1000)
Target: METHINKS IT IS LIKE A WEASEL
Parent: UVEOCXXFBGDCSFNMJQNWTPJ PCVA
Valid Alphabet: ABCDEFGHIJKLMNOPQRSTUVWXYZ
Number of Children: 50
Mutation Rate [0,1]: 8.000000e-002
Maximum Iterations: 1000
>> evolve(instance);
Target fitness is 28
1: MVEOCXXFBYD SFCMJQNWTPM PCVA - Fitness: 2
2: MEEOCXXFBYD SFCMJQNWTPM PCVA - Fitness: 3
3: MEEHCXXFBYD SFCMJXNWTPM ECVA - Fitness: 4
4: MEEHCXXFBYD SFCMJXNWTPM ECVA - Fitness: 4
5: METHCXAFBYD SFCMJXNWXPMARPVA - Fitness: 5
6: METHCXAFBYDFSFCMJXNWX MARSVA - Fitness: 6
7: METHCXKFBYDFBFCQJXNWX MATSVA - Fitness: 7
8: METHCXKFBYDFBF QJXNWX MATSVA - Fitness: 8
9: METHCXKFBYDFBF QJXNWX MATSVA - Fitness: 8
10: METHCXKFUYDFBF QJXNWX MITSEA - Fitness: 9
20: METHIXKF YTBOF LIKN G MIOSEI - Fitness: 16
30: METHIXKS YTCOF LIKN A MIOSEL - Fitness: 19
40: METHIXKS YTCIF LIKN A MEUSEL - Fitness: 21
50: METHIXKS YT IS LIKE A PEUSEL - Fitness: 24
100: METHIXKS YT IS LIKE A WEASEL - Fitness: 26
150: METHINKS YT IS LIKE A WEASEL - Fitness: 27
195: METHINKS IT IS LIKE A WEASEL - Fitness: 28

110
Task/Evolutionary-algorithm/MATLAB/evolutionary-algorithm-3.m Normal file
View file

@ -0,0 +1,110 @@
%% Genetic Algorithm -- Solves For A User Input String
% #### PLEASE NOTE: you can change the selection and crossover type in the
% parameters and see how the algorithm changes. ####
clear;close all;clc; %Clears variables, closes windows, and clears the command window
tic % Begins the timer
%% Select Target String
target = 'METHINKS IT IS LIKE A WEASEL';
% *Can Be Any String With Any Values and Any Length!*
% but for this example we use 'METHINKS IT IS LIKE A WEASEL'
%% Parameters
popSize = 1000; % Population Size (100-10000 generally produce good results)
genome = length(target); % Genome Size
mutRate = .01; % Mutation Rate (5%-25% produce good results)
S = 4; % Tournament Size (2-6 produce good results)
best = Inf; % Initialize Best (arbitrarily large)
MaxVal = max(double(target)); % Max Integer Value Needed
ideal = double(target); % Convert Target to Integers
selection = 0; % 0: Tournament
% 1: 50% Truncation
crossover = 1; % 0: Uniform crossover
% 1: 1 point crossover
% 2: 2 point crossover
%% Initialize Population
Pop = round(rand(popSize,genome)*(MaxVal-1)+1); % Creates Population With Corrected Genome Length
for Gen = 1:1e6 % A Very Large Number Was Chosen, But Shouldn't Be Needed
%% Fitness
% The fitness function starts by converting the characters into integers and then
% subtracting each element of each member of the population from each element of
% the target string. The function then takes the absolute value of
% the differences and sums each row and stores the function as a mx1 matrix.
F = sum(abs(bsxfun(@minus,Pop,ideal)),2);
% Finding Best Members for Score Keeping and Printing Reasons
[current,currentGenome] = min(F); % current is the minimum value of the fitness array F
% currentGenome is the index of that value in the F array
% Stores New Best Values and Prints New Best Scores
if current < best
best = current;
bestGenome = Pop(currentGenome,:); % Uses that index to find best value
fprintf('Gen: %d | Fitness: %d | ',Gen, best); % Formatted printing of generation and fitness
disp(char(bestGenome)); % Best genome so far
elseif best == 0
break % Stops program when we are done
end
%% Selection
% TOURNAMENT
if selection == 0
T = round(rand(2*popSize,S)*(popSize-1)+1); % Tournaments
[~,idx] = min(F(T),[],2); % Index to Determine Winners
W = T(sub2ind(size(T),(1:2*popSize)',idx)); % Winners
% 50% TRUNCATION
elseif selection == 1
[~,V] = sort(F,'descend'); % Sort Fitness in Ascending Order
V = V(popSize/2+1:end); % Winner Pool
W = V(round(rand(2*popSize,1)*(popSize/2-1)+1))'; % Winners
end
%% Crossover
% UNIFORM CROSSOVER
if crossover == 0
idx = logical(round(rand(size(Pop)))); % Index of Genome from Winner 2
Pop2 = Pop(W(1:2:end),:); % Set Pop2 = Pop Winners 1
P2A = Pop(W(2:2:end),:); % Assemble Pop2 Winners 2
Pop2(idx) = P2A(idx); % Combine Winners 1 and 2
% 1-POINT CROSSOVER
elseif crossover == 1
Pop2 = Pop(W(1:2:end),:); % New Population From Pop 1 Winners
P2A = Pop(W(2:2:end),:); % Assemble the New Population
Ref = ones(popSize,1)*(1:genome); % The Reference Matrix
idx = (round(rand(popSize,1)*(genome-1)+1)*ones(1,genome))>Ref; % Logical Indexing
Pop2(idx) = P2A(idx); % Recombine Both Parts of Winners
% 2-POINT CROSSOVER
elseif crossover == 2
Pop2 = Pop(W(1:2:end),:); % New Pop is Winners of old Pop
P2A = Pop(W(2:2:end),:); % Assemble Pop2 Winners 2
Ref = ones(popSize,1)*(1:genome); % Ones Matrix
CP = sort(round(rand(popSize,2)*(genome-1)+1),2); % Crossover Points
idx = CP(:,1)*ones(1,genome)<Ref&CP(:,2)*ones(1,genome)>Ref; % Index
Pop2(idx)=P2A(idx); % Recombine Winners
end
%% Mutation
idx = rand(size(Pop2))<mutRate; % Index of Mutations
Pop2(idx) = round(rand([1,sum(sum(idx))])*(MaxVal-1)+1); % Mutated Value
%% Reset Poplulations
Pop = Pop2;
end
toc % Ends timer and prints elapsed time

42
Task/Evolutionary-algorithm/MATLAB/evolutionary-algorithm-4.m Normal file
View file

@ -0,0 +1,42 @@
Gen: 1 | Fitness: 465 | C<EFBFBD>I1%G+<%?R<EFBFBD>8>9<EFBFBD>JU#(E<EFBFBD>UO<EFBFBD>PHI
Gen: 2 | Fitness: 429 | W=P6>D<EFBFBD>I)VU6$T 99,<EFBFBD> B<EFBFBD>BMP0JH
Gen: 3 | Fitness: 366 | P<EFBFBD>;R08AS<EFBFBD>GJ<EFBFBD>IS&T38IE<EFBFBD>)SJERLJ
Gen: 4 | Fitness: 322 | KI8M5LAS<EFBFBD>GJ<EFBFBD>IS<EFBFBD>SP<EFBFBD>@)D<EFBFBD>V@
JCP
Gen: 5 | Fitness: 295 | UAUR08AS<EFBFBD>GJ<EFBFBD>IS<EFBFBD>8HG*<EFBFBD>+<EFBFBD>=C?UB(
Gen: 6 | Fitness: 259 | VCUQH35S<EFBFBD>HR4.L<EFBFBD>ISJQ%J<EFBFBD>OC*T=E
Gen: 7 | Fitness: 226 | LFB8GPET(LODKQ<EFBFBD>KQ<K E*PEMA6I
Gen: 8 | Fitness: 192 | EPKOLCIR<EFBFBD>QQ<EFBFBD>NF<EFBFBD>QG:B(D/U>BQGF
Gen: 9 | Fitness: 159 | N8R7?SOU<EFBFBD>NO$OK O?K?!;<EFBFBD>MB?QHG
Gen: 10 | Fitness: 146 | TGN@EQR4)PS%IS#TFJQ%A!U>BVLI
Gen: 11 | Fitness: 120 | L?VMALJS%?R EK IILE<EFBFBD>6'RRERLJ
Gen: 12 | Fitness: 102 | R@T9COMR<EFBFBD>NU CS*R?K?!; VD>LCL
Gen: 13 | Fitness: 96 | NENMVOMR<EFBFBD>NU CS*R?K?!; VD>LCL
Gen: 14 | Fitness: 82 | REJGNPMU<EFBFBD>KR CS JKI@+D<EFBFBD>UD?QHG
Gen: 15 | Fitness: 75 | NETI=HPQ<EFBFBD>FT ID EFKE D"WD>QDQ
Gen: 16 | Fitness: 70 | R@TKCOOT)@R$IS KKLE<EFBFBD>D"WC?UBJ
Gen: 17 | Fitness: 61 | NESIKQRP<EFBFBD>NU CS<EFBFBD>MFKE ; SEETCP
Gen: 18 | Fitness: 57 | LFSGLPTN<EFBFBD>NU GQ IIKE D"VD>LCL
Gen: 19 | Fitness: 40 | NENKJLMS<EFBFBD>GS%IS#MFKE B UFATCL
Gen: 21 | Fitness: 39 | NETIGPEU<EFBFBD>KR IS IIKD"? UFDQEK
Gen: 22 | Fitness: 33 | NETGCOMT<EFBFBD>LU IS#MFKE B UFATCL
Gen: 23 | Fitness: 32 | NETIKNPQ<EFBFBD>NU IS#IIKE B UFATCL
Gen: 24 | Fitness: 27 | NETKJLMS<EFBFBD>LU IS MFKE B UFATCL
Gen: 25 | Fitness: 23 | LETIKOMS LU IS IIKE D WEDQEK
Gen: 26 | Fitness: 22 | NETIKMJS LU IS IIKE D WEDQEK
Gen: 27 | Fitness: 20 | LETIKOMS LU IS KILE B"WFATCL
Gen: 28 | Fitness: 19 | NESGJQJS<EFBFBD>GU IS KIKE B WFATEK
Gen: 29 | Fitness: 16 | NETIHPMS KR IS KIKE B WFATEK
Gen: 30 | Fitness: 15 | NESHLPKS KU IS KIKE B WFATEK
Gen: 31 | Fitness: 13 | NETGGNKS KU IS KIKE C WFATEK
Gen: 32 | Fitness: 12 | NETHGNJS IU IS JIKE B WFATCL
Gen: 33 | Fitness: 11 | NETIJPKS IU IS KIKE B WFATEK
Gen: 35 | Fitness: 8 | LEUIHNJS IT IS JIKE A WEATEL
Gen: 37 | Fitness: 7 | NETIHNJS IS IS LIKE B WFASEL
Gen: 38 | Fitness: 6 | NETHGNJS IT IS LIKE A WFASEK
Gen: 39 | Fitness: 4 | METGHNKS IT IS LIKE B WEATEL
Gen: 42 | Fitness: 3 | NETHINKS IT IS KIKE B WEASEL
Gen: 43 | Fitness: 2 | NETHINKS IT IS LIKE A WFASEL
Gen: 44 | Fitness: 1 | METHHNKS IT IS LIKE A WEASEL
Gen: 46 | Fitness: 0 | METHINKS IT IS LIKE A WEASEL
Elapsed time is 0.099618 seconds.

17
Task/Evolutionary-algorithm/Mathematica/evolutionary-algorithm.math Normal file
View file

@ -0,0 +1,17 @@
target = "METHINKS IT IS LIKE A WEASEL";
alphabet = Append[CharacterRange["A", "Z"], " "];
fitness = HammingDistance[target, #] &;
mutate[str_String, rate_ : 0.01] := StringReplace[
str,
_ /; RandomReal[] < rate :> RandomChoice[alphabet]
]
mutationRate = 0.02; c = 100;
NestWhileList[
First@MinimalBy[
Thread[mutate[ConstantArray[#, c], mutationRate]],
fitness
] &,
mutate[target, 1],
fitness@# > 0 &
] // ListAnimate

84
Task/Evolutionary-algorithm/Nanoquery/evolutionary-algorithm.nanoquery Normal file
View file

@ -0,0 +1,84 @@
import Nanoquery.Util
target = "METHINKS IT IS LIKE A WEASEL"
tbl = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
copies = 30
chance = 0.09
rand = new(Random)
// returns a random string of the specified length
def rand_string(length)
global tbl
global rand
ret = ""
for i in range(1, length)
ret += tbl[rand.getInt(len(tbl))]
end
return ret
end
// gets the fitness of a given string
def fitness(string)
global target
fit = 0
for i in range(0, len(string) - 1)
if string[i] != target[i]
fit -= 1
end
end
return fit
end
// mutates the specified string with a chance of 0.09 by default
def mutate(string)
global chance
global rand
global tbl
mutated = string
for i in range(0, len(mutated) - 1)
if rand.getFloat() <= chance
mutated[i] = tbl[rand.getInt(len(tbl))]
end
end
return mutated
end
// a function to find the index of the string with the best fitness
def most_fit(strlist)
global target
best_score = -(len(target) + 1)
best_index = 0
for j in range(0, len(strlist) - 1)
fit = fitness(strlist[j])
if fit > best_score
best_index = j
best_score = fit
end
end
return {best_index, best_score}
end
parent = rand_string(len(target)); iter = 1
while parent != target
children = {}
for i in range(1, 30)
children.append(mutate(parent))
end
fit = most_fit(children)
parent = children[fit[0]]
print format("iter %d, score %d: %s\n", iter, fit[1], parent)
iter += 1
end

37
Task/Evolutionary-algorithm/Nim/evolutionary-algorithm.nim Normal file
View file

@ -0,0 +1,37 @@
import random
const
Target = "METHINKS IT IS LIKE A WEASEL"
Alphabet = " ABCDEFGHIJLKLMNOPQRSTUVWXYZ"
P = 0.05
C = 100
proc negFitness(trial: string): int =
for i in 0 .. trial.high:
if Target[i] != trial[i]:
inc result
proc mutate(parent: string): string =
for c in parent:
result.add (if rand(1.0) < P: sample(Alphabet) else: c)
randomize()
var parent = ""
for _ in 1..Target.len:
parent.add sample(Alphabet)
var i = 0
while parent != Target:
var copies = newSeq[string](C)
for i in 0 .. copies.high:
copies[i] = parent.mutate()
var best = copies[0]
for i in 1 .. copies.high:
if negFitness(copies[i]) < negFitness(best):
best = copies[i]
parent = best
echo i, " ", parent
inc i

41
Task/Evolutionary-algorithm/OCaml/evolutionary-algorithm.ocaml Normal file
View file

@ -0,0 +1,41 @@
let target = "METHINKS IT IS LIKE A WEASEL"
let charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
let tlen = String.length target
let clen = String.length charset
let () = Random.self_init()
let parent =
let s = String.create tlen in
for i = 0 to tlen-1 do
s.[i] <- charset.[Random.int clen]
done;
s
let fitness ~trial =
let rec aux i d =
if i >= tlen then d else
aux (i+1) (if target.[i] = trial.[i] then d+1 else d) in
aux 0 0
let mutate parent rate =
let s = String.copy parent in
for i = 0 to tlen-1 do
if Random.float 1.0 > rate then
s.[i] <- charset.[Random.int clen]
done;
s, fitness s
let () =
let i = ref 0 in
while parent <> target do
let pfit = fitness parent in
let rate = float pfit /. float tlen in
let tries = Array.init 200 (fun _ -> mutate parent rate) in
let min_by (a, fa) (b, fb) = if fa > fb then a, fa else b, fb in
let best, f = Array.fold_left min_by (parent, pfit) tries in
if !i mod 100 = 0 then
Printf.printf "%5d - '%s' (fitness:%2d)\n%!" !i best f;
String.blit best 0 parent 0 tlen;
incr i
done;
Printf.printf "%5d - '%s'\n" !i parent

91
Task/Evolutionary-algorithm/Objeck/evolutionary-algorithm.objeck Normal file
View file

@ -0,0 +1,91 @@
bundle Default {
class Evolutionary {
target : static : String;
possibilities : static : Char[];
C : static : Int;
minMutateRate : static : Float;
perfectFitness : static : Int;
parent : static : String ;
rand : static : Float;
function : Init() ~ Nil {
target := "METHINKS IT IS LIKE A WEASEL";
possibilities := "ABCDEFGHIJKLMNOPQRSTUVWXYZ "->ToCharArray();
C := 100;
minMutateRate := 0.09;
perfectFitness := target->Size();
}
function : fitness(trial : String) ~ Int {
retVal := 0;
each(i : trial) {
if(trial->Get(i) = target->Get(i)) {
retVal += 1;
};
};
return retVal;
}
function : newMutateRate() ~ Float {
x : Float := perfectFitness - fitness(parent);
y : Float := perfectFitness->As(Float) * (1.01 - minMutateRate);
return x / y;
}
function : mutate(parent : String, rate : Float) ~ String {
retVal := "";
each(i : parent) {
rand := Float->Random();
if(rand <= rate) {
rand *= 1000.0;
intRand := rand->As(Int);
index : Int := intRand % possibilities->Size();
retVal->Append(possibilities[index]);
}
else {
retVal->Append(parent->Get(i));
};
};
return retVal;
}
function : Main(args : String[]) ~ Nil {
Init();
parent := mutate(target, 1.0);
iter := 0;
while(target->Equals(parent) <> true) {
rate := newMutateRate();
iter += 1;
if(iter % 100 = 0){
IO.Console->Instance()->Print(iter)->Print(": ")->PrintLine(parent);
};
bestSpawn : String;
bestFit := 0;
for(i := 0; i < C; i += 1;) {
spawn := mutate(parent, rate);
fitness := fitness(spawn);
if(fitness > bestFit) {
bestSpawn := spawn;
bestFit := fitness;
};
};
if(bestFit > fitness(parent)) {
parent := bestSpawn;
};
};
parent->PrintLine();
}
}
}
}

52
Task/Evolutionary-algorithm/Octave/evolutionary-algorithm.octave Normal file
View file

@ -0,0 +1,52 @@
global target;
target = split("METHINKS IT IS LIKE A WEASEL", "");
charset = ["A":"Z", " "];
p = ones(length(charset), 1) ./ length(charset);
parent = discrete_rnd(charset, p, length(target), 1);
mutaterate = 0.1;
C = 1000;
function r = fitness(parent, target)
r = sum(parent == target) ./ length(target);
endfunction
function r = mutate(parent, mutaterate, charset)
r = parent;
p = unifrnd(0, 1, length(parent), 1);
nmutants = sum( p < mutaterate );
if (nmutants)
s = discrete_rnd(charset, ones(length(charset), 1) ./ length(charset),nmutants,1);
r( p < mutaterate ) = s;
endif
endfunction
function r = evolve(parent, mutatefunc, fitnessfunc, C, mutaterate, charset)
global target;
children = [];
for i = 1:C
children = [children, mutatefunc(parent, mutaterate, charset)];
endfor
children = [parent, children];
fitval = [];
for i = 1:columns(children)
fitval = [fitval, fitnessfunc(children(:,i), target)];
endfor
[m, im] = max(fitval);
r = children(:, im);
endfunction
function printgen(p, t, i)
printf("%3d %5.2f %s\n", i, fitness(p, t), p');
endfunction
i = 0;
while( !all(parent == target) )
i++;
parent = evolve(parent, @mutate, @fitness, C, mutaterate, charset);
if ( mod(i, 1) == 0 )
printgen(parent, target, i);
endif
endwhile
disp(parent');

20
Task/Evolutionary-algorithm/Oforth/evolutionary-algorithm.fth Normal file
View file

@ -0,0 +1,20 @@
200 Constant new: C
5 Constant new: RATE
: randChar // -- c
27 rand dup 27 == ifTrue: [ drop ' ' ] else: [ 'A' + 1- ] ;
: fitness(a b -- n)
a b zipWith(#==) sum ;
: mutate(s -- s')
s map(#[ 100 rand RATE <= ifTrue: [ drop randChar ] ]) charsAsString ;
: evolve(target)
| parent |
ListBuffer init(target size, #randChar) charsAsString ->parent
1 while ( parent target <> ) [
ListBuffer init(C, #[ parent mutate ]) dup add(parent)
maxFor(#[ target fitness ]) dup ->parent . dup println 1+
] drop ;

54
Task/Evolutionary-algorithm/OoRexx/evolutionary-algorithm.rexx Normal file
View file

@ -0,0 +1,54 @@
/* Weasel.rex - Me thinks thou art a weasel. - G,M.D. - 2/25/2011 */
arg C M
/* C is the number of children parent produces each generation. */
/* M is the mutation rate of each gene (character) */
call initialize
generation = 0
do until parent = target
most_fitness = fitness(parent)
most_fit = parent
do C
child = mutate(parent, M)
child_fitness = fitness(child)
if child_fitness > most_fitness then
do
most_fitness = child_fitness
most_fit = child
say "Generation" generation": most fit='"most_fit"', fitness="left(most_fitness,4)
end
end
parent = most_fit
generation = generation + 1
end
exit
initialize:
target = "METHINKS IT IS LIKE A WEASEL"
alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
c_length_target = length(target)
parent = mutate(copies(" ", c_length_target), 1.0)
do i = 1 to c_length_target
target_ch.i = substr(target,i,1)
end
return
fitness: procedure expose target_ch. c_length_target
arg parm_string
fitness = 0
do i_target = 1 to c_length_target
if substr(parm_string,i_target,1) = target_ch.i_target then
fitness = fitness + 1
end
return fitness
mutate:procedure expose alphabet
arg string, parm_mutation_rate
result = ""
do istr = 1 to length(string)
if random(1,1000)/1000 <= parm_mutation_rate then
result = result || substr(alphabet,random(1,length(alphabet)),1)
else
result = result || substr(string,istr,1)
end
return result

39
Task/Evolutionary-algorithm/OxygenBasic/evolutionary-algorithm.basic Normal file
View file

@ -0,0 +1,39 @@
'EVOLUTION
target="METHINKS IT IS LIKE A WEASEL"
le=len target
progeny=string le,"X"
quad seed
declare QueryPerformanceCounter lib "kernel32.dll" (quad*q)
QueryPerformanceCounter seed
Function Rand(sys max) as sys
mov eax,max
inc eax
imul edx,seed,0x8088405
inc edx
mov seed,edx
mul edx
return edx
End Function
sys ls=le-1,cp=0,ct=0,ch=0,fit=0,gens=0
do '1 mutation per generation
i=1+rand ls 'mutation position
ch=64+rand 26 'mutation ascii code
if ch=64 then ch=32 'change '@' to ' '
ct=asc target,i 'target ascii code
cp=asc progeny,i 'parent ascii code
'
if ch=ct then
if cp<>ct then
mid progeny,i,chr ch 'carry improvement
fit++ 'increment fitness
end if
end if
gens++
if fit=le then exit do 'matches target
end do
print progeny " " gens 'RESULT (range 1200-6000 generations)

60
Task/Evolutionary-algorithm/Oz/evolutionary-algorithm.oz Normal file
View file

@ -0,0 +1,60 @@
declare
Target = "METHINKS IT IS LIKE A WEASEL"
C = 100
MutateRate = 5 %% percent
proc {Main}
X0 = {MakeN {Length Target} RandomChar}
in
for Xi in {Iterate Evolve X0} break:Break do
{System.showInfo Xi}
if Xi == Target then {Break} end
end
end
fun {Evolve Xi}
Copies = {MakeN C fun {$} {Mutate Xi} end}
in
{FoldL Copies MaxByFitness Xi}
end
fun {Mutate Xs}
{Map Xs
fun {$ X}
if {OS.rand} mod 100 < MutateRate then {RandomChar}
else X
end
end}
end
fun {MaxByFitness A B}
if {Fitness B} > {Fitness A} then B else A end
end
fun {Fitness Candidate}
{Length {Filter {List.zip Candidate Target Value.'=='} Id}}
end
Alphabet = & |{List.number &A &Z 1}
fun {RandomChar}
I = {OS.rand} mod {Length Alphabet} + 1
in
{Nth Alphabet I}
end
%% General purpose helpers
fun {Id X} X end
fun {MakeN N F}
Xs = {List.make N}
in
{ForAll Xs F}
Xs
end
fun lazy {Iterate F X}
X|{Iterate F {F X}}
end
in
{Main}

46
Task/Evolutionary-algorithm/PARI-GP/evolutionary-algorithm.parigp Normal file
View file

@ -0,0 +1,46 @@
target="METHINKS IT IS LIKE A WEASEL";
fitness(s)=-dist(Vec(s),Vec(target));
dist(u,v)=sum(i=1,min(#u,#v),u[i]!=v[i])+abs(#u-#v);
letter()=my(r=random(27)); if(r==26, " ", Strchr(r+65));
insert(v,x=letter())=
{
my(r=random(#v+1));
if(r==0, return(concat([x],v)));
if(r==#v, return(concat(v,[x])));
concat(concat(v[1..r],[x]),v[r+1..#v]);
}
delete(v)=
{
if(#v<2, return([]));
my(r=random(#v)+1);
if(r==1, return(v[2..#v]));
if(r==#v, return(v[1..#v-1]));
concat(v[1..r-1],v[r+1..#v]);
}
mutate(s,rateM,rateI,rateD)=
{
my(v=Vec(s));
if(random(1.)<rateI, v=insert(v));
if(random(1.)<rateD, v=delete(v));
for(i=1,#v,
if(random(1.)<rateM, v[i]=letter())
);
concat(v);
}
evolve(C,rate)=
{
my(parent=concat(vector(#target,i,letter())),ct=0);
while(parent != target,
print(parent" "fitness(parent));
my(v=vector(C,i,mutate(parent,rate,0,0)),best,t);
best=fitness(parent=v[1]);
for(i=2,C,
t=fitness(v[i]);
if(t>best, best=t; parent=v[i])
);
ct++
);
print(parent" "fitness(parent));
ct;
}
evolve(35,.05)

45
Task/Evolutionary-algorithm/PHP/evolutionary-algorithm.php Normal file
View file

@ -0,0 +1,45 @@
define('TARGET','METHINKS IT IS LIKE A WEASEL');
define('TBL','ABCDEFGHIJKLMNOPQRSTUVWXYZ ');
define('MUTATE',15);
define('COPIES',30);
define('TARGET_COUNT',strlen(TARGET));
define('TBL_COUNT',strlen(TBL));
// Determine number of different chars between a and b
function unfitness($a,$b)
{
$sum=0;
for($i=0;$i<strlen($a);$i++)
if($a[$i]!=$b[$i]) $sum++;
return($sum);
}
function mutate($a)
{
$tbl=TBL;
for($i=0;$i<strlen($a);$i++) $out[$i]=mt_rand(0,MUTATE)?$a[$i]:$tbl[mt_rand(0,TBL_COUNT-1)];
return(implode('',$out));
}
$tbl=TBL;
for($i=0;$i<TARGET_COUNT;$i++) $tspec[$i]=$tbl[mt_rand(0,TBL_COUNT-1)];
$parent[0]=implode('',$tspec);
$best=TARGET_COUNT+1;
$iters=0;
do {
for($i=1;$i<COPIES;$i++) $parent[$i]=mutate($parent[0]);
for($best_i=$i=0; $i<COPIES;$i++) {
$unfit=unfitness(TARGET,$parent[$i]);
if($unfit < $best || !$i) {
$best=$unfit;
$best_i=$i;
}
}
if($best_i>0) $parent[0]=$parent[$best_i];
$iters++;
print("Generation $iters, score $best: $parent[0]\n");
} while($best);

108
Task/Evolutionary-algorithm/Pascal/evolutionary-algorithm.pas Normal file
View file

@ -0,0 +1,108 @@
PROGRAM EVOLUTION (OUTPUT);
CONST
TARGET = 'METHINKS IT IS LIKE A WEASEL';
COPIES = 100; (* 100 children in each generation. *)
RATE = 1000; (* About one character in 1000 will be a mutation. *)
TYPE
STRLIST = ARRAY [1..COPIES] OF STRING;
FUNCTION RANDCHAR : CHAR;
(* Generate a random letter or space. *)
VAR RANDNUM : INTEGER;
BEGIN
RANDNUM := RANDOM(27);
IF RANDNUM = 26 THEN
RANDCHAR := ' '
ELSE
RANDCHAR := CHR(RANDNUM + ORD('A'))
END;
FUNCTION RANDSTR (SIZE : INTEGER) : STRING;
(* Generate a random string. *)
VAR
N : INTEGER;
S : STRING;
BEGIN
S := '';
FOR N := 1 TO SIZE DO
INSERT(RANDCHAR, S, 1);
RANDSTR := S
END;
FUNCTION FITNESS (CANDIDATE, GOAL : STRING) : INTEGER;
(* Count the number of correct letters in the correct places *)
VAR N, MATCHES : INTEGER;
BEGIN
MATCHES := 0;
FOR N := 1 TO LENGTH(GOAL) DO
IF CANDIDATE[N] = GOAL[N] THEN
MATCHES := MATCHES + 1;
FITNESS := MATCHES
END;
FUNCTION MUTATE (RATE : INTEGER; S : STRING) : STRING;
(* Randomly alter a string. Characters change with probability 1/RATE. *)
VAR
N : INTEGER;
CHANGE : BOOLEAN;
BEGIN
FOR N := 1 TO LENGTH(TARGET) DO
BEGIN
CHANGE := RANDOM(RATE) = 0;
IF CHANGE THEN
S[N] := RANDCHAR
END;
MUTATE := S
END;
PROCEDURE REPRODUCE (RATE : INTEGER; PARENT : STRING; VAR CHILDREN : STRLIST);
(* Generate children with random mutations. *)
VAR N : INTEGER;
BEGIN
FOR N := 1 TO COPIES DO
CHILDREN[N] := MUTATE(RATE, PARENT)
END;
FUNCTION FITTEST(CHILDREN : STRLIST; GOAL : STRING) : STRING;
(* Measure the fitness of each child and return the fittest. *)
(* If multiple children equally match the target, then return the first. *)
VAR
MATCHES, MOST_MATCHES, BEST_INDEX, N : INTEGER;
BEGIN
MOST_MATCHES := 0;
BEST_INDEX := 1;
FOR N := 1 TO COPIES DO
BEGIN
MATCHES := FITNESS(CHILDREN[N], GOAL);
IF MATCHES > MOST_MATCHES THEN
BEGIN
MOST_MATCHES := MATCHES;
BEST_INDEX := N
END
END;
FITTEST := CHILDREN[BEST_INDEX]
END;
VAR
PARENT, BEST_CHILD : STRING;
CHILDREN : STRLIST;
GENERATIONS : INTEGER;
BEGIN
RANDOMIZE;
GENERATIONS := 0;
PARENT := RANDSTR(LENGTH(TARGET));
WHILE NOT (PARENT = TARGET) DO
BEGIN
IF (GENERATIONS MOD 100) = 0 THEN WRITELN(PARENT);
GENERATIONS := GENERATIONS + 1;
REPRODUCE(RATE, PARENT, CHILDREN);
BEST_CHILD := FITTEST(CHILDREN, TARGET);
IF FITNESS(PARENT, TARGET) < FITNESS(BEST_CHILD, TARGET) THEN
PARENT := BEST_CHILD
END;
WRITE('The string was matched in ');
WRITELN(GENERATIONS, ' generations.')
END.

45
Task/Evolutionary-algorithm/Perl/evolutionary-algorithm.pl Normal file
View file

@ -0,0 +1,45 @@
use List::Util 'reduce';
use List::MoreUtils 'false';
### Generally useful declarations
sub randElm
{$_[int rand @_]}
sub minBy (&@)
{my $f = shift;
reduce {$f->($b) < $f->($a) ? $b : $a} @_;}
sub zip
{@_ or return ();
for (my ($n, @a) = 0 ;; ++$n)
{my @row;
foreach (@_)
{$n < @$_ or return @a;
push @row, $_->[$n];}
push @a, \@row;}}
### Task-specific declarations
my $C = 100;
my $mutation_rate = .05;
my @target = split '', 'METHINKS IT IS LIKE A WEASEL';
my @valid_chars = (' ', 'A' .. 'Z');
sub fitness
{false {$_->[0] eq $_->[1]} zip shift, \@target;}
sub mutate
{my $rate = shift;
return [map {rand() < $rate ? randElm @valid_chars : $_} @{shift()}];}
### Main loop
my $parent = [map {randElm @valid_chars} @target];
while (fitness $parent)
{$parent =
minBy \&fitness,
map {mutate $mutation_rate, $parent}
1 .. $C;
print @$parent, "\n";}

39
Task/Evolutionary-algorithm/Phix/evolutionary-algorithm.phix Normal file
View file

@ -0,0 +1,39 @@
(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">target</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"METHINKS IT IS LIKE A WEASEL"</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">AZS</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"ABCDEFGHIJKLMNOPQRSTUVWXYZ "</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">C</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">5000</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- children in each generation</span>
<span style="color: #000000;">P</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">15</span> <span style="color: #000080;font-style:italic;">-- probability of mutation (1 in 15)</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">fitness</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">sample</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">target</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">return</span> <span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sq_eq</span><span style="color: #0000FF;">(</span><span style="color: #000000;">sample</span><span style="color: #0000FF;">,</span><span style="color: #000000;">target</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">mutate</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">rand</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">AZS</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">rand</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">AZS</span><span style="color: #0000FF;">))]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">s</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">parent</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">mutate</span><span style="color: #0000FF;">(</span><span style="color: #000000;">target</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- (mutate with 100% probability)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">samples</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">C</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">gen</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">best</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">fit</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">best_fit</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">fitness</span><span style="color: #0000FF;">(</span><span style="color: #000000;">parent</span><span style="color: #0000FF;">,</span><span style="color: #000000;">target</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">parent</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">target</span> <span style="color: #008080;">do</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Generation%3d: %s, fitness %3.2f%%\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">gen</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">parent</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">best_fit</span><span style="color: #0000FF;">/</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">target</span><span style="color: #0000FF;">))*</span><span style="color: #000000;">100</span><span style="color: #0000FF;">})</span>
<span style="color: #000000;">best_fit</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">C</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">samples</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">mutate</span><span style="color: #0000FF;">(</span><span style="color: #000000;">parent</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">P</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">fit</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">fitness</span><span style="color: #0000FF;">(</span><span style="color: #000000;">samples</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span> <span style="color: #000000;">target</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">fit</span> <span style="color: #0000FF;">></span> <span style="color: #000000;">best_fit</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">best_fit</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">fit</span>
<span style="color: #000000;">best</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">i</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000000;">parent</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">samples</span><span style="color: #0000FF;">[</span><span style="color: #000000;">best</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">gen</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Finally, \"%s\"\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">parent</span><span style="color: #0000FF;">})</span>
<!--

84
Task/Evolutionary-algorithm/Picat/evolutionary-algorithm.picat Normal file
View file

@ -0,0 +1,84 @@
go =>
_ = random2(),
Target = "METHINKS IT IS LIKE A WEASEL",
Chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ",
C = 50, % Population size in each generation
M = 80, % Mutation rate per individual in a generation (0.8)
evo(Target,Chars,C,M),
nl.
evo(Target,Chars,C,M) =>
if member(T,Target), not member(T, Chars) then
printf("The character %w is not in the character set: %w\n", T, Chars);
halt
end,
% first random string
TargetLen = Target.length,
Parent = random_chars(Chars,TargetLen),
%
% Until current fitness reaches a score of perfect match
% with the target string keep generating new populations
%
CurrentFitness = 0,
Gen = 1,
while (CurrentFitness < TargetLen)
println([gen=Gen, currentFitness=CurrentFitness, parent=Parent]),
Gen := Gen + 1,
[Parent2,CurrentFitness2] = generation(C,Chars,Target,M,Parent),
CurrentFitness := CurrentFitness2,
Parent := Parent2
end,
println([gen=Gen, currentFitness=CurrentFitness, parent=Parent]),
printf("\nFound a perfect fitness (%d) at generation %d\n", CurrentFitness, Gen),
nl.
%
% Generate a random string
%
random_chars(Chars, N) = [Chars[my_rand(Len)] : _ in 1..N] =>
Len = Chars.length.
%
% Increment the fitness for every position in the string
% S that matches the target
%
fitness(S,Target) = sum([1: I in 1..Target.length, S[I] == Target[I]]).
%
% If a random number between 1 and 100 is inside the
% bounds of mutation randomly alter a character in the string
%
mutate(S,M,Chars) = S2 =>
S2 = copy_term(S),
if my_rand(100) <= M then
S2[my_rand(S.length)] := Chars[my_rand(Chars.length)]
end.
% Get a random value between 1 and N
my_rand(N) = 1+(random() mod N).
%
% Create the next population of parent
%
generation(C,Chars,Target,M,Parent) = [NextParent,NextFitness] =>
% generate a random population
Population = [mutate(Parent,M,Chars) : _ in 1..C],
% Find the member of the population with highest fitness,
NextParent = Parent,
NextFitness = fitness(Parent,Target),
foreach(X in Population)
XF = fitness(X,Target),
if XF > NextFitness then
NextParent := X,
NextFitness := XF
end
end.

37
Task/Evolutionary-algorithm/PicoLisp/evolutionary-algorithm.l Normal file
View file

@ -0,0 +1,37 @@
(load "@lib/simul.l")
(setq *Target (chop "METHINKS IT IS LIKE A WEASEL"))
# Generate random character
(de randChar ()
(if (=0 (rand 0 26))
" "
(char (rand `(char "A") `(char "Z"))) ) )
# Fitness function (Hamming distance)
(de fitness (A)
(cnt = A *Target) )
# Genetic algorithm
(gen
(make # Parent population
(do 100 # C = 100 children
(link
(make
(do (length *Target)
(link (randChar)) ) ) ) ) )
'((A) # Termination condition
(prinl (maxi fitness A)) # Print the fittest element
(member *Target A) ) # and check if solution is found
'((A B) # Recombination function
(mapcar
'((C D) (if (rand T) C D)) # Pick one of the chars
A B ) )
'((A) # Mutation function
(mapcar
'((C)
(if (=0 (rand 0 10)) # With a proability of 10%
(randChar) # generate a new char, otherwise
C ) ) # return the current char
A ) )
fitness ) # Selection function

44
Task/Evolutionary-algorithm/Pike/evolutionary-algorithm.pike Normal file
View file

@ -0,0 +1,44 @@
string chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";
string mutate(string data, int rate)
{
array(int) alphabet=(array(int))chars;
multiset index = (multiset)enumerate(sizeof(data));
while(rate)
{
int pos = random(index);
data[pos]=random(alphabet);
rate--;
}
return data;
}
int fitness(string input, string target)
{
return `+(@`==(((array)input)[*], ((array)target)[*]));
}
void main()
{
array(string) alphabet = chars/"";
string target = "METHINKS IT IS LIKE A WEASEL";
string parent = "";
while(sizeof(parent) != sizeof(target))
{
parent += random(alphabet);
}
int count;
write(" %5d: %s\n", count, parent);
while (parent != target)
{
string child = mutate(parent, 2);
count++;
if (fitness(child, target) > fitness(parent, target))
{
write(" %5d: %s\n", count, child);
parent = child;
}
}
}

73
Task/Evolutionary-algorithm/Pony/evolutionary-algorithm-1.pony Normal file
View file

@ -0,0 +1,73 @@
use "random"
actor Main
let _env: Env
let _rand: MT = MT // Mersenne Twister
let _target: String = "METHINKS IT IS LIKE A WEASEL"
let _possibilities: String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
let _c: U16 = 100 // number of spawn per generation
let _min_mutate_rate: F64 = 0.09
let _perfect_fitness: USize = _target.size()
var _parent: String = ""
new create(env: Env) =>
_env = env
_parent = mutate(_target, 1.0)
var iter: U64 = 0
while not _target.eq(_parent) do
let rate: F64 = new_mutate_rate()
iter = iter + 1
if (iter % 100) == 0 then
_env.out.write(iter.string() + ": " + _parent)
_env.out.write(", fitness: " + fitness(_parent).string())
_env.out.print(", rate: " + rate.string())
end
var best_spawn = ""
var best_fit: USize = 0
var i: U16 = 0
while i < _c do
let spawn = mutate(_parent, rate)
let spawn_fitness = fitness(spawn)
if spawn_fitness > best_fit then
best_spawn = spawn
best_fit = spawn_fitness
end
i = i + 1
end
if best_fit > fitness(_parent) then
_parent = best_spawn
end
end
_env.out.print(_parent + ", " + iter.string())
fun fitness(trial: String): USize =>
var ret_val: USize = 0
var i: USize = 0
while i < trial.size() do
try
if trial(i)? == _target(i)? then
ret_val = ret_val + 1
end
end
i = i + 1
end
ret_val
fun new_mutate_rate(): F64 =>
let perfect_fit = _perfect_fitness.f64()
((perfect_fit - fitness(_parent).f64()) / perfect_fit) * (1.0 - _min_mutate_rate)
fun ref mutate(parent: String box, rate: F64): String =>
var ret_val = recover trn String end
for char in parent.values() do
let rnd_real: F64 = _rand.real()
if rnd_real <= rate then
let rnd_int: U64 = _rand.int(_possibilities.size().u64())
try
ret_val.push(_possibilities(rnd_int.usize())?)
end
else
ret_val.push(char)
end
end
consume ret_val

115
Task/Evolutionary-algorithm/Pony/evolutionary-algorithm-2.pony Normal file
View file

@ -0,0 +1,115 @@
use "random"
use "collections"
class CreationFactory
let _desired: String
new create(d: String) =>
_desired = d
fun apply(c: String): Creation =>
Creation(c, _fitness(c))
fun _fitness(s: String): USize =>
var f = USize(0)
for i in Range(0, s.size()) do
try
if s(i)? == _desired(i)? then
f = f +1
end
end
end
f
class val Creation
let string: String
let fitness: USize
new val create(s: String = "", f: USize = 0) =>
string = s
fitness = f
class Mutator
embed _rand: MT = MT
let _possibilities: String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
let _cf: CreationFactory
new create(cf: CreationFactory) =>
_cf = cf
fun ref apply(parent: Creation, rate: F64): Creation =>
let ns = _new_string(parent.string, rate)
_cf(ns)
fun ref _new_string(parent: String, rate: F64): String =>
var mutated = recover String(parent.size()) end
for char in parent.values() do
mutated.push(_mutate_letter(char, rate))
end
consume mutated
fun ref _mutate_letter(current: U8, rate: F64): U8 =>
if _rand.real() <= rate then
_random_letter()
else
current
end
fun ref _random_letter(): U8 =>
let ln = _rand.int(_possibilities.size().u64()).usize()
try _possibilities(ln)? else ' ' end
class Generation
let _size: USize
let _desired: Creation
let _mutator: Mutator
new create(size: USize = 100, desired: Creation, mutator: Mutator) =>
_size = size
_desired = desired
_mutator = consume mutator
fun ref apply(parent: Creation): Creation =>
var best = parent
let mutation_rate = _mutation_rate(best)
for i in Range(0, _size) do
let candidate = _mutator(best, mutation_rate)
if candidate.fitness > best.fitness then
best = candidate
end
end
best
fun _mutation_rate(best: Creation): F64 =>
let min_mutate_rate: F64 = 0.09
let df = _desired.fitness.f64()
let bf = best.fitness.f64()
((df - bf) / df) * (1.0 - min_mutate_rate)
actor Main
new create(env: Env) =>
let d = "METHINKS IT IS LIKE A WEASEL"
let cf = CreationFactory(d)
let desired = cf(d)
let mutator = Mutator(cf)
let start = mutator(desired, 1.0)
let spawn_per_generation = USize(100)
var iterations = U64(0)
var best = start
repeat
best = Generation(spawn_per_generation, desired, mutator)(best)
iterations = iterations + 1
if (iterations % 100) == 0 then
env.out.print(
iterations.string() + ": "
+ best.string + ", fitness: " + best.fitness.string()
)
end
until best.string == desired.string end
env.out.print(best.string + ", " + iterations.string())

32
Task/Evolutionary-algorithm/Prolog/evolutionary-algorithm.pro Normal file
View file

@ -0,0 +1,32 @@
target("METHINKS IT IS LIKE A WEASEL").
rndAlpha(64, 32). % Generate a single random character
rndAlpha(P, P). % 32 is a space, and 65->90 are upper case
rndAlpha(Ch) :- random(N), P is truncate(64+(N*27)), !, rndAlpha(P, Ch).
rndTxt(0, []). % Generate some random text (fixed length)
rndTxt(Len, [H|T]) :- succ(L, Len), rndAlpha(H), !, rndTxt(L, T).
score([], [], Score, Score). % Score a generated mutation (count diffs)
score([Ht|Tt], [Ht|Tp], C, Score) :- !, score(Tt, Tp, C, Score).
score([_|Tt], [_|Tp], C, Score) :- succ(C, N), !, score(Tt, Tp, N, Score).
score(Txt, Score, Target) :- !, score(Target, Txt, 0, Score).
mutate(_, [], []). % mutate(Probability, Input, Output)
mutate(P, [H|Txt], [H|Mut]) :- random(R), R < P, !, mutate(P, Txt, Mut).
mutate(P, [_|Txt], [M|Mut]) :- rndAlpha(M), !, mutate(P, Txt, Mut).
weasel(Tries, _, _, mutation(0, Result)) :- % No differences=success
format('~w~4|:~w~3| - ~s\n', [Tries, 0, Result]).
weasel(Tries, Chance, Target, mutation(S, Value)) :- % output progress
format('~w~4|:~w~3| - ~s\n', [Tries, S, Value]), !, % and call again
weasel(Tries, Chance, Target, Value).
weasel(Tries, Chance, Target, Start) :-
findall(mutation(S,M), % Generate 30 mutations, select the best.
(between(1, 30, _), mutate(Chance, Start, M), score(M,S,Target)),
Mutations), % List of 30 mutations and their scores
sort(Mutations, [Best|_]), succ(Tries, N),
!, weasel(N, Chance, Target, Best).
weasel :- % Chance->probability for a mutation, T=Target, Start=initial text
target(T), length(T, Len), rndTxt(Len, Start), Chance is 1 - (1/(Len+1)),
!, weasel(0, Chance, T, Start).

71
Task/Evolutionary-algorithm/PureBasic/evolutionary-algorithm.basic Normal file
View file

@ -0,0 +1,71 @@
Define population = 100, mutationRate = 6
Define.s target$ = "METHINKS IT IS LIKE A WEASEL"
Define.s charSet$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
Procedure.i fitness(Array aspirant.c(1), Array target.c(1))
Protected i, len, fit
len = ArraySize(aspirant())
For i = 0 To len
If aspirant(i) = target(i): fit +1: EndIf
Next
ProcedureReturn fit
EndProcedure
Procedure mutatae(Array parent.c(1), Array child.c(1), Array charSetA.c(1), rate.i)
Protected i, L, maxC
L = ArraySize(child())
maxC = ArraySize(charSetA())
For i = 0 To L
If Random(100) < rate
child(i) = charSetA(Random(maxC))
Else
child(i) = parent(i)
EndIf
Next
EndProcedure
Procedure.s cArray2string(Array A.c(1))
Protected S.s, len
len = ArraySize(A())+1 : S = Space(len)
CopyMemory(@A(0), @S, len * SizeOf(Character))
ProcedureReturn S
EndProcedure
Define mutationRate, maxChar, target_len, i, maxfit, gen, fit, bestfit
Dim targetA.c(Len(target$) - 1)
CopyMemory(@target$, @targetA(0), StringByteLength(target$))
Dim charSetA.c(Len(charSet$) - 1)
CopyMemory(@charSet$, @charSetA(0), StringByteLength(charSet$))
maxChar = Len(charSet$) - 1
maxfit = Len(target$)
target_len = Len(target$) - 1
Dim parent.c(target_len)
Dim child.c(target_len)
Dim Bestchild.c(target_len)
For i = 0 To target_len
parent(i) = charSetA(Random(maxChar))
Next
fit = fitness (parent(), targetA())
OpenConsole()
PrintN(Str(gen) + ": " + cArray2string(parent()) + ": Fitness= " + Str(fit) + "/" + Str(maxfit))
While bestfit <> maxfit
gen + 1
For i = 1 To population
mutatae(parent(),child(),charSetA(), mutationRate)
fit = fitness (child(), targetA())
If fit > bestfit
bestfit = fit: CopyArray(child(), Bestchild())
EndIf
Next
CopyArray(Bestchild(), parent())
PrintN(Str(gen) + ": " + cArray2string(parent()) + ": Fitness= " + Str(bestfit) + "/" + Str(maxfit))
Wend
PrintN("Press any key to exit"): Repeat: Until Inkey() <> ""

47
Task/Evolutionary-algorithm/Python/evolutionary-algorithm-1.py Normal file
View file

@ -0,0 +1,47 @@
from string import letters
from random import choice, random
target = list("METHINKS IT IS LIKE A WEASEL")
charset = letters + ' '
parent = [choice(charset) for _ in range(len(target))]
minmutaterate = .09
C = range(100)
perfectfitness = float(len(target))
def fitness(trial):
'Sum of matching chars by position'
return sum(t==h for t,h in zip(trial, target))
def mutaterate():
'Less mutation the closer the fit of the parent'
return 1-((perfectfitness - fitness(parent)) / perfectfitness * (1 - minmutaterate))
def mutate(parent, rate):
return [(ch if random() <= rate else choice(charset)) for ch in parent]
def que():
'(from the favourite saying of Manuel in Fawlty Towers)'
print ("#%-4i, fitness: %4.1f%%, '%s'" %
(iterations, fitness(parent)*100./perfectfitness, ''.join(parent)))
def mate(a, b):
place = 0
if choice(xrange(10)) < 7:
place = choice(xrange(len(target)))
else:
return a, b
return a, b, a[:place] + b[place:], b[:place] + a[place:]
iterations = 0
center = len(C)/2
while parent != target:
rate = mutaterate()
iterations += 1
if iterations % 100 == 0: que()
copies = [ mutate(parent, rate) for _ in C ] + [parent]
parent1 = max(copies[:center], key=fitness)
parent2 = max(copies[center:], key=fitness)
parent = max(mate(parent1, parent2), key=fitness)
que()

21
Task/Evolutionary-algorithm/Python/evolutionary-algorithm-2.py Normal file
View file

@ -0,0 +1,21 @@
from random import choice, random
target = list("METHINKS IT IS LIKE A WEASEL")
alphabet = " ABCDEFGHIJLKLMNOPQRSTUVWXYZ"
p = 0.05 # mutation probability
c = 100 # number of children in each generation
def neg_fitness(trial):
return sum(t != h for t,h in zip(trial, target))
def mutate(parent):
return [(choice(alphabet) if random() < p else ch) for ch in parent]
parent = [choice(alphabet) for _ in xrange(len(target))]
i = 0
print "%3d" % i, "".join(parent)
while parent != target:
copies = (mutate(parent) for _ in xrange(c))
parent = min(copies, key=neg_fitness)
print "%3d" % i, "".join(parent)
i += 1

52
Task/Evolutionary-algorithm/R/evolutionary-algorithm-1.r Normal file
View file

@ -0,0 +1,52 @@
set.seed(1234, kind="Mersenne-Twister")
## Easier if the string is a character vector
target <- unlist(strsplit("METHINKS IT IS LIKE A WEASEL", ""))
charset <- c(LETTERS, " ")
parent <- sample(charset, length(target), replace=TRUE)
mutaterate <- 0.01
## Number of offspring in each generation
C <- 100
## Hamming distance between strings normalized by string length is used
## as the fitness function.
fitness <- function(parent, target) {
sum(parent == target) / length(target)
}
mutate <- function(parent, rate, charset) {
p <- runif(length(parent))
nMutants <- sum(p < rate)
if (nMutants) {
parent[ p < rate ] <- sample(charset, nMutants, replace=TRUE)
}
parent
}
evolve <- function(parent, mutate, fitness, C, mutaterate, charset) {
children <- replicate(C, mutate(parent, mutaterate, charset),
simplify=FALSE)
children <- c(list(parent), children)
children[[which.max(sapply(children, fitness, target=target))]]
}
.printGen <- function(parent, target, gen) {
cat(format(i, width=3),
formatC(fitness(parent, target), digits=2, format="f"),
paste(parent, collapse=""), "\n")
}
i <- 0
.printGen(parent, target, i)
while ( ! all(parent == target)) {
i <- i + 1
parent <- evolve(parent, mutate, fitness, C, mutaterate, charset)
if (i %% 20 == 0) {
.printGen(parent, target, i)
}
}
.printGen(parent, target, i)

34
Task/Evolutionary-algorithm/R/evolutionary-algorithm-2.r Normal file
View file

@ -0,0 +1,34 @@
# Setup
set.seed(42)
target= unlist(strsplit("METHINKS IT IS LIKE A WEASEL", ""))
chars= c(LETTERS, " ")
C= 100
# Fitness function; high value means higher fitness
fitness= function(x){
sum(x == target)
}
# Mutate function
mutate= function(x, rate= 0.01){
idx= which(runif(length(target)) <= rate)
x[idx]= replicate(n= length(idx), expr= sample(x= chars, size= 1, replace= T))
x
}
# Evolve function
evolve= function(x){
parents= rep(list(x), C+1) # Repliction
parents[1:C]= lapply(parents[1:C], function(x) mutate(x)) # Mutation
idx= which.max(lapply(parents, function(x) fitness(x))) # Selection
parents[[idx]]
}
# Initialize first parent
parent= sample(x= chars, size= length(target), replace= T)
# Main program
while (fitness(parent) < fitness(target)) {
parent= evolve(parent)
cat(paste0(parent, collapse=""), "\n")
}

33
Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-1.rexx Normal file
View file

@ -0,0 +1,33 @@
/*REXX program demonstrates an evolutionary algorithm (by using mutation). */
parse arg children MR seed . /*get optional arguments from the C.L. */
if children=='' | children=="," then children=10 /*# children produced each generation. */
if MR =='' | MR =="," then MR= "4%" /*the character Mutation Rate each gen.*/
if right(MR,1)=='%' then MR= strip(MR,,"%")/100 /*expressed as a percent? Then adjust.*/
if seed\=='' then call random ,,seed /*SEED allow the runs to be repeatable.*/
abc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ ' ; Labc= length(abc)
target= 'METHINKS IT IS LIKE A WEASEL' ; Ltar= length(target)
parent= mutate( left('', Ltar), 1) /*gen rand string,same length as target*/
say center('target string', Ltar, "─") 'children' "mutationRate"
say target center(children, 8) center((MR*100/1)'%', 12); say
say center('new string' ,Ltar, "─") "closeness" 'generation'
do gen=0 until parent==target; close= fitness(parent)
almost= parent
do children; child= mutate(parent,MR)
_= fitness(child); if _<=close then iterate
close= _; almost= child
say almost right(close, 9) right(gen, 10)
end /*children*/
parent= almost
end /*gen*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fitness: parse arg x; $=0; do k=1 for Ltar; $= $+(substr(x,k,1)==substr(target,k,1)); end
return $
/*──────────────────────────────────────────────────────────────────────────────────────*/
mutate: parse arg x,rate; $= /*set X to 1st argument, RATE to 2nd.*/
do j=1 for Ltar; r= random(1, 100000) /*REXX's max for RANDOM*/
if .00001*r<=rate then $= $ || substr(abc, r//Labc+1, 1)
else $= $ || substr(x , j , 1)
end /*j*/
return $

40
Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-2.rexx Normal file
View file

@ -0,0 +1,40 @@
/*REXX program demonstrates an evolutionary algorithm (by using mutation). */
parse arg children MR seed . /*get optional arguments from the C.L. */
if children=='' | children=="," then children=10 /*# children produced each generation. */
if MR =='' | MR =="," then MR= "4%" /*the character Mutation Rate each gen.*/
if right(MR,1)=='%' then MR= strip(MR,,"%")/100 /*expressed as a percent? Then adjust.*/
if seed\=='' then call random ,,seed /*SEED allow the runs to be repeatable.*/
abc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '; Labc= length(abc)
do i=0 for Labc; @.i= substr(abc, i+1, 1) /*define array (for faster compare), */
end /*i*/ /*than picking one from a char string. */
target= 'METHINKS IT IS LIKE A WEASEL' ; Ltar= length(target)
do j=1 for Ltar; T.j= substr(target, j, 1) /*define an array (for faster compare),*/
end /*j*/ /*faster than a byte-by-byte compare. */
parent= mutate( left('', Ltar), 1) /*gen rand string, same length as tar. */
say center('target string', Ltar, "─") 'children' "mutationRate"
say target center(children, 8) center( (MR*100/1)'%', 12); say
say center('new string' , Ltar, "─") 'closeness' "generation"
do gen=0 until parent==target; close= fitness(parent)
almost= parent
do children; child= mutate(parent, MR)
_= fitness(child); if _<=close then iterate
close= _; almost= child
say almost right(close, 9) right(gen, 10)
end /*children*/
parent= almost
end /*gen*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fitness: parse arg x; $=0; do k=1 for Ltar; $=$+(substr(x,k,1)==T.k); end; return $
/*──────────────────────────────────────────────────────────────────────────────────────*/
mutate: parse arg x,rate /*set X to 1st argument, RATE to 2nd.*/
$=; do m=1 for Ltar; r=random(1, 100000) /*REXX's max for RANDOM*/
if .00001*r<=rate then do; _= r//Labc; $= $ || @._; end
else $= $ || substr(x, m, 1)
end /*m*/
return $

37
Task/Evolutionary-algorithm/Racket/evolutionary-algorithm.rkt Normal file
View file

@ -0,0 +1,37 @@
#lang racket
(define alphabet " ABCDEFGHIJKLMNOPQRSTUVWXYZ")
(define (randch) (string-ref alphabet (random 27)))
(define (fitness s1 s2)
(for/sum ([c1 (in-string s1)] [c2 (in-string s2)])
(if (eq? c1 c2) 1 0)))
(define (mutate s P)
(define r (string-copy s))
(for ([i (in-range (string-length r))] #:when (<= (random) P))
(string-set! r i (randch)))
r)
(define (evolution target C P)
(let loop ([parent (mutate target 1.0)] [n 0])
;; (printf "~a: ~a\n" n parent)
(if (equal? parent target)
n
(let cloop ([children (for/list ([i (in-range C)]) (mutate parent P))]
[best #f] [fit -1])
(if (null? children)
(loop best (add1 n))
(let ([f (fitness target (car children))])
(if (> f fit)
(cloop (cdr children) (car children) f)
(cloop (cdr children) best fit))))))))
;; Some random experiment using all of this
(define (try-run C P)
(define ns
(for/list ([i 10])
(evolution "METHINKS IT IS LIKE A WEASEL" C P)))
(printf "~s Average generation: ~s\n" C (/ (apply + 0.0 ns) (length ns)))
(printf "~s Total strings: ~s\n" C (for/sum ([n ns]) (* n 50))))
(for ([C (in-range 10 501 10)]) (try-run C 0.001))

12
Task/Evolutionary-algorithm/Raku/evolutionary-algorithm.raku Normal file
View file

@ -0,0 +1,12 @@
constant target = "METHINKS IT IS LIKE A WEASEL";
constant @alphabet = flat 'A'..'Z',' ';
constant C = 10;
sub mutate(Str $string, Real $mutate-chance where 0 ≤ * < 1) {
$string.subst: /<?{ rand < $mutate-chance }> . /, @alphabet.pick, :global
}
sub fitness(Str $string) { [+] $string.comb Zeq target.comb }
printf "\r%6d: '%s'", $++, $_ for
@alphabet.roll(target.chars).join,
{ max :by(&fitness), mutate($_, .001) xx C } ... target;

56
Task/Evolutionary-algorithm/Red/evolutionary-algorithm.red Normal file
View file

@ -0,0 +1,56 @@
Red[]
; allowed characters
alphabet: "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
; target string
target: "METHINKS IT IS LIKE A WEASEL"
; parameter controlling the number of children
C: 10
; parameter controlling the evolution rate
RATE: 0.05
; compute closeness of 'string' to 'target'
fitness: function [string] [
sum: 0
repeat i length? string [
if not-equal? pick string i pick target i [
sum: sum + 1
]
]
sum
]
; return copy of 'string' with mutations, frequency based on given 'rate'
mutate: function [string rate] [
result: copy string
repeat i length? result [
if rate > random 1.0 [
poke result i random/only alphabet
]
]
result
]
; create initial random parent
parent: ""
repeat i length? target [
append parent random/only alphabet
]
; main loop, displaying progress
while [not-equal? parent target] [
print parent
children: copy []
repeat i C [
append children mutate parent RATE
]
sort/compare children function [a b] [lesser? fitness a fitness b]
parent: pick children 1
]
print parent

57
Task/Evolutionary-algorithm/Ring/evolutionary-algorithm.ring Normal file
View file

@ -0,0 +1,57 @@
# Project : Evolutionary algorithm
target = "METHINKS IT IS LIKE A WEASEL"
parent = "IU RFSGJABGOLYWF XSMFXNIABKT"
num = 0
mutationrate = 0.5
children = len(target)
child = list(children)
while parent != target
bestfitness = 0
bestindex = 0
for index = 1 to children
child[index] = mutate(parent, mutationrate)
fitness = fitness(target, child[index])
if fitness > bestfitness
bestfitness = fitness
bestindex = index
ok
next
if bestindex > 0
parent = child[bestindex]
num = num + 1
see "" + num + ": " + parent + nl
ok
end
func fitness(text, ref)
f = 0
for i = 1 to len(text)
if substr(text, i, 1) = substr(ref, i, 1)
f = f + 1
ok
next
return (f / len(text))
func mutate(text, rate)
rnd = randomf()
if rate > rnd
c = 63+random(27)
if c = 64
c = 32
ok
rnd2 = random(len(text))
if rnd2 > 0
text[rnd2] = char(c)
ok
ok
return text
func randomf()
decimals(10)
str = "0."
for i = 1 to 10
nr = random(9)
str = str + string(nr)
next
return number(str)

39
Task/Evolutionary-algorithm/Ruby/evolutionary-algorithm.rb Normal file
View file

@ -0,0 +1,39 @@
@target = "METHINKS IT IS LIKE A WEASEL"
Charset = [" ", *"A".."Z"]
COPIES = 100
def random_char; Charset.sample end
def fitness(candidate)
sum = 0
candidate.chars.zip(@target.chars) {|x,y| sum += (x[0].ord - y[0].ord).abs}
100.0 * Math.exp(Float(sum) / -10.0)
end
def mutation_rate(candidate)
1.0 - Math.exp( -(100.0 - fitness(candidate)) / 400.0)
end
def mutate(parent, rate)
parent.each_char.collect {|ch| rand <= rate ? random_char : ch}.join
end
def log(iteration, rate, parent)
puts "%4d %.2f %5.1f %s" % [iteration, rate, fitness(parent), parent]
end
iteration = 0
parent = Array.new(@target.length) {random_char}.join
prev = ""
while parent != @target
iteration += 1
rate = mutation_rate(parent)
if prev != parent
log(iteration, rate, parent)
prev = parent
end
copies = [parent] + Array.new(COPIES) {mutate(parent, rate)}
parent = copies.max_by {|c| fitness(c)}
end
log(iteration, rate, parent)

101
Task/Evolutionary-algorithm/Rust/evolutionary-algorithm.rust Normal file
View file

@ -0,0 +1,101 @@
//! Author : Thibault Barbie
//!
//! A simple evolutionary algorithm written in Rust.
extern crate rand;
use rand::Rng;
fn main() {
let target = "METHINKS IT IS LIKE A WEASEL";
let copies = 100;
let mutation_rate = 20; // 1/20 = 0.05 = 5%
let mut rng = rand::weak_rng();
// Generate first sentence, mutating each character
let start = mutate(&mut rng, target, 1); // 1/1 = 1 = 100%
println!("{}", target);
println!("{}", start);
evolve(&mut rng, target, start, copies, mutation_rate);
}
/// Evolution algorithm
///
/// Evolves `parent` to match `target`. Returns the number of evolutions performed.
fn evolve<R: Rng>(
rng: &mut R,
target: &str,
mut parent: String,
copies: usize,
mutation_rate: u32,
) -> usize {
let mut counter = 0;
let mut parent_fitness = target.len() + 1;
loop {
counter += 1;
let (best_fitness, best_sentence) = (0..copies)
.map(|_| {
// Copy and mutate a new sentence.
let sentence = mutate(rng, &parent, mutation_rate);
// Find the fitness of the new mutation
(fitness(target, &sentence), sentence)
})
.min_by_key(|&(f, _)| f) // find the closest mutation to the target
.unwrap(); // fails if `copies == 0`
// If the best mutation of this generation is better than `parent` then "the fittest
// survives" and the next parent becomes the best of this generation.
if best_fitness < parent_fitness {
parent = best_sentence;
parent_fitness = best_fitness;
println!(
"{} : generation {} with fitness {}",
parent, counter, best_fitness
);
if best_fitness == 0 {
return counter;
}
}
}
}
/// Computes the fitness of a sentence against a target string, returning the number of
/// incorrect characters.
fn fitness(target: &str, sentence: &str) -> usize {
sentence
.chars()
.zip(target.chars())
.filter(|&(c1, c2)| c1 != c2)
.count()
}
/// Mutation algorithm.
///
/// It mutates each character of a string, according to a `mutation_rate`.
fn mutate<R: Rng>(rng: &mut R, sentence: &str, mutation_rate: u32) -> String {
let maybe_mutate = |c| {
if rng.gen_weighted_bool(mutation_rate) {
random_char(rng)
} else {
c
}
};
sentence.chars().map(maybe_mutate).collect()
}
/// Generates a random letter or space.
fn random_char<R: Rng>(rng: &mut R) -> char {
// Returns a value in the range [A, Z] + an extra slot for the space character. (The `u8`
// values could be cast to larger integers for a better chance of the RNG hitting the proper
// range).
match rng.gen_range(b'A', b'Z' + 2) {
c if c == b'Z' + 1 => ' ', // the `char` after 'Z'
c => c as char,
}
}

Some files were not shown because too many files have changed in this diff Show more