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.
mi eviti un lavoraccio cinese