Rešitev: Problem kromosomov (Mathematica)

Iz MaFiRaWiki

Naloga: Problem kromosomov

 one[v_String]:=StringCount[v,"1"]
 one::usege="Funkcija one[v] vrne število enk v nizu v.";
 f[v_String]:=Abs[11*one[v]-150]
 f::Usage="Funkcija f je kriterijska funkcija problema kromosom.";
 f ima dva lokalna maksimuma, in sicer pri "000000000000000000000000000000" in "111111111111111111111111111111", kjer je tudi globalni maksimum.

SIMULIRANO OHLAJANJE

 sosed::usage="Funkcija sosed[v], vrne soseda kromosoma v. To je kromosom enak v-ju povsod,  razen na natanko enem mestu.";
 
 sosed[v_String]:=Module[{i},
 :i=Random[Integer,{1,StringLength[v]}];                    (*naključen izbor pozicije*)
 :If[StringTake[v,{i}]\[Equal]"1",b="0",b="1"];            (*spremenimo vrednost i-to mesto v  kromosomu v*)
 :StringReplacePart[v,b,{i,i}]
 ]
 zacetni::usage="Funkcija zacetni vrne naključen kromosom.";
 zacetni:=StringJoin[Table[ToString[Random[Integer,{0,1}]],{30}]]
 simuliranoOhlajanje::usage="Funkcija simuliranoOhlajanje[Tzacetna,n,m] poišče maksimum funkcije f z metodo simuliranega ohlajanja, kjer je začetna temperatura Tzacetna, imamo n temperatur in vsakič pogledamo m sosedov (to je okolica kromosoma).";
 
 simuliranoOhlajanje[Tzacetna_,n_,m_]:=Module[{v,T,i,j,s},
 :v=zacetni;
 :T=Tzacetna;
 :For[i=1,i≤n,i++,
 ::For[j=1,j≤m,j++,        (*pogledamo m sosedov*)
 :::s=sosed[v];
 :::If[f[s]>f[v],v=s]        (*soseda si zapomnemo, če je boljši*)
 ::];
 ::s=sosed[v];               (*pogledamo enega soseda in...*)
 ::If[Random[]<Exp[(f[v]-f[s])/T],v=s];     (*...si ga zapomnemo z neko verjetnostjo*)
 ::T=T-(Tzacetna/n)              (*znižamo temperaturo*)
 :];
 :Return[{v,f[v]}]
 ]

Preizkus:

 In[1]:= simuliranoOhlajanje[100,10,100]
 Out[1]:= {111111111111110111111111111111,169}
 
 In[2]:= simuliranoOhlajanje[100,10,10]
 Out[2]:= {000000000000000000001010000010,117} 
 
 In[3]:= simuliranoOhlajanje[1,10,10]
 Out[3] := {110000100001001000000000001000,84}
 
'''LOKALNA OPTIMIZACIJA'''
<pre>
 lokalniMax::usage="Funkcija lokalniMax[m] poišče maksimum funkcije f z metodo lokalne optimizacije, kjer pogledamo m sosedov (to je okolica kromosoma).";
 
 lokalniMax[m_Integer]:=Module[{v,i,s},
 :v=zacetni;
 :For[i=1,i≤m,i++,         (*pogledamo m sosedov*)
 ::s=sosed[v];
 ::If[f[s]>f[v],v=s]        (*soseda si zapomnimo, če je boljši*)
 :];
 :Return[{v,f[v]}]
 ]

Preizkus:

 In[1]:= lokalniMax[100]
 Out[1]:= {111111111111111111110111111111,169}
 
 In[2]:=lokalniMax[50]
 Out[2]:= {111110110111111111111111101111,147}
 
 In[3]:=lokalniMax[10]
 Out[3]:= {000000000010000100000000010010,106}
Osebna orodja