Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- -module(genetic).
- -export([test/1, start/0]).
- -author({jha, abhinav}).
- % This is for use directly from the command line.
- test(Superman)->
- io:format("Trying to Breed Superhuman: ~p ~n", [Superman]),
- start(lists:concat(Superman)).
- % This can be used from the erlang shell, once exported above.
- start()-> start("superman").
- start(Superman)->start(Superman, 100).
- start(Superman, Base)->start(Superman, Base, 10000000).
- start(Superman, Base, Apocalypse)->start(Superman, Base, Apocalypse, 5).
- % Superman is the ideal being that the population should evolve into.
- % Base is the maximum initial population (of monkeys).
- % Apocalypse is the number of generations after which
- % a big meteor will wipe off all life from the planet and hence is our deadline.
- start(Superman, Base, Apocalypse, Mutability)->
- Monkeys = spawn_base(length(Superman), [], Base),
- Gens = evolve(Monkeys, Superman, Apocalypse, Mutability),
- io:format("Total time taken: ~p generations. ~n", [Apocalypse - Gens]).
- % We currently have 2 policies for allowing breeding : fascist (top 20) and liberal (everyone allowed to breed:P)
- % Line 19 has an atom (liberal/fascist) that can change the policy.
- evolve(_,_, 0, _) -> 0;
- evolve(Monkeys, Superman, Generations_to_apocalypse, P)->
- DamageList = lists:keysort(2, [{X, inverse_fitness(X, Superman,0)} || X <- Monkeys]),
- {GoodD, BadD} = breedingpolicy(DamageList, fascist, 50),
- Good = [ X || {X, _} <- GoodD],
- case goodenough(Good, Superman) of
- false ->
- Bad = [ Y || {Y, _} <- BadD],
- NewGood = reproduction_cycle(Good, Superman, P),
- evolve(NewGood ++ Bad, Superman, Generations_to_apocalypse -1, P);
- X ->io:format("Success - Bred Superman! ~p ~n", [X]),
- Generations_to_apocalypse
- end.
- % One reproduction cycle involves cross breeding the eligible mating population as decided by
- % the reproduction policy, once.
- reproduction_cycle(Generation, Superman, P)->
- reproduction_cycle(Generation, 1, (length(Generation) div 2) + 1,
- Generation, Superman, P).
- reproduction_cycle(_, X, X, NewGen, _, _) -> NewGen;
- reproduction_cycle(Generation, X, Y, NewGen, Superman, P)->
- Parent1 = lists:nth(X*2 -1, Generation),
- Parent2 = lists:nth(X*2, Generation),
- {Sibling1, Sibling2} = breed(Parent1, Parent2, P),
- io:format("[Breeding] ~p x ~p => ~p , ~p ~n", [Parent1, Parent2, Sibling1, Sibling2]),
- NextGen = [ Pop || Pop <- NewGen, Pop =/= Sibling1, Pop =/= Sibling2],
- Match = [ Child || Child <- [Sibling1, Sibling2], Sibling1 =:= Superman orelse Sibling2 =:= Superman ],
- case length(Match) of
- 0 -> reproduction_cycle(Generation, X+1, Y, [Sibling1, Sibling2|NextGen], Superman, P);
- _ ->io:format("======================================================~n"),
- io:format("~p x ~p => [~p, ~p] ~n", [Parent1, Parent2, Sibling1, Sibling2]),
- io:format("======================================================~n"),
- [Sibling1,Sibling2|NewGen]
- end.
- % One specific instance of a couple mating.
- % Pick a random pivot, and swap the strings around the pivot
- % in Parent1 and Parent 2.
- % e.g: AAAAAZZZZZ x BBBBBYYYYY = AAAAAYYYYY, BBBBBZZZZZ
- breed(Parent1, Parent2, P)->
- Xspot = random:uniform(length(Parent1)),
- {Parent1_frag1, Parent1_frag2} = lists:split(Xspot, Parent1),
- {Parent2_frag1, Parent2_frag2} = lists:split(Xspot, Parent2),
- random_mutate({Parent1_frag1 ++ Parent2_frag2, Parent2_frag1 ++ Parent1_frag2}, P).
- % Mutate with a 1/pow(2, P) probability
- random_mutate(S, P)->
- {S1, S2} = S,
- X = case probability(P) of
- true ->
- Mutant1 = mutate(S1),
- io:format("[Mutation]Result: ~p <==> ~p ~n", [S1, Mutant1]),
- Mutant1;
- false -> S1
- end,
- Y = case probability(5) of
- true ->
- Mutant2 = mutate(S2),
- io:format("[Mutation]Result: ~p <==> ~p ~n", [S1, Mutant2]),
- Mutant2;
- false -> S2
- end,
- {X, Y}.
- % Actual mutation function.
- % Mutagen = Random + or - variation of variable value at a random mutation point within a string.
- mutate(S)->
- {A1,A2,A3} = now(),
- random:seed(A1,A2,A3),
- MutationPoint = random:uniform(length(S)-1),
- {Pre, [X|Post]} = lists:split(MutationPoint-1, S),
- Mutagen = case probability(1) of
- true -> -1 * random:uniform(5);
- false -> random:uniform(5)
- end,
- Pre ++ [abs((X-97 + Mutagen) rem 122) + 97] ++ Post.
- % Initial population
- spawn_base(_, Acc, 1)-> Acc;
- spawn_base(Num, Acc, N)->spawn_base(Num, [make_string(Num, [])|Acc], N-1).
- make_string(X, Acc)->
- case length(Acc) of
- X -> Acc;
- _ -> make_string(X, [96 + random:uniform(26)|Acc])
- end.
- % Inverse fitness count. ( As in survival of the fittest).
- % calculates absolute distance of a progeny from the ideal ubermensch.
- inverse_fitness([], _, N) -> N;
- inverse_fitness([P|Person], [I|Ideal], N)->inverse_fitness(Person, Ideal, N+abs(P-I)).
- % Whether we have formed the ideal person or not.
- goodenough([Superman|_Good], Superman)->Superman;
- goodenough(_, _)->false.
- % A simple probability function that returns true with
- % a probability of 1/2^X
- probability(X)-> probability(X, X).
- probability(_, 0) -> true;
- probability(X, A) ->
- N1 = random:uniform(),
- N2 = random:uniform(),
- case N1 > N2 of
- true -> probability(X, A-1);
- false -> false
- end.
- % Decide the breeding policy - fascist or liberal
- breedingpolicy(Population, fascist, X)->lists:split(X, Population);
- breedingpolicy(Population, liberal, _)->lists:split(length(Population), Population).
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement