08/08/12 13:39
systemgvp
Salve,
siccome avevo bisogno di trovare quando la funzione Tsim = a*a + b*b + c fosse pari a Treale = 10, ho riscritto per delphi l'algoritmo genetico riportato fra i tutorial scritto in VB. Il mio problema è leggermente differente da quello, in quanto nell'esempio si cerca un massimo, mentre io cerco di minimizzare l'errore Fitness = Treale - Tsim per avvicinarmi alla soluzione.
Il problema però è che l'algoritmo non trova un errore minimo globale, ma, a ogni ricerca, tanti minimi locali. Esiste un modo per giungere ad una soluzione "minima"?
Per chi servisse riporto l'intero codice funzionante della mia applicazione:
siccome avevo bisogno di trovare quando la funzione Tsim = a*a + b*b + c fosse pari a Treale = 10, ho riscritto per delphi l'algoritmo genetico riportato fra i tutorial scritto in VB. Il mio problema è leggermente differente da quello, in quanto nell'esempio si cerca un massimo, mentre io cerco di minimizzare l'errore Fitness = Treale - Tsim per avvicinarmi alla soluzione.
Il problema però è che l'algoritmo non trova un errore minimo globale, ma, a ogni ricerca, tanti minimi locali. Esiste un modo per giungere ad una soluzione "minima"?
Per chi servisse riporto l'intero codice funzionante della mia applicazione:
unit MenuGE; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Layouts, FMX.Memo, FMX.Objects, FMX.Edit; type TMenuGEN = class(TForm) Avvia: TButton; Console_TXT: TMemo; FermaRicerca: TCheckBox; MostraPassaggi: TCheckBox; Layout_sopra: TLayout; Layout_sotto: TLayout; ErroreMax_TXT: TEdit; ErroreMax_LAB: TText; ProbabilitaMutazione_TXT: TEdit; ProbabilitaMutazione_LAB: TText; popolazione_TXT: TEdit; popolazione_LAB: TText; SoluzioniPossibili_TXT: TEdit; SoluzioniPossibili_LAB: TText; MaxEminUguali_TXT: TEdit; MaxEminUguali_LAB: TText; MaxFitUguali_TXT: TEdit; MaxFitUguali_LAB: TText; procedure CreaPopolazione(variabili,popolazione,Max:integer); function CalcolaFitness(idVettore:integer):real; procedure SceltaSoluzioni_TipoRoulette(SoluzioniPossibili,popolazione:integer); procedure Combina_Crossover(idPadre,idMadre,variabili:integer); procedure Combina_Mutazione(soluzione,variabili,popolazione,Max:integer; ProbabilitaMutazione:real); procedure GeneraFigli(SoluzioniPossibili,variabili,popolazione,Max:integer;ProbabilitaMutazione:real); procedure NuovaGenerazione(SoluzioniPossibili,variabili,popolazione:integer); procedure MostraGenerazione(variabili,popolazione,SoluzioniPossibili,generazione:integer); procedure VediSoluzioniOrdinate(variabili,popolazione:integer); procedure MostraListaSoluzioniOrdinate(variabili,popolazione,generazione:integer); procedure AvviaClick(Sender: TObject); private { Private declarations } var Vettori, VettoriTemp, VettoriFigli : array of array of real; Treale : real; Fitness,Probabilita : array of real; Soluzioni : array of integer; //risultati ListaSoluzioniOrdinate : array of array of real; FitnessOrdinate : array of real; public { Public declarations } end; var MenuGEN: TMenuGEN; implementation {$R *.fmx} procedure TMenuGEN.CreaPopolazione(variabili,popolazione,Max:integer); var p,v,i:integer; numero:real; confermato:boolean; begin //Per iniziare, dobbiamo disporre di un insieme di soluzioni possibili, ossia //dei vettori casuali. Non è detto che queste soluzioni siano le migliori per il //problema, anzi, è altamente improbabile che lo siano poiché sono per ipotesi //casuali. Esse costituiscono il cosiddetto genetic pool, o, più semplicemente, //la popolazione della cui evoluzione ci occuperemo. Il numero di soluzioni //possibili presenti nel pool iniziale è arbitrario e definisce uno dei 4/5 //parametri importanti dell'algoritmo: piùindividui favoriscono una maggiore //varietà, ma al contempo incrementano il tempo necessario per passare alla //generazione successiva (poiché ci sono più informazioni da processare). //casualità Randomize; //imposta le dimensioni SetLength(Vettori,popolazione,variabili); //riempie la popolazione for p := 0 to popolazione-1 do begin for v := 0 to variabili-1 do begin //valore numero := Random(Max*10000)/10000; //se non è il primo valore controlla che lo stesso valore non sia //già stato assegnato alla stessa variabile di un'altra popolazione if (p > 0) then begin confermato := False; while (confermato = False) do begin confermato := True; for i := 0 to p-1 do begin //se è già presente assegna un altro valore if (Vettori[i,v] = numero) then begin confermato := False; numero := Random(Max*10000)/10000; break; end; end; end; end; //assegna il valore Vettori[p,v] := numero; end; end; end; function TMenuGEN.CalcolaFitness(idVettore:integer):real; var Tsimulato : real; begin //Una volta generato il pool genetico iniziale, occore dare una spinta all'algoritmo //verso l'evoluzione. Con questo termine intendiamo il miglioramento della //popolazione attraverso il passaggio in molte generazioni successive. Ogni //generazione ha una determinata popolazione, che si è sviluppata dalla precedente //mediante selezione. Come la scienza insegna, in una popolazione ci sono individui //più o meno adatti alla riproduzione. Quelli più adatti in genere vantano //caratteristiche migliori e perciò hanno più probabilità di accoppiarsi. Nella //scrittura dell'algoritmo occorre quindi definire una funzione che ci dica //quanto buona è una soluzione. In base a questo potremmo eseguire altri calcoli //sulle probabilità di sopravvivenza. Tsimulato := sqr(Vettori[idVettore,0]) + sqr(Vettori[idVettore,1]) + Vettori[idVettore,2]; CalcolaFitness := abs(Treale - Tsimulato); end; procedure TMenuGEN.SceltaSoluzioni_TipoRoulette(SoluzioniPossibili,popolazione:integer); var p,s,soluzione,EstrazioniMassime,estrazione:integer; sommaFitness,Max,Min,numero,Pini,valoreMin:real; idSoluzioniPossibili : array of integer; confermato:boolean; begin //In questo tipo di selezione, l'individuo con fitness maggiore ha maggiori //probabilità di accoppiarsi, ma non è certo che questo succeda. Per calcolare //questa probabilità si prende la sua fitness e la si divide per la fitness //totale di tutta la popolazione (ossia la somma di tutte le fitness calcolate). //Il nome deriva dal fatto che, se immaginassimo di avere una lunga striscia che //rappresenta la superficie della corona circolare di una roulette e di //suddividere questa striscia in porzioni proporzionali alla fitness di ogni //individuo, allora lanciando la pallina e facendo girare la roulette, l'individuo //con la fetta più grande avrebbe maggiori possibilità che la pallina si fermi //sulla sua parte di striscia. La relazione tra f e p, tuttavia, non è proprio //proporzionale, ma piuttosto asintotica. Infatti, qualora f tendesse a infinito, //p tenderebbe a 1, rendendo certo l'evento "accoppiamento" per la soluzione data. //limite di estrazioni per evitare loop infiniti EstrazioniMassime := 50; //casualità Randomize; //imposta le dimensioni dei vettori SetLength(Probabilita,popolazione); SetLength(Soluzioni,SoluzioniPossibili); //calcola la somma degli errori sommaFitness := 0; Max := 0; Min := Fitness[0]; for p := 0 to popolazione-1 do begin sommaFitness := sommaFitness + Fitness[p]; if (Max < Fitness[p]) then Max := Fitness[p]; if (Min > Fitness[p]) then Min := Fitness[p]; end; //anche se improbabile controllo il minimo della somma if (sommaFitness = 0) then sommaFitness := 1; //calcola le probabilità singole for p := 0 to popolazione-1 do Probabilita[p]:=((Max+Min)-Fitness[p])/sommaFitness; //le converte in intervalli for p := 1 to popolazione-1 do Probabilita[p]:=Probabilita[p]+Probabilita[p-1]; //imposta gli indici delle soluzioni possibili SetLength(idSoluzioniPossibili,popolazione); for p := 0 to popolazione-1 do idSoluzioniPossibili[p] := p; //seleziona le possibili soluzioni dall'insieme della popolazione for s := 0 to SoluzioniPossibili-1 do begin //azzera la posizione estrazione:= 0; soluzione := 0; //genera una probabilità casuale, e a seconda di quale intervallo ricade, //ne deduce la soluzione, se l'intervallo in esame non è già stato scelto numero := Random(1000)/1000; confermato := False; while (confermato = False) do begin //cerca l'intervallo di appartenenza soluzione := 0; Pini := 0; for p := 0 to popolazione-1 do begin if (numero >= Pini) and (numero < Probabilita[p]) then begin soluzione := p; break; end else Pini := Probabilita[p]; end; //controlla che la soluzione non sia già stata scelta if (idSoluzioniPossibili[soluzione] <> -1) then begin idSoluzioniPossibili[soluzione] := -1; confermato := True; end; //se si deve rigenerare la probabilità if (confermato = False) then begin //se il numero di estrazioni è arrivato al limite è si è entrati //in un loop si prende il valore con Fitness più basso rimasto if (estrazione >= EstrazioniMassime) then begin valoreMin := 1000000; for p := 0 to popolazione-1 do begin //se la soluzione non è già stata assegnata if (idSoluzioniPossibili[p] <> -1) then begin //se possiede il valore minimo if (Fitness[p] < valoreMin) then begin valoreMin := Fitness[p]; soluzione := p; end; end; end; //toglie la soluzione dalle scelte idSoluzioniPossibili[soluzione] := -1; //ferma il ciclo confermato := True; end //altrimenti else begin numero := Random(1000)/1000; estrazione:= estrazione + 1; end; end; end; //assegna la soluzione Soluzioni[s] := soluzione; end; end; procedure TMenuGEN.Combina_Crossover(idPadre,idMadre,variabili:integer); var v,punto,j:integer; begin //Per far avveniare questa operazione servono due genitori: il nuovo individuo //è formato combinando i dati dei due genitori in modo "casuale". In genere, si //punta a rappresentare ogni soluzione come array di dati o stringhe di caratteri, //detti cromosomi, poiché è molto semplice mescolarli: basta scegliere un punto //qualsiasi dell'array e formarne uno nuovo attaccando ai dati che lo precedono //i dati dell'altro genitore che seguono quello stesso punto. //casualità Randomize; //punto in cui spezzare il dna //cerca di prendere il punto centrale punto := 0; if (variabili > 2) then punto := Random(variabili-2) + 1; //incrementa il vettore j := Length(VettoriFigli); SetLength(VettoriFigli,j+1,variabili); //genera il figlio for v := 0 to variabili-1 do begin if (v <= punto) then VettoriFigli[j,v] := Vettori[idPadre,v] else VettoriFigli[j,v] := Vettori[idMadre,v]; end; end; procedure TMenuGEN.Combina_Mutazione(soluzione,variabili,popolazione,Max:integer; ProbabilitaMutazione:real); var p,variabile:integer; valore:real; confermato:boolean; begin //E' naturale che durante l'evoluzione si verifichino degli eventi imprevisti //che cambiano il codice gentico degli individui. È proprio la mutazione che //favorisce l'evoluzione, poiché altrimenti non si potrebbero affermare nuove //caratteristiche. La probabilità di mutazione è un altro importante parametro //dell'algoritmo. Dopo il crossover c'è una certa probabilità che un esemplare //venga modificato casualmente. //casualità Randomize; //se si ha la possibilità di avere una mutazione if (Random(100)/100 >= ProbabilitaMutazione) then begin //variabile da mutare variabile := Random(variabili); //genera il nuovo valore valore := Random(Max*10000)/10000; //procedura di conferma del valore per vedere che non esista già confermato := False; while (confermato = False) do begin confermato := True; for p := 0 to popolazione-1 do begin //se questo valore esiste già if (Vettori[p,variabile] = valore) then begin confermato := False; //genera un nuovo valore valore := Random(Max*10000)/10000; break; end; end; end; //assegna il nuovo valore VettoriFigli[soluzione,variabile] := valore; end; end; procedure TMenuGEN.GeneraFigli(SoluzioniPossibili,variabili,popolazione,Max:integer;ProbabilitaMutazione:real); var sol,figlio:integer; begin //azzera il vettore dei figli SetLength(VettoriFigli,0,variabili); //azzera gli indici figlio := 0; sol := 0; //per tutte le soluzioni probabilisticamente migliori genera i figli while (sol <= SoluzioniPossibili-2) do begin Combina_Crossover(Soluzioni[sol],Soluzioni[sol+1],variabili); Combina_Mutazione(figlio,variabili,popolazione,Max,ProbabilitaMutazione); //incrementa i contatori sol := sol + 2; figlio := figlio + 1; end; end; procedure TMenuGEN.NuovaGenerazione(SoluzioniPossibili,variabili,popolazione:integer); var p,v,s,ind:integer; indici : array of integer; temporanea:real; begin //In ogni generazione si susseguono le seguenti fasi: calcolo della fitness di //ogni invidiuo, selezione, crossover, mutazione, morte dei meno adatti. //Nell'ultima fase, gli individui peggiori "muoiono", vengono rimossi dalla //popolazione. Al loro posto sopraggiungono i figli dei candidati all'accoppiamento. //La dimensione della popolazione rimane comunque costante. Un algoritmo //genetico è costituito dal succedersi delle generazioni. //copia i vettori in una matrice di vettori temporanea SetLength(VettoriTemp,popolazione,variabili); for p := 0 to popolazione-1 do begin for v := 0 to variabili-1 do VettoriTemp[p,v] := Vettori[p,v]; end; //genera la lista degli indici SetLength(indici,popolazione); for p := 0 to popolazione-1 do indici[p] := p; //ordina il vettore delle Fitness dal più grande al più piccolo spostando //anche gli indici delle posizioni for v := 1 to popolazione-1 do begin for p := 0 to popolazione-2 do begin if (Fitness[p]<Fitness[p+1]) then begin temporanea := Fitness[p+1]; Fitness[p+1] := Fitness[p]; Fitness[p] := temporanea; //indici ind := indici[p+1]; indici[p+1] := indici[p]; indici[p] := ind; end; end; end; //ordina i vettori della popolazione in funzione delle Fitness ordinate for p := 0 to popolazione-1 do begin for v := 0 to variabili-1 do Vettori[p,v] := VettoriTemp[indici[p],v]; end; //sostituisce gli individui con Fitness (errore) alti con i //figli di quelli che hanno avuto Fitness basse for s := 0 to Length(VettoriFigli)-1 do begin for v := 0 to variabili-1 do Vettori[s,v] := VettoriFigli[s,v]; end; end; procedure TMenuGEN.MostraGenerazione(variabili,popolazione,SoluzioniPossibili,generazione:integer); var p,v,s:integer; stringa:string; begin //intestazione Console_TXT.Lines.Append('GENERAZIONE : '+intToStr(generazione)); Console_TXT.Lines.Append(''); stringa := 'ind'; for v := 0 to variabili-1 do stringa := stringa +#9+ intToStr(v+1); stringa := stringa +#9+ 'Fitness' +#9+ 'scelta'; Console_TXT.Lines.Append(stringa); //dati for p := 0 to popolazione-1 do begin stringa := inttostr(p); for v := 0 to variabili-1 do stringa := stringa +#9+ CurrToStr(Vettori[p,v]); stringa := stringa +#9+ CurrToStr(Fitness[p]); for s := 0 to SoluzioniPossibili-1 do begin if (Soluzioni[s] = p) then stringa := stringa +#9+ 'x'; end; Console_TXT.Lines.Append(stringa); end; Console_TXT.Lines.Append(''); //figli for s := 0 to Length(VettoriFigli)-1 do begin stringa := inttostr(s); for v := 0 to variabili-1 do stringa := stringa +#9+ CurrToStr(VettoriFigli[s,v]); Console_TXT.Lines.Append(stringa); end; Console_TXT.Lines.Append(''); //aggiorna la grafica Application.ProcessMessages; end; procedure TMenuGEN.VediSoluzioniOrdinate(variabili,popolazione:integer); var p,v,ind:integer; indici:array of integer; temporanea:real; begin //dimensiona le matrici e i vettori SetLength(FitnessOrdinate,popolazione); SetLength(ListaSoluzioniOrdinate,popolazione,variabili); //riempie i vettori for p := 0 to popolazione-1 do FitnessOrdinate[p] := Fitness[p]; //genera la lista degli indici SetLength(indici,popolazione); for p := 0 to popolazione-1 do indici[p] := p; //ordina il vettore delle Fitness dal più grande al più piccolo spostando //anche gli indici delle posizioni for v := 1 to popolazione-1 do begin for p := 0 to popolazione-2 do begin if (FitnessOrdinate[p]>FitnessOrdinate[p+1]) then begin temporanea := FitnessOrdinate[p+1]; FitnessOrdinate[p+1] := FitnessOrdinate[p]; FitnessOrdinate[p] := temporanea; //indici ind := indici[p+1]; indici[p+1] := indici[p]; indici[p] := ind; end; end; end; //ordina i vettori della popolazione in funzione delle Fitness ordinate for p := 0 to popolazione-1 do begin for v := 0 to variabili-1 do ListaSoluzioniOrdinate[p,v] := Vettori[indici[p],v]; end; end; procedure TMenuGEN.MostraListaSoluzioniOrdinate(variabili,popolazione,generazione:integer); var p,v:integer; stringa:string; begin //intestazione Console_TXT.Lines.Append('GENERAZIONE : '+intToStr(generazione)); Console_TXT.Lines.Append(''); stringa := 'ind'; for v := 0 to variabili-1 do stringa := stringa +#9+ intToStr(v+1); stringa := stringa +#9+ 'Fitness'; Console_TXT.Lines.Append(stringa); //dati for p := 0 to popolazione-1 do begin stringa := inttostr(p); for v := 0 to variabili-1 do stringa := stringa +#9+ CurrToStr(ListaSoluzioniOrdinate[p,v]); stringa := stringa +#9+ FloatToStr(FitnessOrdinate[p]); Console_TXT.Lines.Append(stringa); end; Console_TXT.Lines.Append(''); //aggiorna la grafica Application.ProcessMessages; end; procedure TMenuGEN.AvviaClick(Sender: TObject); var p,variabili,popolazione,Max,SoluzioniPossibili,AggiornamentoSchermo:integer; ContFitUguali,MaxFitUguali,generazione,ContEminUguali,MaxEminUguali:integer; ProbabilitaMutazione,ErroreMax,FitTotPrec,FitnessTot:real; begin Console_TXT.Lines.Clear; if (FermaRicerca.IsChecked = True) then FermaRicerca.IsChecked := False; //variabile da ricercare Treale := 10; //variabili variabili := 3; //valore massimo delle variabili Max := 20; //popolazione popolazione := StrToInt(popolazione_TXT.Text); //individui selezinabili //deve essere sempre un numero pari emassimo il doppio della popolazione SoluzioniPossibili := StrToInt(SoluzioniPossibili_TXT.Text); //probabilità do avere una mutazione ProbabilitaMutazione := StrToFloat(ProbabilitaMutazione_TXT.Text); //massimo errore accettabile ErroreMax := StrToFloat(ErroreMax_TXT.Text) * popolazione; //iterazioni massime costanti per evitare loop MaxFitUguali := StrToInt(MaxFitUguali_TXT.Text); //soluzione costante per avere la certezza della soluzione MaxEminUguali := StrToInt(MaxEminUguali_TXT.Text); //aggiornamento dello schermo AggiornamentoSchermo := 250; //crea la popolazione generazione := 0; CreaPopolazione(variabili,popolazione,Max); //calcola le funzioni di Fitness per ogni individuo SetLength(Fitness,popolazione); for p := 0 to popolazione-1 do begin Fitness[p] := 10000; Fitness[p] := CalcolaFitness(p); end; //col metodo della Roulet scegli gli individui per la riproduzione SceltaSoluzioni_TipoRoulette(SoluzioniPossibili,popolazione); //dalle soluzioni probabilisticamente migliori genera i figli GeneraFigli(SoluzioniPossibili,variabili,popolazione,Max,ProbabilitaMutazione); //mostra i dati if (MostraPassaggi.IsChecked = True) then MostraGenerazione(variabili,popolazione,SoluzioniPossibili,generazione); //calcola l'errore totale FitnessTot := 0; for p := 0 to popolazione-1 do FitnessTot := FitnessTot + Fitness[p]; //aggiorna l'errore precedente ContFitUguali := 1; ContEminUguali:= 1; FitTotPrec := FitnessTot; //ciclo iterativo di calcolo while ((FitnessTot>=ErroreMax) and (ContEminUguali<MaxEminUguali)) or (ContFitUguali<MaxFitUguali) or (FermaRicerca.IsChecked = False) do begin generazione := generazione + 1; //crea la nuova generazione di individui NuovaGenerazione(SoluzioniPossibili,variabili,popolazione); //calcola le funzioni di Fitness per ogni individuo for p := 0 to popolazione-1 do begin Fitness[p] := 10000; Fitness[p] := CalcolaFitness(p); end; //col metodo della Roulet scegli gli individui per la riproduzione SceltaSoluzioni_TipoRoulette(SoluzioniPossibili,popolazione); //dalle soluzioni probabilisticamente migliori genera i figli GeneraFigli(SoluzioniPossibili,variabili,popolazione,Max,ProbabilitaMutazione); //mostra i dati if (MostraPassaggi.IsChecked = True) then MostraGenerazione(variabili,popolazione,SoluzioniPossibili,generazione); //calcola l'errore totale FitnessTot := 0; for p := 0 to popolazione-1 do FitnessTot := FitnessTot + Fitness[p]; //controlla se uguale a quello precedente if (FitnessTot = FitTotPrec) then ContFitUguali := ContFitUguali + 1 else ContFitUguali := 1; if (FitnessTot = FitTotPrec) and (FitnessTot<ErroreMax) then ContEminUguali := ContEminUguali + 1 else ContEminUguali := 1; //aggiorna l'errore precedente FitTotPrec := FitnessTot; //ipotesi di fermo il ciclo if ((FitnessTot<ErroreMax) and (ContEminUguali>=MaxEminUguali)) or (ContFitUguali>=MaxFitUguali) or (FermaRicerca.IsChecked = True) then begin Console_TXT.Lines.Append('CICLO INTERROTTO-----------------------------'); if (FitnessTot<ErroreMax) and (ContEminUguali>=MaxEminUguali) then Console_TXT.Lines.Append('...per errore minimo'); if (ContFitUguali >= MaxFitUguali) then Console_TXT.Lines.Append('...per errori tipo loop'); if (FermaRicerca.IsChecked = True) then Console_TXT.Lines.Append('...manualmente'); Console_TXT.Lines.Append(''); Application.ProcessMessages; break; end; //aggiorna lo schermo if (generazione >= AggiornamentoSchermo) then begin Application.ProcessMessages; AggiornamentoSchermo := AggiornamentoSchermo + 250; end; end; VediSoluzioniOrdinate(variabili,popolazione); //mostra i dati dell'ultima soluzione trovata MostraListaSoluzioniOrdinate(variabili,popolazione,generazione); end; end.
aaa