transcript[dna_]:=Module[{litery1,litery2,litery3},
litery1=Characters[dna];
litery2=Partition[litery1,2];
litery3=StringJoin/@litery2;
TakeWhile[litery3,(#!="BB")&]
]
(* 
funkcja powyżej dzieli łańcuch DNA na dwójki, i pobiera je do momentu napotkania kodonu STOP ("BB") lub końca sekwencji
*)

tRNA[rna_]:=Switch[rna,"AA",(#+1)&,"BA",(1/#)&,"AB",(1#)&]
(* funkcja tRNA realizuje kod genetyczny, czyli zamienia dwójki ,,nukleotydów'' na odpowiednie funkcje *)

translate[rna_]:=tRNA/@rna
(* funkcja dokonuje ,,translacji'', czyli zamienia RNA na listę ,,aminokwasów'' - czyli funkcji *)

fold[amino_]:=Apply[Composition,amino][1]
(* 
funkcja fold składa po kolei funkcje znajdujące się na liście amino i wstawia x=1; w wyniku tego procesu zawsze powinna powstać dodatnia liczba wymierna - ,,dorosły osobnik'' 
*)

substytucja[org_]:=Module[{nuk,pos},
nuk=RandomChoice[{"A","B"}];
pos=RandomInteger[{1,StringLength[org]}];
StringReplacePart[org,nuk,{pos,pos}]
]
(* funkcja substytucja zamienia na losowo wybranej pozycji jeden z nukleotydów *)

delecja[dna_?StringQ]:=StringDrop[dna,Sort[{RandomInteger[{1,StringLength[dna]}],RandomInteger[{1,StringLength[dna]}]}]]
(* funkcja kasuje losowy fragment DNA *)

insercja[dna_?StringQ]:=Module[{n,dna1,dna2},
n=RandomInteger[{1,StringLength[dna]}] (* wybieramy losowo punkt podziału ,,dna'' następująco: z generatora
liczb losowych za pomocą RandomInteger (random->losowy; integer->liczba całkowita), a przedziału
od 1 do liczby znaków w sekwencji (StringLength[dna]) *);
dna1=StringTake[dna,{1,n}];
dna2=StringTake[dna,{n+1,StringLength[dna]}];
dna1<>randomDNA[RandomInteger[3]]<>dna2 (* maks. ,,poślizg'' przy kopiowaniu to 3 pozycje *)
]
(*funkcja insercja wstawia losowo maks. 3 nukleotydy wewnątrz DNA*)

mutacja[dna_?StringQ]:=RandomChoice[{0.1*StringLength[dna],0.01*StringLength[dna],StringLength[dna],400/StringLength[dna]}->{delecja[dna],insercja[dna],substytucja[dna],dna}]
(* funkcja mutacja wybiera losowo z podanymi wagami za pomocą RandomChoice jedną z czterch funkcji: delecja, insercja, substytucja, lub funkcja ktora nic nie robi poza skopiowaniem argumentu bez zmian
*)

Przykład dzialania powyższych funkcji:

dna="AABABBBA" (* przykładowe DNA *)

rna=dna//transcript (* dzielimy na kodony i obcinamy wszystko za kodonem STOP="BB" *)

amino=rna//translate (* każdy kodon zostaje zamieniony na funkcję zgodnie z kodem genetycznym *)

Table[amino[[k]][x],{k,1,Length[amino]}] (* bardziej zrozumiała dla studentów postać funkcji powyżej *)

Apply[Composition,amino][x] (* wynik złożenia funkcji F[ H [x]] *)

fold[amino] (* składamy funkcje i wstawiamy x=1 *)

W tym momencie ,,aparat komórkowy’’ jest już gotowy, potrzebujemy teraz ,,wrogiego środowiska’’. Wszytkie organizmy które kiepsko poradzą sobie z zadaniem ,,obliczenia’’ liczby Pi, E lub Sqrt[2] zostaną sklasyfikowane niżej i nie przejdą do dalszego etapu. Ocena polega na obliczeniu 
sumy:

d[org_]:=Module[{osob},
osob=org//transcript//translate//fold;
1/Abs[N[Sqrt[2]-osob]]+1/Abs[N[Pi-osob]]+1/Abs[N[E-osob]] (* można tu eksperymentować *)
]

Teraz tworzymy populację 200 prymitywnych (długość DNA to 4 zasady) osobników:

randomDNA[num_]:=RandomChoice[{"A","B"},num]//StringJoin

populacja=Table[randomDNA[4],{i,200}];

Obliczamy ,,jakość’’ każdego osobnika funkcją d i dla wygody sortujemy od nalepszego do najgorszego:

NOWE POKOLENIE:

ewolucja100={}; (* miejsce na kolekcję wykopalisk *)

{d/@populacja,populacja}//Transpose//Sort//Reverse

Bierzemy połowę ,,najlepszych’’:

%[[1;;Length[%]/2]]

Duplikujemy (rozmnażamy przez podział) najlepszych:

{Transpose[%][[2]],Transpose[%][[2]]}//Flatten

Dokonujemy mutacji (są one mało prawdopodobne, więc często prawie nic się nie zmienia):

mutacja/@%

Tworzymy nowe pokolenie, i wracamy na początek (oznaczone wcześniej ,,NOWE POKOLENIE’’):

populacja=%

Oczywiście robienie tych czynności ręcznie ma sens tylko na początku, aby zrozumieć o co chodzi. Potem należy zostawić to komputerowi, pętla Do powtarza zadane czynności wielokrotnie:

Do[
p1={d/@populacja,populacja}//Transpose//Sort//Reverse;
p2=p1[[1;;Length[p1]/2]];
p3=Transpose[p2];
p4=p3[[2]];
p5={p4,p4}//Flatten ;(* duplikacja, rozmanazanie przez podzial *)
p6=mutacja/@p5;
populacja=p6;
,{100}] //Timing(* powtarzamy 100 razy *)

{d/@populacja,populacja}//Transpose//Sort//Last

best=%[[2]]

Apply[Composition,translate[transcript[best]]][1]

d[best]

Apply[Composition,translate[transcript[best]]][x]

{d[best],best,Apply[Composition,translate[transcript[best]]][1],Apply[Composition,translate[transcript[best]]][1.0],Apply[Composition,translate[transcript[best]]][x]}

AppendTo[ewolucja100,%]