File Coverage

blib/lib/AI/ParticleSwarmOptimization/Pmap.pm

Criterion	Covered	Total	%
statement	65	78	83.3
branch	7	18	38.8
condition	3	9	33.3
subroutine	10	10	100.0
pod			n/a
total	85	115	73.9

package AI::ParticleSwarmOptimization::Pmap;

use strict;
use warnings;
use base qw(
	AI::ParticleSwarmOptimization
);
#-----------------------------------------------------------------------
use List::Util 					qw( min );
use Parallel::parallel_map;
#-----------------------------------------------------------------------
$AI::ParticleSwarmOptimization::Pmap::VERSION = '1.004';
#=======================================================================
sub _initParticles {
    my ($self) = @_;

	@{ $self->{ prtcls } } = map {
		my %prt = ( id => $_ );
		$self->_initParticle( \%prt );
		\%prt;
	} 0 .. $self->{ numParticles } - 1;
}
#=======================================================================
sub _moveParticles {
    my ($self, $iter) = @_;

    print "Iter $iter\n" if $self->{verbose} & AI::ParticleSwarmOptimization::kLogIter;

	my @lst = grep { defined $_ } parallel_map {
		my $prtcl = $_;
		#---------------------------------------------------------------
		@{$prtcl->{currPos}} = @{$prtcl->{nextPos}};
        $prtcl->{currFit} = $prtcl->{nextFit};

        my $fit = $prtcl->{currFit};

        if ($self->_betterFit ($fit, $prtcl->{bestFit})) {
            # Save position - best fit for this particle so far
            $self->_saveBest ($prtcl, $fit, $iter);
        }

		my $ret;
		if( defined $self->{exitFit} and $fit < $self->{exitFit} ){
			$ret = $fit;
		}elsif( !($self->{verbose} & AI::ParticleSwarmOptimization::kLogIterDetail) ){
			$ret = undef;
		}else{
			printf "Part %3d fit %8.2f", $prtcl->{id}, $fit
				if $self->{verbose} >= 2;
			printf " (%s @ %s)",
				join (', ', map {sprintf '%5.3f', $_} @{$prtcl->{velocity}}),
				join (', ', map {sprintf '%5.2f', $_} @{$prtcl->{currPos}})
				if $self->{verbose} & AI::ParticleSwarmOptimization::kLogDetail;
			print "\n";

			$ret = undef;
		}
		#---------------------------------------------------------------
		[ $prtcl, $ret ]
	} @{ $self->{ prtcls } };

	@{ $self->{ prtcls } } = map { $_->[ 0 ] } @lst;

	$self->{ bestBest } = min map { $_->{ bestFit } } @{ $self->{ prtcls } };

	my @fit = map { $_->[ 1 ] } grep { defined $_->[ 1 ] } @lst;

    return scalar( @fit ) ? ( sort { $a <=> $b } @fit )[ 0 ] : undef;
}
#=======================================================================
sub _updateVelocities {
    my ($self, $iter) = @_;

	@{ $self->{ prtcls } } = parallel_map {
		my $prtcl = $_;
		#---------------------------------------------------------------
		my $bestN = $self->{prtcls}[$self->_getBestNeighbour ($prtcl)];
        my $velSq;

        for my $d (0 .. $self->{dimensions} - 1) {
            my $meFactor =
                $self->_randInRange (-$self->{meWeight}, $self->{meWeight});
            my $themFactor =
                $self->_randInRange (-$self->{themWeight}, $self->{themWeight});
            my $meDelta   = $prtcl->{bestPos}[$d] - $prtcl->{currPos}[$d];
            my $themDelta = $bestN->{bestPos}[$d] - $prtcl->{currPos}[$d];

            $prtcl->{velocity}[$d] =
                $prtcl->{velocity}[$d] * $self->{inertia} +
                $meFactor * $meDelta +
                $themFactor * $themDelta;
            $velSq += $prtcl->{velocity}[$d]**2;
        }

        my $vel = sqrt ($velSq);
        if (!$vel or $self->{stallSpeed} and $vel <= $self->{stallSpeed}) {
            $self->_initParticle ($prtcl);
            printf "#%05d: Particle $prtcl->{id} stalled (%6f)\n", $iter, $vel
                if $self->{verbose} & AI::ParticleSwarmOptimization::kLogStall;
        }

        $self->_calcNextPos ($prtcl);
		#---------------------------------------------------------------
		$prtcl;
	} @{ $self->{ prtcls } };
}
#=======================================================================
1;

__END__