11
\$\begingroup\$

I've written an Erlang implementation of the genetic algorithm for a "Hello World" program as described here.

This is my first time writing any code in Erlang and also my first time writing code in a functional language, so I'd really like some feedback on whether I'm doing things the "functional" way, whether I'm doing things the Erlang way, and what useful functional/Erlang features could make this code better. I'm not interested in general programming style feedback or whether there are bugs in this implementation (I'm sure there are). I'm slightly interested in efficiency, but not too much.

Let me describe the basic algorithm for those of you who aren't planning on reading the article (I don't think you need to understand all the details to be able to review the code). The idea is to "breed" strings that closer and closer to the target string.

  1. Create a large pool of random strings of the target length.
  2. Choose four strings and pick the "fittest" two to breed (fit is defined later).
  3. Breed the two strings by either doing nothing, or by picking a point in both strings, and swapping substrings at that point.
  4. With the resulting two strings, either insert them directly into the pool of strings, or mutate them by moving a random character in the string up or down a bit, and then insert them.

With this process, eventually one of the strings will be the target string you are searching for. This depends on having a good fitness function, which I define as the sum of the difference of each character in a candidate string with the respective characters in the target string. So if a candidate string is "abc" and the target string was "acd", the first character has a difference of 0, second a difference of 1, and third a difference of one so its fitness score is 2. A lower fitness score is better.

-module(genetic).
-author("Gulshan Singh").
-export([run_genetic/1]).

-define(PoolSize, 400).
-define(CrossoverProb, 0.9).
-define(MutateProb, 0.2).

-define(MinChar, 65). %% 'A'
-define(MaxChar, 90). %% 'Z'

%% Main entry point. Produces the Target string from a pool of random strings
%% using a genetic algorithm
run_genetic(Target) ->
    random:seed(now()),
    FirstGen = create_pool(length(Target), ?PoolSize),
    io:format("Starting iteration 1~n"),
    run_genetic(FirstGen, [], Target, ?PoolSize, 0, 1).
run_genetic(_, CurrentGen, Target, ?PoolSize, ?PoolSize, Iteration) ->
    io:format("Starting iteration ~B~n", [Iteration + 1]),
    run_genetic(CurrentGen, [], Target, ?PoolSize, 0, Iteration + 1);
run_genetic(LastGen, CurrentGen, Target, ?PoolSize, Size, Iteration) ->
    {P1, P2} = choose_parents(LastGen, Target),
    io:format("Breeding ~s (~B) and ~s (~B)~n",
              [P1, fitness(P1, Target), P2, fitness(P2, Target)]),
    CrossoverProb = random:uniform(),
    if CrossoverProb =< ?CrossoverProb ->
            {Result1, Result2} = crossover(P1, P2);
       CrossoverProb > ?CrossoverProb ->
            {Result1, Result2} = {P1, P2}
    end,
    io:format("Result strings are ~s (~B) and ~s (~B)~n",
              [Result1, fitness(Result1, Target),
               Result2, fitness(Result2, Target)]),
    Finished = check_result(Result1, Target) or check_result(Result2, Target),
    case Finished of
        true -> io:format("Found result at iteration ~B~n", [Iteration]);
        false -> case MutateProb = random:uniform() of
                     MutateProb when MutateProb =< ?MutateProb ->
                         mutate(Result1),
                         mutate(Result2);
                     MutateProb when MutateProb > ?MutateProb ->
                         no_mutation
                 end,
                 run_genetic(LastGen, [Result1, Result2|CurrentGen], Target,
                             ?PoolSize, Size + 2, Iteration)
    end.

%% Returns a list of Num random strings, each of length Len
create_pool(Len, Num) ->
    create_pool(Len, Num, [], 0).
create_pool(_, Num, Pool, Num) ->
    Pool;
create_pool(Len, Num, Pool, X) ->
    S = rand_string(Len),
    create_pool(Len, Num, [S|Pool], X + 1).

%% Returns a random string of length Len
rand_string(Len) ->
    rand_string(Len, [], 0).
rand_string(Len, String, Len) ->
    String;
rand_string(Len, String, SoFar) ->
    C = random:uniform(?MaxChar - ?MinChar + 1) + ?MinChar - 1,
    rand_string(Len, [C|String], SoFar + 1).

%% Return two parents for breeding
choose_parents(Pool, Target) ->
    P1 = choose_parent(Pool, Target),
    P2 = choose_parent(Pool, Target),
    case P1 =:= P2 of
        true ->
            choose_parents(Pool, Target);
        false -> {P1, P2}
    end.

%% Chooses a single parent for breeding. This is done by choosing two candidates
%% and then choosing the fittest of the two
choose_parent(Pool, Target) ->
    P1 = lists:nth(random:uniform(length(Pool)), Pool),
    P2 = lists:nth(random:uniform(length(Pool)), Pool),

    F1 = fitness(P1, Target),
    F2 = fitness(P2, Target),

    if P1 =:= P2 -> choose_parent(Pool, Target);
       F1 > F2 -> P2;
       F1 < F2 -> P1;
       F1 == F2 -> P1
    end.

%% Return the fitness of the Candidate. This is calculated as the sum of the
%% distances of each letter from Candidate to the corresponding letter in Target
fitness(Candidate, Target) ->
    fitness(Candidate, Target, 0).
