Ejercicio 6

En el siguiente código se muestra el algoritmo genético en que los cromosomas son representados con número reales en lugar de binarios, usando para el fitness la función de Griewank

#!/usr/bin/perl

use warnings;
use strict;

#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 fitness,
que es la función Griewank

my $funcion_griewank = sub {

    my $indi = shift;

    my @cr = @{$indi->{_array}};
    my $fr=4000;

    my $sum;

    my $prod=1;
    for(my $i=1; $i<=$#cr; $i++){

        $sum+=$cr[$i-1]^2;
        $prod*=cos($cr[$i-1]/sqrt($i));

    }

    return -$sum/$fr + $prod-1;

    #Using n==2
    #my ($x, $y) = @{$indi->{_array}};
    #return ($x*$x+$y*$y)/$fr
#-(cos($x)+ cos($y)/sqrt(2));

};

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

#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 $mut_operator = Algorithm::Evolutionary::Op::
GaussianMutation->new( 0, 0.1 );

my $cross_operator = Algorithm::Evolutionary::Op::
VectorCrossover->new(2);

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

# 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( $funcion_griewank, 
0.2 , [$mut_operator, $cross_operator] ) ;

#----------------------------------------------------------#
#Evaluamos la población inicial
for( @pop ){
    if ( !defined $_->Fitness() ) {

        my $fitness = $funcion_griewank->($_);
        $_->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() ;

Lo único a destacar es que yo la había hecho para sólo dos elementos, pero al ver que todo el mundo la ha generalizado, pues no iba yo a ser menos ...

En fin, en el siguiente enlace está la captura de pantalla que demuestra que el algoritmo funciona

Ejercicio 5

En la siguiente imagen tenemos las tablas de semejanzas y también las características (diferencias) para cada una de las técnicas bio-inspiradas.

Ejercicio 4

En el siguiente ejercicio tenemos que hacer un ranking con las 50 palabras en minúscula que más se utilicen en el texto.
El código correspondiente sería:

use strict;
use warnings;

use File::Slurp;

@ARGV || die "Uso: $0 <fichero de entrada>\n";

my %indice;
my $text = read_file( $ARGV[0] ) ;

my @palabras=split(" ", $text);
my $contador = 0;

for (@palabras){
    if (/[a-záéíóúñ]+/){
        $indice{$_} = 0;

    }
}

for (@palabras) {
  if (/[a-záéíóúñ]+/) {

    $indice{$_} =$indice{$_}+1;
  }
}

#for (sort {length($indice{$b}) cmp  
length($indice{$a})} keys %indice ) {
for (sort {$indice{$b} <=> $indice{$a}} 
keys %indice){

$contador++;
if($contador<=50){
   print $_, " = ", $indice{$_},"\n";

}

}

En cuanto a la línea comentada, la primera no funciona y la explicación parece estar en el siguiente trozo de la documentación de perldoc:

Equality Operators

Binary "<=>" returns -1, 0, or 1 depending on whether the left argument is numerically less than, equal to, or greater than the right argument.

Binary "cmp" returns -1, 0, or 1 depending on whether the left argument is stringwise less than, equal to, or greater than the right argument.

<=> compara numéricamente, por tanto, como nuestros valores lo son, es el correcto. Usando cmp y la longitud no nos sirve, puesto que entiende que 8 es menor que 2 pero mayor que 12. A continuación tenemos las salidas para cada caso:

Usando sort {length($indice{$a})cmp length($indice{$b})}:


Usando sort {$indice{$a} <=> $indice{$b}}:

Ejercicio 3

Por finnnnn!!!!

#!/usr/bin/perl

use strict;
use warnings;

use File::Slurp;

@ARGV || die "Uso: $0 <fichero a partir por trancos>\n";

my $text = read_file( $ARGV[0] ) ;
my @trancos=split("TRANCO", $text);


# $#vector te da el último elemento indexable del array

for (@trancos[1..$#trancos]){   
# -x40 multiplica el - por cuarenta, como cadena,
# por tanto, cuarenta - (-----  ...  --)
print substr($_,0,40), "\n", "-"x40, "\n"; 

  my @parrafo = split("\n\n", $_);

  for my $c(@parrafo){
      print "<p>", $c, "</p>\n\n";

    }
}

La imagen siguiente es la salida

Ejercicio 2

El siguiente ejercicio, cuenta el número de líneas que no están en blanco en un fichero de texto y las calcula para luego guardar ese valor en un fichero de nombre igual al de entrada al programa, pero con la extensión .lc

Así, el programa podría ser:

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

$contador=0;

while (<$fh>) {
    chop; chop;

    $contador++ if $_;
}

print $fh_out $contador;
close $fh;

close $fh_out;

De hecho, la lectura del fichero de entrada podría hacerse desde la línea de comandos, poniendo el nombre como argumento, y así no tener que abrir ningún fichero de entrada, pero entonces, ¿cómo acceder al nombre de ese fichero? supongo que una de las variables $algo.

Este es el primer ejercicio. Estoy depurando con perl -d.

n --> linea siguente

R --> ejecutar

b --> para poner un punto de ruptura en la linea

Sólo se ve una captura de la depuración y se ven distintos pasos

y un error que estoy arreglando

Mi primera entrada

Buenas!!!
Esta es la primera ventana abierta al mundo, de información de la ETSIIT en español!!!
(Aparte de servir para el master).