Ejercicio 5: Algoritmo genético

En este ejercicio hemos programado un algoritmo genético con números reales que utiliza la función Griewank como función de fitness. El código es el siguiente:

#Incluimos los elementos de la librería necesarios
use Algorithm::Evolutionary::Individual::Vector;
use Algorithm::Evolutionary::Op::Easy;
use Algorithm::Evolutionary::Op::GaussianMutation;
use Algorithm::Evolutionary::Op::VectorCrossover;


#----------------------------------------------------------#

#leemos los parámetros de la línea de comandos
my $popSize = shift || 100;
my $numGens = shift || 100 ;


#----------------------------------------------------------#

#Definimos la función de fitnes, que es la función Griewank: f(x) = 1/4000*sum(xi-100)^2 - prod((xi-100)/sqrt(i)) + 1

my $funcionGriewank = sub {

my $indice = shift;
my @x = @{$indice->{_array}};
my $nComp = $#x; #número de componentes del array x

my $suma = 0;
my $producto = 1;
for (my $j = 1; $j<=$nComp; $j++){
$suma = $suma + $x[$j-1]^2;
$producto = $producto * cos($x[$j-1]/sqrt($j));
}

my $f = $suma/4000 - $producto + 1;
return -1*$f; #pasamos el resultado a negativo para que el objetivo sea maximizar la función de fitness

};


#----------------------------------------------------------#

#Creamos la población inicial con $popSize individuos
my @pop;
for ( 0..$popSize ) {
my $indi = Algorithm::Evolutionary::Individual::Vector->new(2);
push( @pop, $indi );
}


#----------------------------------------------------------#

#Definimos los operadores de variación
my $m = Algorithm::Evolutionary::Op::GaussianMutation->new(0, 0.1); #mutación
my $c = Algorithm::Evolutionary::Op::VectorCrossover->new(2); #cruce


#----------------------------------------------------------#

# Usamos estos operadores para definir una generación del algoritmo. Lo cual
# no es realmente necesario ya que este algoritmo define ambos operadores por
# defecto. Los parámetros son la función de fitness, la tasa de selección y
# los operadores de variación.
my $generation = Algorithm::Evolutionary::Op::Easy->new( $funcionGriewank , 0.2 , [$m, $c] ) ;


#----------------------------------------------------------#

#Evaluamos la población inicial
for ( @pop ) {
if ( !defined $_->Fitness() ) {
my $fitness = $funcionGriewank->($_);
$_->Fitness( $fitness );
}
}


#bucle del algoritmo evolutivo
my $contador=0;

do{
$generation->apply( \@pop );
print "$contador : ", $pop[0]->asString(), "\n" ;
$contador++;
} while( $contador < $numGens );


#----------------------------------------------------------#

#Tomamos la mejor solución encontrada y la mostramos
my ( $x, $y ) = @{$pop[0]->{_array}};
print "El mejor es:\n\t ";
print $pop[0]->asString() ;
print "\n\t x=$x \n\t y=$y \n\t Fitness: ";
print $pop[0]->Fitness() ;

Y el resultado de la ejecución del programa se muestra en la siguiente imagen:

EJERCICIO 4: Cuenta-palabras

Programa en PERL que cuenta las palabras en minúscula que contiene un fichero de texto y muestra una lista con las 50 palabras que más aparecen:

#Programa PERL que cuenta las palabras en minúscula de un fichero y muestra las 50 más frecuentes

my $fichero_a_procesar = shift
|| die "Uso: $0 <nombre de fichero>n";
open my $fh, "<", $fichero_a_procesar || die "No puedo abrir el fichero. Error $!\n";

my %indice; #El % indica que tenemos una variable asociativa
while(<$fh>) {
@linea = split; #troceamos la línea por palabras, para que se analicen todas las palabras de la línea
for(@linea){
if (/(^[a-záéíóúñ]+)/ ) { #indicamos la expresión regular buscada: letra minúscula seguida de una o más letras
$indice{$1}++; #incrementamos el número de apariciones de la palabra en minúscula
}
}
}

#Ordenar las palabras en orden descendente del número de apariciones
@orden = sort {$indice{$b} <=> $indice{$a}} keys %indice;

#Mostrar sólo los 50 primeros
for(@orden[0..49]){
print "* $_ -> \t $indice{$_}\n";
}

EJERCICIO 3: TRANCOS

En este ejercicio se divide un fichero de texto en trozos, delimitados por la palabra "TRANCO", y cada tranco se descompone en párrafos.

#Programa que divide un fichero de texto en trozos. Cada trozo está delimitado por la palabra "TRANCO". Cada trozo se mete en un elemento de un array
use File::Slurp;

@ARGV || die "Uso: $0 <fichero a dividir trancos>\n";
my $text = read_file( $ARGV[0] ) ;
my @trancos=split("TRANCO", $text);

#para cada array hay una variable por defecto que referencia al último elemento indexable de un array (es como dar el tamaño del array)
#Esta variable es: $#nombre_array y su valor es num_elem-1 (los elementos se numeran empezando por 0)
#Operador .. -> inicio..fin -> iterar desde inicio hasta fin
for (@trancos[1..$#trancos]){ #Recorre el array. En cada iteración, el elemento actual está en $_
print substr($_,0,40), "\n", "-"x40, "\n"; #substr($_,0,40) es el substring que contiene los primeros 40 caracteres

#Dividir el tranco en párrafos
my @parrafos = split("\n\n", $_);

for (@parrafos){
print "<p> ", $_, "</p> \n\n";
}

}

Ejercicio 2: Programa "cuenta líneas"

El segundo ejercicio que hemos hecho en Perl consiste en un programa que lee un fichero, cuenta el número de líneas que no están en blanco en dicho fichero, y escribe este valor en otro fichero cuyo nombre es igual al del fichero de entrada, pero con extensión .lc.

Solución:
El código de este programa es el siguiente:

my $leyendo = "prueba.txt"; #Nombre del fichero que se va a leer

#Abrir los ficheros. Uno en modo lectura ("<") y otro en modo escritura (">")
if ( ! -r $leyendo ) { #comprobar si el fichero se puede leer
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";

#Crear e inicializar el contador de líneas
my $contador;
$contador = 0;

#Recorrer línea a línea el fichero
while (<$fh>) {
chop; chop; #quita los dos caracteres del final de la línea (el retorno de carro)
$contador++ if $_; #si queda algo en la línea (no está vacía), la cuento
}

#Imprimir el resultado de la cuenta en el fichero de salida
print $fh_out "El fichero tiene $contador líneas con texto\n"; #imprimir el número de líneas en #el fichero de salida

#Cerrar los ficheros
close $fh;
close $fh_out;

PERL - ejercicio 1

Éste es el primer ejercicio: ejecución en el depurador de un código en perl: