RosettaCodeData/Task/Evolutionary-algorithm/Pascal/evolutionary-algorithm.pascal

109 lines
2.5 KiB
Plaintext

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.