
Originariamente inviato da
Dev-01
Non è che lavoro alla cieca... è che ho iniziato ad occuparmene da tre giorni.
Vabbè dai alla ciechissima 
In una coltura generata randomicamente che evolve ed effettua cross-over sulla base del valore di fitness degli individui come faccio (in linea teorica) ad individuare una soluzione accettabile al problema posto prima che la quest'ultima sia superata dalla prossima generazione e che la coltura converga magari verso una soluzione di qualità inferiore?
Mah vedo un pochino di idee confuse.
1) non converge affatto
Mi sto un po' scoraggiando perché l'argomento è particolarmente impegnativo, il mio livello di conoscenza in merito basso e di conseguenza anche la mia capacità di effettuare domande ne risente.
Un pochino sì, ma non disperare, dopo 3 anni di uso quotidiano di AG (O GA se vuoi faaa l'ammerikano) tutto sarà più facile.
Visto che vogliamo partire da cose semplici, niente codifica dinamica dei parametri (aka zoom)
ecco un vecchio genetico accademico-dimostrativo in pascal (object)
unit Threads;
interface
uses
Dialogs,Main,ComCtrls,Classes, Graphics, ExtCtrls,stdctrls,sysUtils,Math;
type
MIO = integer;
const
MAXPOP=100;
MAXLENGTH=300;
type
{ TFranzThread }
TFranzThread = class(TThread)
private
FListBox:TListBox; // listbox a scopo debug
FSeed:integer; // seme random
FPM:double; // mutazione
FPC:double; //probabilità crossover
FChoice:integer; //funzione
FMaxCicli:integer; //max num cicli
FEpoca:integer; // cicli per output
FObjectiveMin: integer; // indice individuo migliore
FSoluzioneMigliore:string; // soluzione migliore in stringa
FProgressBarbestsol:TProgressBar;
FProgressBarFomin:TProgressBar;
Flblbestsol:TLabel;
FlblFomin:TLabel;
FIterazione: integer;
Fbestsol: double;
FFomin: double;
FFomax: double;
FOutputSuFile:boolean; // se true output su FFileOutput
FNomeFileOutput:string; // nome file di output
FHandleFileOutput:textfile;
procedure doMostraMinimo;
protected
procedure Execute; override;
procedure MostraMinimo(iterazione:integer;var bestsol:double;var fomin:double;var fomax:double;individuoMigliore:string);
public
constructor Create(outputSuFile:boolean;nomeFile:string;choice:integer;var lblbestsol:TLabel;var lblFomin:Tlabel;var lbListBox:TListBox;var pgrProgressbestsol:TProgressBar;var pgrProgressFomin:TProgressBar;seed:integer;mutazione:double;crossover:double;maxcicli:integer;epoca:integer);
end;
TMINGenetico = class(TFranzThread)
private
numvar,bitvar,maxlen:longint;
deno:longint;
pop: array [0..MAXPOP,0..MAXLENGTH] of MIO;
fitness: array [0..MAXPOP] of double;
incfitness: array [0..MAXPOP] of double;
bestsol:double;
protected
procedure Execute; override;
function getrandom(var x:longint;max:double):double;
function gauss(var x:longint):double;
function conver(k:integer;riga:integer):double;
function clcobj(line:integer):double;
procedure makeselection;
procedure compact(var vetcomp:array of MIO;canc:integer;cicle:integer);
procedure makexover;
procedure makemutation;
procedure Minimizza;
end;
implementation
constructor TFranzThread.Create(outputSuFile:boolean;nomeFile:string;choice:integer;var lblbestsol:TLabel;var lblFomin:Tlabel;var lbListBox:TListBox;var pgrProgressbestsol:TProgressBar;var pgrProgressFomin:TProgressBar;seed:integer;mutazione:double;crossover:double;maxcicli:integer;epoca:integer);
begin
FOutputSuFile:=outputsufile;
FNomeFileOutput:=nomeFile;
FListBox:=lbListBox;
FProgressBarbestsol:=pgrProgressbestsol;
FProgressBarFomin:=pgrProgressFomin;
Flblbestsol:=lblbestsol;
FlblFomin:=lblFomin;
FSeed:=seed;
FPM:=mutazione;
FMaxCicli:=maxcicli;
FEpoca:=epoca;
FPC:=crossover;
FChoice:=choice;
FObjectiveMin:=0;
FreeOnTerminate := True;
inherited Create(False);
end;
procedure TFranzThread.DoMostraMinimo;
begin
FLblbestsol.caption:='IT '+inttostr(fiterazione)+' '+format('%10.6f',[fbestsol]);
FLblFomin.caption :=FSoluzioneMigliore;
if FBestSol<>0 then
FProgressbarFomin.position:=trunc((1.0/(FBestSol))*Ffomin);
FProgressbarbestsol.position:=trunc(10000*FBestSol);
if FOutputSuFile then
writeln(FHandleFileOutput,Format('Iterazione |%06d| %s',[fiterazione,FsoluzioneMigliore]));
end;
procedure TFranzThread.MostraMinimo(iterazione:integer;var bestsol:double;var fomin:double;var fomax:double;individuoMigliore:string);
begin
FSoluzioneMigliore:=individuoMigliore;
FIterazione:=iterazione;
Fbestsol:=bestsol;
FFomin:=Fomin;
FFomax:=fomax;
Synchronize(DoMostraMinimo);
end;
procedure TFranzThread.Execute;
begin
end;
procedure TMinGENETICO.Execute;
begin
Minimizza;
end;
function TMINGenetico.getrandom(var x:longint;max:double):double;
var
y:longint;
yfl:double;
begin
y := x * 1220703125;
if (y<0) then
begin
y :=y+2147483647;
INC(y);
end;
x:=y;
yfl :=y;
yfl :=yfl*0.4656613E-9;
if max=1 then
getrandom:=yfl
else
getrandom:=y mod (trunc(max+1));
end;
// generiamo una v.a. distribuita normalmente (teorema limite centrale)
// con media 3 , var. e sigma = 1
// prendo media 3 e non 6 per limitare i rischi di
// grandi valori negativi che potrebbero creare problemi nella
// minimizzazione
function TMINGenetico.gauss(var x:longint):double;
var somma:double;
i:integer;
begin
somma:=0;
for i:=1 to 12 do
somma:=somma+getrandom(x,1);
result:=somma-3.0;
end;
// converte la K-esima variabile dell'individuo riga
function TMINGenetico.conver(k:integer;riga:integer):double;
var j:integer;
cont:double;
begin
cont:=0;
for j:=0 to bitvar-1 do
begin
//cont:=cont+power(2,bitvar-1-j)*pop[riga,k*bitvar+j];
cont:=cont+(1 shl (bitvar-1-j))*pop[riga,k*bitvar+j];
end;
//cont:=(cont-power(2,bitvar-1))/deno;
cont:=(cont-(1 shl (bitvar-1)))/deno;
result:=cont;
end;
// nota: niente fronzoli, niente puntatori a funzioni, etc.
function TMINGenetico.clcobj(line:integer):double;
var val,val1,x1,x2,x3:double;
i:integer;
begin
VAL:=0;
val1:=0;
case (Fchoice) of
1: begin
for i:=0 to numvar-1 do
begin
val1:=conver(i,line);
val:=val+val1*val1;
end;
end;
2: begin
x1:=conver(0,line);
x2:=conver(1,line);
val:=100*(power((x1*x1)-x2,2)+power((1-x1),2)); // usato volutamente power() e non la moltiplicazione
// per rallentare l'esecuzione
end;
3: begin
for i:=0 to numvar-1 do
val:=val+trunc(conver(i,line));
end;
4: begin
for i:=0 to numvar-1 do
begin
val1:=conver(i,line);
val:=val+i*val1*val1*val1*val1;
end;
val:=val+gauss(Fseed);
end;
5: begin
x1:=conver(0,line);
x2:=conver(1,line);
x3:=conver(2,line);
val:=abs(x1*18+x2*48+x3*42-600);
if x1<=0 then val:=val+600;
if x2<=0 then val:=val+600;
if x3<=0 then val:=val+600;
if (x1+x2+x3)<>20 then val:=val+600;
end;
end;
result:=val;
end;
// riproduzione
procedure TMINGenetico.makeselection;
var
i,k,linecopy:integer;
pos:double;
popsel:array[0..MAXPOP,0..MAXLENGTH] of MIO;
begin
// metto in incfitness[] la fitness[] incrementale (somma da 0 a i delle fitness[i])
incfitness[0]:=fitness[0];
for k:=1 to MAXPOP-1 do
begin
incfitness[k]:=incfitness[k-1]+fitness[k];
end;
for k:=0 to MAXPOP-1 do
begin
// genero numero casuale compreso tra 1 e il valore della fitness cumulata
pos:=(getrandom(Fseed,trunc(incfitness[MAXPOP-1])));
// trova l'indice linecopy (all'interno della fitness cumulata) che e' >= di pos
linecopy:=0;
while(incfitness[linecopy]<pos) do
INC(linecopy);
for i:=0 to maxlen-1 do
popsel[k,i]:=pop[linecopy,i];
end;
for i:=0 to MAXPOP-1 do
for k:=0 to maxlen-1 do
pop[i,k]:=popsel[i,k];
end;
procedure TMINGenetico.compact(var vetcomp:array of MIO;canc:integer;cicle:integer);
var ind,ind1:integer;
begin
ind:=0;
while(vetcomp[ind]<>canc) do
INC(ind);
for ind1:=ind to cicle-1 do
vetcomp[ind1]:=vetcomp[ind1+1];
end;
procedure TMINGenetico.makexover;
var
num:array[0..MAXPOP] of MIO; // MIO
couple:array[0..MAXPOP] of integer;
temp:MIO; //MIO
i,j,xcut,temp1:integer;
begin
temp1:=MAXPOP;
// inizializza vettore num[] a 0,1,2,...MAXPOP-1
for i:=0 to MAXPOP-1 do
num[i]:=i;
// genera le coppie candidate per il crossover
for i:=0 to MAXPOP-1 do
begin
couple[i]:=num[trunc(getrandom(Fseed,temp1-1))];
compact(num,couple[i],temp1);
DEC(temp1);
end;
i:=0;
while (i<MAXPOP) do
//for(i=0;i<MAXPOP;i+=2)
begin
if(getrandom(Fseed,1)<=Fpc) then
begin
xcut:=trunc(getrandom(Fseed,maxlen-1));
for j:=xcut to maxlen-1 do
begin
temp := pop[couple[i],j];
pop[couple[i],j] := pop[couple[i+1],j];
pop[couple[i+1],j] := temp;
end;
end;
i:=i+2;
end;
end;
procedure TMINGenetico.makemutation;
var i,j:integer;
test:double;
begin
for i:=0 to MAXPOP-1 do
for j:=0 to maxlen-1 do
begin
test:=Fpm;
if (getrandom(Fseed,1)<=test) then
begin
//pop[i,j] := not pop[i,j];
if pop[i,j]=1 then pop[i,j]:=0 else pop[i,j]:=1; // nota: i numeri in Pascal sono SIGNED.
// questo rallenta, ma rende sicuri
end;
end;
end;
procedure TMINGenetico.Minimizza;
var n,i,j,k:integer;
objective:array [0..MAXPOP] of double;
fomin,fomax:double;
numit:integer;
individuoSoluzioneMigliore:integer;
soluzioneMigliore:string;
variabile:double;
begin
if FOutputSuFile then
begin
try
AssignFile(FHandleFileOutput,FNomeFileOutput);
if FileExists(FNomeFIleOutput) then
append(FHandleFileOutput)
else
Rewrite(FHandleFileOutput);
except
FOutputSuFile:=false;
end;
end;
case Fchoice of
1: begin
numvar:=3;
bitvar:=10;
deno:=100;
end;
2: begin
numvar:=2;
bitvar:=12;
deno:=1000;
end;
3: begin
numvar:=5;
bitvar:=10;
deno:=100;
end;
4: begin
numvar:=30;
bitvar:=8;
deno:=100;
end;
5: begin
numvar:=3;
bitvar:=6;
deno:=1;
end;
end;
if FOutputSuFile then
writeln(FHandleFileOutput,Format('Funzione %d Iterazioni %06d Mutazione %6.3f Xver %6.3f seed %d',[Fchoice,FMaxCicli,FPM,FPC,FSeed]));
maxlen:=numvar*bitvar;
for i:=0 to MAXPOP-1 do
for j:=0 to maxlen-1 do
pop[i,j]:=trunc(getrandom(fseed,1)+0.5);
fomin:=0;
fomax:=0;
bestsol:=10000000;
for numit:=0 to Fmaxcicli do
begin
if Terminated then
begin
if FOutputSuFile then closefile(FHandleFileOutput);
exit;
end;
individuoSoluzioneMigliore:=-1;
for n:=0 to MAXPOP-1 do
begin
// calcola funzioni obiettivo e le mette in objective[]
objective[n]:=clcobj(n);
// setta fomin e fomax al min,max delle funzioni obiettivo della popolazione
if (objective[n]<fomin) OR (n=0) then
fomin:=objective[n];
if (objective[n]>fomax) OR (n=0) then
fomax:=objective[n];
if objective[n]<bestsol then
begin
bestsol:=objective[n];
individuosoluzionemigliore:=n;
end;
end;
// test ad ogni generazione (anche se non Epoca). Usato per il debug
if individuoSoluzioneMigliore>-1 then
begin
soluzioneMigliore:='';
for k:=0 to numvar-1 do
begin
variabile:=conver(k,individuoSoluzioneMigliore);
soluzioneMigliore:=SOLUZIONemigliore+ format('%8.3f|',[variabile]);
end;
soluzioneMigliore:=format('%10.6f | %s',[bestsol,soluzioneMigliore]);
end;
// ora di collezionare output?
if (numit mod Fepoca)=0 then
MostraMinimo(numit,bestsol,fomin,fomax,soluzioneMigliore);
// calcola fitness con metodo silly (niente window o sigma scaling)
for n:=0 to MAXPOP-1 do
begin
fitness[n]:=fomax-objective[n];
end;
// operatori genetici
makeselection;
makexover;
makemutation;
// abbiamo una soluzione migliore? Si' aggiorna bestsol (nota:sarebbe bestmin...)
end;
if FOutputSuFile then
closefile(FHandleFileOutput);
end;
end.
Non ho capito cosa intendi...
Non voglio richiedere sforzi particolari e gratuiti, credevo che nel suo concetto di base l'applicazione reale fosse più facilmente esplicabile.
Mi viene quasi da scusarmi per aver aperto il thread...
Bhè guarda che è come demoralizzarsi dopo 3 giorni di iscrizione a medicina 
La codifica banale la vedi sopra: ogni allele è un bit del genoma; ogni variabile continua la trasformi in discreta, col metodo più facile (potenze di 2).
Questo è l'esempio più scemo: semplicemente sommi le potenze di due (i vari bit )per la popolazione, e sommi (in sostanza la convoluzione)
cont:=0;
for j:=0 to bitvar-1 do
begin
//cont:=cont+power(2,bitvar-1-j)*pop[riga,k*bitvar+j];
cont:=cont+(1 shl (bitvar-1-j))*pop[riga,k*bitvar+j];
end;
//cont:=(cont-power(2,bitvar-1))/deno;
cont:=(cont-(1 shl (bitvar-1)))/deno;
result:=cont;
Questo approccio ha un caterva di problemi, è solo per didattica, ma l'idea è quella.
Cosa ti turba?