use Algorithm::Evolutionary::Individual::Vector;
use Algorithm::Evolutionary::Op::Easy;
use Algorithm::Evolutionary::Op::GaussianMutation;
use Algorithm::Evolutionary::Op::VectorCrossover;
# Definición de la función de Griewank:
# -------------------------------------
# f(x) = 1/4000*sum(xi^2) - prod(cos(xi)/sqrt(i)) + 1
#
# -600 <= x(i) <= 600
# i = 1..n (n = número de dimensiones del problema)
#
# Mínimo global: f(x) = 0 se alcanza con x = (0, ..., 0)
#
# Función de Griewank
my $funcionGriewank = sub {
# Cogemos el individuo a evaluar
my $chrom = shift;
# Extraemos el vector
my @x = @{$chrom->{_array}};
# Calculamos la función
my $suma = 0;
my $prod = 1;
for (my $i=0;$i<=$#x;$i++){
$suma += $x[$i]**2;
$prod *= cos($x[$i]/sqrt($i+1));
}
$suma = $suma/4000;
my $fitness = $suma-$prod+1;
return $fitness;
};
# Parámetros del algoritmo
my $popSize = 100; # Tamaño de la población
my $numGens = 100; # Número de generaciones
my $dimensiones = 2; # Número de dimensiones del problema
# y, por lo tanto, número de cromosomas
# Creación de la población inicial
my @pop;
for ( 0..$popSize ) {
# Los genes tomarán valores entre -600 y 600
my $indi = Algorithm::Evolutionary::Individual::Vector->
new( $dimensiones, -600, 600 );
push( @pop, $indi );
}
# Inicializamos el fitnes de la población inicial
for ( @pop ) {
if ( !defined $_->Fitness() ) {
my $fitness = $funcionGriewank->($_);
$_->Fitness( $fitness );
}
}
# Definición de los operadores genéticos
my $mutacion = Algorithm::Evolutionary::Op::GaussianMutation->
new( 0, 0.1 );
my $cruce = Algorithm::Evolutionary::Op::VectorCrossover->
new(2);
# Elección del algoritmo
my $generation = Algorithm::Evolutionary::Op::Easy->
new( $funcionGriewank , 0.2 , [$mutacion, $cruce] ) ;
# Bucle general del algoritmo
do {
$generation->apply( \@pop );
print "$numGens : ", $pop[0]->asString(), "\n" ;
$numGens--;
} while( $numGens > 0 );
# Mejor individuo encontrado
print "\nLa mejor solución encontrada es:\n\t ";
print $pop[0]->asString(),"\n";
lunes, 26 de mayo de 2008
Séptimo ejercicio
En este ejercicio utilizaremos el paquete de perl Algorithm::Evolutionary para implementar un algoritmo genético para minimizar la función de Griewank. En este caso usaremos codificación real para los cromosomas.
Sexto Ejercicio
En este ejercicio utilizaremos el paquete de perl Algorithm::Evolutionary para implementar un algoritmo genético para minimizar la función de Griewank. Usaremos codificación binaria para los cromosomas.
use Algorithm::Evolutionary::Individual::BitString;
use Algorithm::Evolutionary::Op::Easy;
use Algorithm::Evolutionary::Op::Mutation;
use Algorithm::Evolutionary::Op::Crossover;
# Definición de la función de Griewank:
# -------------------------------------
# f(x) = 1/4000*sum(xi^2) - prod(cos(xi)/sqrt(i)) + 1
#
# -600 <= x(i) <= 600
# i = 1..n (n = número de dimensiones del problema)
#
# Mínimo global: f(x) = 0 se alcanza con x = (0, ..., 0)
#
# Parámetros del algoritmo
# Tamaño de la población
my $popSize=100;
# Número de dimensiones del problema (en cada cromosoma
# se codificarán este número de reales)
my $dimensiones = 3;
# Número de bits con los que se codificará cada dimensión
# Cada cromosoma: ($dimensiones*$numBitsPorDimension)bits
my $numBitsPorDimension=10;
# Número de generaciones
my $numGens = 100;
# Función de Griewank:
my $funcionGriewank = sub {
#Cogemos el individuo a evaluar
my $chrom = shift;
my $str = $chrom->Chrom();
#Extraemos los números reales de la cadena binaria
my @vector;
my $pos=0;
while($pos<length($str)){
my $x = eval("0b".substr($str,$pos,$numBitsPorDimension));
@vector = (@vector,$x);
$pos += $numBitsPorDimension;
}
#Los normalizamos y los pasamos al rango [-600,600]
my $max=(2**$numBitsPorDimension )-1;
for(my $i=0;$i<=$#vector;$i++){
$vector[$i]=(($vector[$i]/$max)*1200)-600;
}
# Calculamos la función
my $suma = 0;
my $prod = 1;
for (my $i=0;$i<=$#vector;$i++){
$suma += $vector[$i]**2;
$prod *= cos($vector[$i]/sqrt($i+1));
}
$suma = $suma/4000;
my $fitness = $suma-$prod+1;
return $fitness;
};
# Muestra los números reales que componen un cromosoma
sub componentesSolucion{
#Cogemos el individuo a evaluar
my $chrom = shift;
my $str = $chrom->Chrom();
my $resultado = "";
#Extraemos los números reales de la cadena binaria
my @vector;
my $pos=0;
while($pos<length($str)){
my $x = eval("0b".substr($str,$pos,$numBitsPorDimension));
@vector = (@vector,$x);
$pos += $numBitsPorDimension;
}
#Los normalizamos y los pasamos al rango [-600,600]
my $max=(2**$numBitsPorDimension )-1;
for(my $i=0;$i<=$#vector;$i++){
$vector[$i]=(($vector[$i]/$max)*1200)-600;
$resultado = "$resultado$vector[$i], ";
}
print substr($resultado, 0, length($resultado)-2);
};
# Creación de la población inicial
my @pop;
for ( 0..$popSize ) {
my $indi = Algorithm::Evolutionary::Individual::BitString->
new( $dimensiones*$numBitsPorDimension ) ;
push( @pop, $indi );
}
# Inicializamos el fitnes de la población inicial
for ( @pop ) {
if ( !defined $_->Fitness() ) {
my $fitness = $funcionGriewank->($_);
$_->Fitness( $fitness );
}
}
# Definición de los operadores genéticos
my $mutacion = Algorithm::Evolutionary::Op::Mutation->new(0.1);
my $cruce = Algorithm::Evolutionary::Op::Crossover->new(2);
# Elección del algoritmo
my $generation = Algorithm::Evolutionary::Op::Easy->
new( $funcionGriewank , 0.2 , [$mutacion, $cruce] ) ;
# Bucle general del algoritmo
do {
$generation->apply( \@pop );
print "$numGens : ", $pop[0]->asString(), "\n" ;
$numGens -- ;
} while( $numGens > 0 );
# Mejor individuo encontrado
print "\nLa mejor solución encontrada es:\n\t ";
print $pop[0]->asString() ;
print "\nComponentes de la mejor solución: \n\t ";
componentesSolucion($pop[0]);
miércoles, 30 de abril de 2008
Quinto Ejercicio
En este ejercicio vamos a contar todas las veces que se repiten las palabras que aparecen en un fichero y vamos a imprimir las 50 palabras más repetidas.
El código del programa es el siguiente:
Primero dividimos el texto en palabras con la función split.
Luego recorremos el array con las palabras y si concuerdan con la expresión regular que define "una palabra en minúsculas" vamos incrementando el valor de un hash en el que tenemos como clave la palabra en sí y como valor el número de veces que se ha repetido.
A continuación ordenamos las palabras por repeticiones e imprimimos las 50 más frecuentes.
El código del programa es el siguiente:
use File::Slurp;
@ARGV || die "Uso: $0 <fichero para contar palabras>\n";
my $text = read_file( $ARGV[0] ) ;
my @palabras = split(" ",$text);
my %indice;
for(@palabras){
if($_ =~ /^([a-záéíóúñ])+$/){
$indice{$_}=$indice{$_}+1;
}
}
@ordenadas = sort {$indice{$b} cmp $indice{$a}} keys %indice;
for(0..49){
if($_<=$#ordenadas){
print $_+1,": ",$ordenadas[$_]," ... ",$indice{$ordenadas[$_]}," veces\n";
}
}
Primero dividimos el texto en palabras con la función split.
Luego recorremos el array con las palabras y si concuerdan con la expresión regular que define "una palabra en minúsculas" vamos incrementando el valor de un hash en el que tenemos como clave la palabra en sí y como valor el número de veces que se ha repetido.
A continuación ordenamos las palabras por repeticiones e imprimimos las 50 más frecuentes.
Cuarto Ejercicio
Vamos a escribir un programa que, dado un fichero de entrada, lo divida en párrafos y le añada las correspondientes etiquetas de párrafo en html (<p>Parrafo</p>).
El código del programa es el siguiente:
El código del programa es el siguiente:
Primero dividimos el texto del fichero en párrafos usando la función split la cual, como indica su primer argumento, añadirá una parte cada vez que encuentre 2 saltos de línea. Seguidamente, recorremos el array que contiene las partes e imprimimos en pantalla cada parte entre las mencionadas etiquetas html.
use File::Slurp;
@ARGV || die "Uso: $0 <fichero a dividir por párrafos>\n";
my $text = read_file( $ARGV[0] ) ;
my @parrafos=split("\r\n\r\n", $text);
for (@parrafos[0..$#parrafos]){
print "<p>\n",$_,"\n</p>\n";
}
martes, 22 de abril de 2008
Tercer ejercicio
Vamos a escribir un programa que cuente el número de líneas que no estén en blanco en un fichero, y lo escriba en un fichero de salida cuyo nombre se cree a partir del nombre del fichero original, con la extensión lc.
El código de nuestro programa es el siguiente:
Hemos usado cierta funcionalidad de perl que habíamos aprendido en el tutorial:
El código de nuestro programa es el siguiente:
my $leyendo = "diablocojuelo.txt";
if ( ! -r $leyendo ) {
die "El fichero $leyendo no es legible\n";
}
open my $fh, "<", $leyendo
or die "No puedo abrir el fichero $leyendo por $!\n";
open my $fh_out, ">", "$leyendo.lc"
or die "No puedo abrir el fichero $leyendo.lc por $!\n";
my $cont = 0;
while (<$fh>) {
chop; chop;
$cont++ if $_;
}
print $fh_out "$cont\n";
close $fh;
close $fh_out;
Hemos usado cierta funcionalidad de perl que habíamos aprendido en el tutorial:
- $! es una variable que contiene el último mensaje de error del sistema.
- <$fh> lee la siguiente línea (incluido el \n) del fichero al que apunta $fh
- $_ es la variable por defecto de perl. Si en algún sitio debería haber una variable y no la hay, entonces se está usando $_
- chop elimina un caracter del final de la línea
miércoles, 16 de abril de 2008
Segundo ejercicio
Depurando un fichero .pl desde el intérprete de comandos:
> perl -d fichero.pl
Algunos comandos del depurador:
c: continuar
n: siguiente
q: salir
h: ayuda
b [num_linea]: breakpoint en num_linea
> perl -d fichero.pl
Algunos comandos del depurador:
c: continuar
n: siguiente
q: salir
h: ayuda
b [num_linea]: breakpoint en num_linea
Suscribirse a:
Entradas (Atom)