Helio Master

Séptimo ejercicio

2008-05-26T03:53:00.000-07:00

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.

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";

Sexto Ejercicio

2008-05-26T03:14:00.000-07:00

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]);

Quinto Ejercicio

2008-04-30T07:49:00.000-07:00

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:


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

2008-04-30T06:34:00.000-07:00

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:


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";
}

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.

Tercer ejercicio

2008-04-22T09:43:00.001-07:00

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:


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

Segundo ejercicio

2008-04-16T09:33:00.001-07:00

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

Primer ejercicio

2008-04-16T09:00:00.000-07:00

Ejecutando un fichero .pl desde la línea de comandos:
> perl fichero.pl

Iniciándose en Perl

2008-04-16T08:59:00.000-07:00

Vamos a realizar un curso rápido de perl.
Se podrá realizar un seguimiento del desarrollo de este curso a través de este blog.

Lo primero que hemos hecho ha sido:

Descargar perl desde http://strawberryperl.com/
Descargar el editor Crimson desde http://www.crimsoneditor.com/