diff --git a/lib/linguist/languages.yml b/lib/linguist/languages.yml index 8ec6d0754f..73cfadd9bc 100755 --- a/lib/linguist/languages.yml +++ b/lib/linguist/languages.yml @@ -3386,6 +3386,8 @@ Perl: - ".psgi" - ".t" filenames: + - Makefile.PL + - Rexfile - ack - cpanfile interpreters: @@ -3409,8 +3411,6 @@ Perl 6: - ".pm" - ".pm6" - ".t" - filenames: - - Rexfile interpreters: - perl6 aliases: diff --git a/samples/Perl/Any.pm b/samples/Perl/Any.pm new file mode 100644 index 0000000000..6c53e12c60 --- /dev/null +++ b/samples/Perl/Any.pm @@ -0,0 +1,100 @@ +use strict; #-*-cperl-*- +use warnings; + +use lib qw( ../../../../lib ); + +=encoding utf8 + +=head1 NAME + +Algorithm::Evolutionary::Fitness::Any - Façade for any function so that it can be used as fitness + +=head1 SYNOPSIS + + use Algorithm::Evolutionary::Utils qw( string_decode ) + + sub squares { + my $chrom = shift; + my @values = string_decode( $chrom, 10, -1, 1 ); + return $values[0] * $values[1]; + } + + my $any_eval = new Algorithm::Evolutionary::Fitness::Any \&squares; + + +=head1 DESCRIPTION + +Turns any subroutine or closure into a fitness function. Useful mainly +if you want results cached; it's not really needed otherwise. + +=head1 METHODS + +=cut + +package Algorithm::Evolutionary::Fitness::Any; + +use Carp; + +use base 'Algorithm::Evolutionary::Fitness::Base'; + +our $VERSION = '3.2'; + +=head2 new( $function ) + +Assigns default variables + +=cut + +sub new { + my $class = shift; + my $self = { _function => shift || croak "No functiona rray" }; + bless $self, $class; + $self->initialize(); + return $self; +} + +=head2 apply( $individual ) + +Applies the instantiated problem to a chromosome. It is actually a +wrapper around C<_apply>. + +=cut + +sub apply { + my $self = shift; + my $individual = shift || croak "Nobody here!!!"; + $self->{'_counter'}++; + return $self->_apply( $individual ); +} + +=head2 _apply( $individual ) + +This is the one that really does the stuff. It applies the defined +function to each individual. Itis cached for efficiency. + +=cut + +sub _apply { + my $self = shift; + my $individual = shift || croak "Nobody here!"; + my $chrom = $individual->Chrom(); + my $cache = $self->{'_cache'}; + if ( $cache->{$chrom} ) { + return $cache->{$chrom}; + } + my $result = $self->{'_function'}->($chrom); + if ( (scalar $chrom ) eq $chrom ) { + $cache->{$chrom} = $result; + } + return $result; +} + + +=head1 Copyright + + This file is released under the GPL. See the LICENSE file included in this distribution, + or go to http://www.fsf.org/licenses/gpl.txt + +=cut + +"What???"; diff --git a/samples/Perl/filenames/Makefile.PL b/samples/Perl/filenames/Makefile.PL new file mode 100644 index 0000000000..0492ba5ffd --- /dev/null +++ b/samples/Perl/filenames/Makefile.PL @@ -0,0 +1,20 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Algorithm::Evolutionary::Simple', + AUTHOR => 'JJ Merelo ', + VERSION_FROM => 'lib/Algorithm/Evolutionary/Simple.pm', + ABSTRACT_FROM => 'lib/Algorithm/Evolutionary/Simple.pm', + LICENSE => 'gpl', + EXE_FILES => [ 'script/simple-EA.pl', 'script/maxones.pl'], + PREREQ_PM => { + 'Test::More' => 0, + 'Carp' => 0, + 'Exporter' => 0, + 'Sort::Key::Top' => 0 + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => 'Algorithm-Evolutionary-Simple-*' }, +); diff --git a/samples/Perl/filenames/Rexfile b/samples/Perl/filenames/Rexfile new file mode 100644 index 0000000000..a88b48a7e9 --- /dev/null +++ b/samples/Perl/filenames/Rexfile @@ -0,0 +1,9 @@ +use Rex -feature => ['1.0']; + +user "eleccionesugr"; +group eleccionesugr => "elecciones-ugr.cloudapp.net"; + +desc "Install perlbrew"; +task "perlbrew", group => "eleccionesugr", sub { +}; + diff --git a/test/fixtures/Perl 6/chromosome.pl b/test/fixtures/Perl 6/chromosome.pl new file mode 100644 index 0000000000..82fb719d7c --- /dev/null +++ b/test/fixtures/Perl 6/chromosome.pl @@ -0,0 +1,9 @@ +class Chromosome { + has Seq $.chromosome is rw; + has $.fitness is rw; + +} + +my $len = 32; +my $this-chromosome = Chromosome.new( chromosome => map( { rand >= 0.5 ?? True !! False }, 1..$len ) ); +say $this-chromosome.chromosome();