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

CDE

Browse source
This commit is contained in:
Ingy döt Net 2013-04-10 16:57:12 -07:00
parent 518da4a923
commit 764da6cbbb
6144 changed files with 83610 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

13
Task/Evolutionary-algorithm/0DESCRIPTION Normal file
View file

@ -0,0 +1,13 @@
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.
Cf: [[wp:Weasel_program#Weasel_algorithm|Weasel algorithm]] and [[wp:Evolutionary algorithm|Evolutionary algorithm]]
<small>Note: to aid comparison, try and ensure the variables and functions mentioned in the task description appear in solutions</small>

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
)

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;

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.bbc 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$

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>
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;
typedef std::vector<std::string> childvec;
childvec 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";
}

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

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))))

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)

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

@ -0,0 +1,33 @@
import std.stdio, std.random, std.algorithm, std.range, std.ascii;
void evolve(string target, double prob=0.05, int C=100) {
auto chars = uppercase ~ " ";
char rndCh() { return chars[uniform(0, $)]; }
void mutate(char[] parent, char[] child) {
foreach (i, ref c; child)
c = uniform(0.0, 1.0) < prob ? rndCh() : parent[i];
}
int fitness(char[] subject, string target) {
return count!q{ a[0] != a[1] }(zip(subject, target));
}
auto parent= map!(i => rndCh())(target).array();
auto best = parent.dup;
auto child = new char[target.length];
int currDist = fitness(parent, target);
for (int gen; currDist > 0; gen++) {
foreach (_; 0 .. C) {
mutate(parent, child);
int dist = fitness(child, target);
if (dist < currDist) {
currDist = dist;
best[] = child[];
}
}
parent = best;
writefln("Generation %2s, dist=%2s: %s", gen, currDist, best);
}
}
void main() {
evolve("METHINKS IT IS LIKE A WEASEL");
}

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

@ -0,0 +1,19 @@
import std.stdio, std.random, std.algorithm, std.range;
enum target = "METHINKS IT IS LIKE A WEASEL"d;
enum C = 100; // Number of children in each generation.
enum P = 0.05; // Mutation probability.
auto alphabet = " ABCDEFGHIJLKLMNOPQRSTUVWXYZ"d.dup;
const fitness = (dchar[] s) => count!"a[0] != a[1]"(zip(s, target));
const rndc = () => alphabet[uniform(0, $)];
const mutate = (dchar[] s) =>
s.map!(a => uniform(0., 1.) < P ? rndc() : a)().array();
void main() {
auto parent = target.length.iota().map!(_ => rndc())().array();
for (int gen = 1; parent != target; gen++) {
auto offs = parent.repeat(C).map!mutate().array();
parent = offs.minPos!((a, b) => fitness(a) < fitness(b))()[0];
writefln("Gen %2d, dist=%2d: %s", gen, fitness(parent), 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()

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})

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

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) => 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

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

@ -0,0 +1,36 @@
import System
import 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

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);

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

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

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";}

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

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

@ -0,0 +1,35 @@
from string import ascii_uppercase
from random import choice, random
target = list("METHINKS IT IS LIKE A WEASEL")
charset = ascii_uppercase + ' '
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)))
iterations = 0
while parent != target:
rate = mutaterate()
iterations += 1
if iterations % 100 == 0: que()
copies = [ mutate(parent, rate) for _ in C ] + [parent]
parent = max(copies, key=fitness)
print ()
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.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)

54
Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-1.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

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