fitness([C1|Rest1], [C2|Rest2], Sum) ->
    fitness(Rest1, Rest2, Sum + abs(C1 - C2));
fitness([], [], Sum) ->
    Sum.

%% Cross S1 with S2. Choose a random position and swap S1 and S2 at this
%% position
crossover(S1, S2) ->
    R = random:uniform(length(S1)),
    {lists:sublist(S1, R) ++ lists:nthtail(R, S2),
     lists:sublist(S2, R) ++ lists:nthtail(R, S1)}.

%% Returns true when Result equals Target
check_result(Result, Target) ->
    fitness(Result, Target) =:= 0.

%% Mutates S by modifying the value of one character by +5/-5
mutate(S) ->
    R = random:uniform(length(S)) - 1, %% [0, length - 1]
    Char = lists:nth(R + 1, S),

    %% Randomly mutate a single character, but don't go out of the character range
    case X = random:uniform() of
        X when X =< 0.5 ->
            Offset = min(random:uniform(5) * -1, ?MinChar - Char);
        X when X > 0.5 ->
            Offset = min(random:uniform(5), ?MaxChar - Char)
    end,
    lists:sublist(S, R) ++ [Char + Offset] ++ lists:nthtail(R + 1, S).

You would run this with genetic:run_genetic("HELLO") and it would usually finish within 20 iterations. 10% of the time it loops forever, but I'm not too concerned about that.

\$\endgroup\$
10
\$\begingroup\$

General Remarks

  • Give your constants all uppercase names see Style in reference manual.
  • If you make the pool size a parameter in the run_genetic function, you should match it with an unbound variable. If you always match it only with the constant, you could omit this parameter and only use the constant.

run_genetic

  • run_genetic currently does three different jobs which should be split in functions with different names:
    • main entry point and initialization
    • runs over all generations
    • genetic algorithm steps for one generation (test fitness, mutation, crossover)
  • When compute a possible crossover, you can compute the result and store the result of the if as value.

  • When you perform mutation, you don't store the result of the call of the mutate(Result1)

  • As you should check also if the mutated string matches your target, this should be split in another function

check_pool / rand_string

You could write those simpler as

create_pool(Len, Num) ->
  [rand_string(Len) || _ <- lists:seq(1,Num)].

But this solution is potentially not as fast as you create a list from 1 to N first.

crossover

You could create the sublists with lists:split

mutate

You want if your calculated offset is negative probably do not go under MinChar so exchange min with max

My changed version of run_genetic

run_genetic(Target) ->
    random:seed(now()),
    FirstGen = create_pool(length(Target), ?POOLSIZE),
    produce_generations(FirstGen, Target, ?POOLSIZE, 1).

produce_generations(CurrentGen, Target, PoolSize, Iteration) ->
    io:format("Starting iteration ~B~n", [Iteration]),
    case populate(CurrentGen,[],Target, PoolSize) of 
        {not_found,NextGen} ->
            produce_generations(NextGen,Target,PoolSize,Iteration+1);
        _->
            io:format("Found result at iteration ~B~n", [Iteration])
    end.

populate(_LastGen,CurrentGen,_Target,0)->
    {not_found,CurrentGen};         
populate(LastGen,CurrentGen,Target,NumberMissingInPopulation) ->
    {P1, P2} = choose_parents(LastGen, Target),
    io:format("Breeding ~s (~B) and ~s (~B)~n",
              [P1, fitness(P1, Target), P2, fitness(P2, Target)]),
    CrossoverProb = random:uniform(),
    if CrossoverProb =< ?CROSSOVERPROB ->
            {Result1, Result2} = crossover(P1, P2);
       CrossoverProb > ?CROSSOVERPROB ->
            {Result1, Result2} = {P1, P2}
    end,
    io:format("Result strings are ~s (~B) and ~s (~B)~n",
              [Result1, fitness(Result1, Target),
               Result2, fitness(Result2, Target)]),
    Result=case check_add_and_continue(Result1,Result2,CurrentGen,Target) of
               R={not_found,_Gen} -> 
                   case MutateProb = random:uniform() of
                       MutateProb when MutateProb =< ?MutateProb ->
                           MutatedResult1=mutate(Result1),
                           MutatedResult2=mutate(Result2),
                           check_add_and_continue(MutatedResult1,MutatedResult2,CurrentGen,Target);           
                       _-> R
                   end;
               Found -> Found          
           end,
    case Result of 
        %%include min here if population size can be uneven
        {not_found,NewCurrentGen}->    
            populate(LastGen,NewCurrentGen,Target,NumberMissingInPopulation-2);
        _-> Result
    end.


check_add_and_continue(Child1,Child2,Generation,Target)->
    NewCurrentGen=[Child1, Child2|Generation],
    Found=case check_result(Child1, Target) or check_result(Child2, Target) of
              true -> found;
              false ->not_found
          end,
    {Found,NewCurrentGen}.
\$\endgroup\$
  • 3
    \$\begingroup\$ Welcome to Code Review! Your answer looks good, so I'll just leave you to enjoy your stay here. (Your answer came up in the review queue because the question is from about a year ago, maybe don't expect it to be accepted.) \$\endgroup\$ – ferada Jan 17 '15 at 12:06

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.