@ -0,0 +1,35 @@
/*REXX program demonstrates an evolutionary algorithm (using mutation).*/
parse arg children MR seed . /*get options (maybe) from C.L. */
if children=='' then children = 10 /*# of children produced each gen*/
if MR =='' then MR = '4%' /*the char Mutation Rate each gen*/
if right(MR,1)=='%' then MR=strip(MR,,'%')/100 /*expressed as %? Adjust*/
if seed\=='' then call random ,,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 str,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 done.*/
/*───────────────────────────────────FITNESS subroutine─────────────────*/
fitness: parse arg x; hit=0; do k=1 for Ltar
hit=hit+(substr(x,k,1)==substr(target,k,1))
end /*k*/
return hit
/*───────────────────────────────────MUTATE subroutine──────────────────*/
mutate: parse arg x,rate,? /*set ? to a null, x=string. */
do j=1 for Ltar; r=random(1,100000)
if .00001*r<=rate then ?=? || substr(abc,r//Labc+1,1)
else ?=? || substr(x,j,1)
end /*j*/
return ?

45
Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-3.rexx Normal file
View file

@ -0,0 +1,45 @@
/*REXX program demonstrates an evolutionary algorithm (using mutation).*/
parse arg children MR seed . /*get options (maybe) from C.L. */
if children=='' then children = 10 /*# of children produced each gen*/
if MR =='' then MR = "4%" /*the char Mutation Rate each gen*/
if right(MR,1)=='%' then MR=strip(MR,,"%")/100 /*expressed as %? Adjust*/
if seed\=='' then call random ,,seed /*allow the runs to be repeatable*/
abc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ ' ; Labc=length(abc)
do i=0 for Labc /*define array (faster compare), */
A.i=substr(abc, i+1, 1) /* it's better than picking out a*/
end /*i*/ /* byte from a character string. */
target= 'METHINKS IT IS LIKE A WEASEL' ; Ltar=length(target)
do i=1 for Ltar /*define array (faster compare), */
T.i=substr(target, i, 1) /*it's better than a byte-by-byte*/
end /*i*/ /*compare using character strings*/
parent= mutate( left('', Ltar), 1) /*gen rand str,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 done.*/
/*───────────────────────────────────FITNESS subroutine─────────────────*/
fitness: parse arg x; hit=0; do k=1 for Ltar
hit=hit + (substr(x,k,1) == T.k)
end /*k*/
return hit
/*───────────────────────────────────MUTATE subroutine──────────────────*/
mutate: parse arg x,rate,? /*set ? to a null, x=string. */
do j=1 for Ltar; r=random(1, 100000)
if .00001*r<=rate then do; _=r//Labc; ?=? || A._; end
else ?=? || substr(x,j,1)
end /*j*/
return ?

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

@ -0,0 +1,40 @@
@target = "METHINKS IT IS LIKE A WEASEL"
Charset = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Max_mutate_rate = 0.91
C = 100
def random_char; Charset[rand Charset.length].chr; 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(C) {mutate(parent, rate)}
parent = copies.max_by {|c| fitness(c)}
end
log iteration, rate, parent

37
Task/Evolutionary-algorithm/Scala/evolutionary-algorithm.scala Normal file
View file

@ -0,0 +1,37 @@
import scala.annotation.tailrec
case class LearnerParams(target:String,rate:Double,C:Int)
val chars = ('A' to 'Z') ++ List(' ')
val randgen = new scala.util.Random
def randchar = {
val charnum = randgen.nextInt(chars.size)
chars(charnum)
}
class RichTraversable[T](t: Traversable[T]) {
def maxBy[B](fn: T => B)(implicit ord: Ordering[B]) = t.max(ord on fn)
def minBy[B](fn: T => B)(implicit ord: Ordering[B]) = t.min(ord on fn)
}
implicit def toRichTraversable[T](t: Traversable[T]) = new RichTraversable(t)
def fitness(candidate:String)(implicit params:LearnerParams) =
(candidate zip params.target).map { case (a,b) => if (a==b) 1 else 0 }.sum
def mutate(initial:String)(implicit params:LearnerParams) =
initial.map{ samechar => if(randgen.nextDouble < params.rate) randchar else samechar }
@tailrec
def evolve(generation:Int, initial:String)(implicit params:LearnerParams){
import params._
printf("Generation: %3d %s\n",generation, initial)
if(initial == target) return ()
val candidates = for (number <- 1 to C) yield mutate(initial)
val next = candidates.maxBy(fitness)
evolve(generation+1,next)
}
implicit val params = LearnerParams("METHINKS IT IS LIKE A WEASEL",0.01,100)
val initial = (1 to params.target.size) map(x => randchar) mkString
evolve(0,initial)

116
Task/Evolutionary-algorithm/Smalltalk/evolutionary-algorithm.st Normal file
View file

@ -0,0 +1,116 @@
Object subclass: Evolution [
|target parent mutateRate c alphabet fitness|
Evolution class >> newWithRate: rate andTarget: aTarget [
|r| r := super new.
^r initWithRate: rate andTarget: aTarget.
]
initWithRate: rate andTarget: aTarget [
target := aTarget.
self mutationRate: rate.
self maxCount: 100.
self defaultAlphabet.
self changeParent.
self fitness: (self defaultFitness).
^self
]
defaultFitness [
^ [:p :t |
|t1 t2 s|
t1 := p asOrderedCollection.
t2 := t asOrderedCollection.
s := 0.
t2 do: [:e| (e == (t1 removeFirst)) ifTrue: [ s:=s+1 ] ].
s / (target size)
]
]
defaultAlphabet [ alphabet := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ ' asOrderedCollection. ]
maxCount: anInteger [ c := anInteger ]
mutationRate: aFloat [ mutateRate := aFloat ]
changeParent [
parent := self generateStringOfLength: (target size) withAlphabet: alphabet.
^ parent.
]
generateStringOfLength: len withAlphabet: ab [
|r|
r := String new.
1 to: len do: [ :i |
r := r , ((ab at: (Random between: 1 and: (ab size))) asString)
].
^r
]
fitness: aBlock [ fitness := aBlock ]
randomCollection: d [
|r| r := OrderedCollection new.
1 to: d do: [:i|
r add: (Random next)
].
^r
]
mutate [
|r p nmutants s|
r := parent copy.
p := self randomCollection: (r size).
nmutants := (p select: [ :e | (e < mutateRate)]) size.
(nmutants > 0)
ifTrue: [ |t|
s := (self generateStringOfLength: nmutants withAlphabet: alphabet) asOrderedCollection.
t := 1.
(p collect: [ :e | e < mutateRate ]) do: [ :v |
v ifTrue: [ r at: t put: (s removeFirst) ].
t := t + 1.
]
].
^r
]
evolve [
|children es mi mv|
es := self getEvolutionStatus.
children := OrderedCollection new.
1 to: c do: [ :i |
children add: (self mutate)
].
children add: es.
mi := children size.
mv := fitness value: es value: target.
children doWithIndex: [:e :i|
(fitness value: e value: target) > mv
ifTrue: [ mi := i. mv := fitness value: e value: target ]
].
parent := children at: mi.
^es "returns the parent, not the evolution"
]
printgen: i [
('%1 %2 "%3"' % {i . (fitness value: parent value: target) . parent }) displayNl
]
evoluted [ ^ target = parent ]
getEvolutionStatus [ ^ parent ]
].
|organism j|
organism := Evolution newWithRate: 0.01 andTarget: 'METHINKS IT IS LIKE A WEASEL'.
j := 0.
[ organism evoluted ]
whileFalse: [
j := j + 1.
organism evolve.
((j rem: 20) = 0) ifTrue: [ organism printgen: j ]
].
organism getEvolutionStatus displayNl.

55
Task/Evolutionary-algorithm/Tcl/evolutionary-algorithm-1.tcl Normal file
View file

@ -0,0 +1,55 @@
package require Tcl 8.5
# A function to select a random character from an argument string
proc tcl::mathfunc::randchar s {
string index $s [expr {int([string length $s]*rand())}]
}
# Set up the initial variables
set target "METHINKS IT IS LIKE A WEASEL"
set charset "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
set parent [subst [regsub -all . $target {[expr {randchar($charset)}]}]]
set MaxMutateRate 0.91
set C 100
# Work with parent and target as lists of characters so iteration is more efficient
set target [split $target {}]
set parent [split $parent {}]
# Generate the fitness *ratio*
proc fitness s {
global target
set count 0
foreach c1 $s c2 $target {
if {$c1 eq $c2} {incr count}
}
return [expr {$count/double([llength $target])}]
}
# This generates the converse of the Python version; logically saner naming
proc mutateRate {parent} {
expr {(1.0-[fitness $parent]) * $::MaxMutateRate}
}
proc mutate {rate} {
global charset parent
foreach c $parent {
lappend result [expr {rand() <= $rate ? randchar($charset) : $c}]
}
return $result
}
proc que {} {
global iterations parent
puts [format "#%-4i, fitness %4.1f%%, '%s'" \
$iterations [expr {[fitness $parent]*100}] [join $parent {}]]
}
while {$parent ne $target} {
set rate [mutateRate $parent]
if {!([incr iterations] % 100)} que
set copies [list [list $parent [fitness $parent]]]
for {set i 0} {$i < $C} {incr i} {
lappend copies [list [set copy [mutate $rate]] [fitness $copy]]
}
set parent [lindex [lsort -real -decreasing -index 1 $copies] 0 0]
}
puts ""
que

70
Task/Evolutionary-algorithm/Tcl/evolutionary-algorithm-2.tcl Normal file
View file

@ -0,0 +1,70 @@
package require Tcl 8.5
proc tcl::mathfunc::randchar {} {
# A function to select a random character
set charset "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
string index $charset [expr {int([string length $charset] * rand())}]
}
set target "METHINKS IT IS LIKE A WEASEL"
set initial [subst [regsub -all . $target {[expr randchar()]}]]
set MaxMutateRate 0.91
set C 100
# A place-wise equality function defined over two lists (assumed equal length)
proc fitnessByEquality {target s} {
set count 0
foreach c1 $s c2 $target {
if {$c1 eq $c2} {incr count}
}
return [expr {$count / double([llength $target])}]
}
# Generate the fitness *ratio* by place-wise equality with the target string
interp alias {} fitness {} fitnessByEquality [split $target {}]
# This generates the converse of the Python version; logically saner naming
proc mutationRate {individual} {
global MaxMutateRate
expr {(1.0-[fitness $individual]) * $MaxMutateRate}
}
# Mutate a string at a particular rate (per character)
proc mutate {parent rate} {
foreach c $parent {
lappend child [expr {rand() <= $rate ? randchar() : $c}]
}
return $child
}
# Pretty printer
proc prettyPrint {iterations parent} {
puts [format "#%-4i, fitness %5.1f%%, '%s'" $iterations \
[expr {[fitness $parent]*100}] [join $parent {}]]
}
# The evolutionary algorithm itself
proc evolve {initialString} {
global C
# Work with the parent as a list; the operations are more efficient
set parent [split $initialString {}]
for {set iterations 0} {[fitness $parent] < 1} {incr iterations} {
set rate [mutationRate $parent]
if {$iterations % 100 == 0} {
prettyPrint $iterations $parent
}
set copies [list [list $parent [fitness $parent]]]
for {set i 0} {$i < $C} {incr i} {
lappend copies [list \
[set copy [mutate $parent $rate]] [fitness $copy]]
}
set parent [lindex [lsort -real -decreasing -index 1 $copies] 0 0]
}
puts ""
prettyPrint $iterations $parent
return [join $parent {}]
}
evolve $initial