File Coverage

blib/lib/AI/ParticleSwarmOptimization/MCE.pm

Criterion	Covered	Total	%
statement	105	133	78.9
branch	3	6	50.0
condition	1	3	33.3
subroutine	17	21	80.9
pod	3	3	100.0
total	129	166	77.7

package AI::ParticleSwarmOptimization::MCE;
$AI::ParticleSwarmOptimization::MCE::VERSION = '1.006';
use strict;
use warnings;
use base qw(
	AI::ParticleSwarmOptimization
	Class::Accessor::Fast
);
#-----------------------------------------------------------------------
use Clone 			qw( clone 	 	);
use List::Util 		qw( min shuffle );
use Storable;
use MCE				( Sereal => 0 );
use MCE::Map;
use MCE::Util;
#-----------------------------------------------------------------------
__PACKAGE__->mk_accessors( qw(
	_pop
	_tpl
	_wrk
));
#-----------------------------------------------------------------------
$Storable::Deparse 	= 1;
$Storable::Eval 	= 1;
#=======================================================================
sub new {
    my ($class, %params) = @_;

    #-------------------------------------------------------------------
    my $self = bless {}, $class;
    $self->SUPER::setParams( %params );

    #-------------------------------------------------------------------
	$self->_init_mce( \%params );
	$self->_init_pop( \%params );
	$self->_init_tpl( \%params );

    #-------------------------------------------------------------------
    return $self;
}
#=======================================================================
sub _init_tpl {
	my ( $self, $params ) = @_;

	my $cln = clone( $params );
	delete $cln->{ $_ } for qw(
		-iterCount
		-iterations
		-numParticles
		-workers

		_pop
		_tpl
		_wrk
	);

	$self->_tpl( $cln );

	return;
}
#=======================================================================
sub _init_pop {
	my ( $self, $params ) = @_;

	my $pop = int( $self->{ numParticles } / $self->_wrk );
	my $rst = $self->{ numParticles } % $self->_wrk;

	my @pop = ( $pop ) x $self->_wrk;
	$pop[ 0 ] += $rst;

	$self->_pop( \@pop );
}
#=======================================================================
sub _init_mce {
	my ( $self, $params ) = @_;

	#-------------------------------------------------------------------
	$self->_wrk( $params->{ '-workers' } || MCE::Util::get_ncpu() );

	#-------------------------------------------------------------------
	MCE::Map->init(
		chunk_size 	=> 1,				# Thanks Roy :-)
		#chunk_size => q[auto],			# The old one. Currently it should be the same...
		max_workers => $self->_wrk,
		posix_exit  => 1,				# Thanks Roy :-)
	);

	#-------------------------------------------------------------------
	return;
}
#=======================================================================
sub setParams {
	my ( $self, %params ) = @_;

	my $fles = __PACKAGE__->new( %params );

	$self->{ $_ } = $fles->{ $_ } for keys %$fles;

	return 1;
}
#=======================================================================
sub init {
	my ( $self ) = @_;

	#-------------------------------------------------------------------
	my $pop = $self->{ numParticles };
	$self->{ numParticles } = 1;
	$self->SUPER::init();
	$self->{ numParticles } = $pop;
	$self->{ prtcls } = [ ];

	#-------------------------------------------------------------------
	my $cnt = 0;
	my $tpl = $self->_tpl;

	@{ $self->{ prtcls } } = map {
		$_->{ id } = $cnt++;
		$_
	} mce_map {
		my $arg = clone( $tpl );
		$arg->{ -numParticles } = $_;

		my $swm = AI::ParticleSwarmOptimization->new( %$arg );
		$swm->init;

		@{ $swm->{ prtcls } };

	} @{ $self->_pop };

	#-------------------------------------------------------------------
	return 1;
}
#=======================================================================
sub _chunks {
	my ( $self ) = @_;

	#-------------------------------------------------------------------
	@{ $self->{ prtcls } } = shuffle @{ $self->{ prtcls } };

	#-------------------------------------------------------------------
	my @chk;
	for my $idx ( 0 .. $#{ $self->_pop } ){
		#my $cnt = 0;
		#my @tmp = map {
		#	$_->{ id } = $cnt++;
		#	$_
		#} splice @{ $self->{ prtcls } }, 0, $self->_pop->[ $idx ];

		# Faster and smaller memory consumption...
		my $cnt = 0;
		my @tmp = splice @{ $self->{ prtcls } }, 0, $self->_pop->[ $idx ];
		$_->{ id } = $cnt++ for @tmp;

		push @chk, \@tmp;
	}

	#-------------------------------------------------------------------
	return \@chk;
}
#=======================================================================
sub _updateVelocities {
    my ( $self, $iter ) = @_;

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

	my $tpl = $self->_tpl;

	my @lst = mce_map {
		#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
		my $ary = $_;
		#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
		my $arg = clone( $tpl );
		$arg->{ -numParticles } = 1;

		my $swm = AI::ParticleSwarmOptimization->new( %$arg );
		$swm->init;
		$swm->{ numParticles } = scalar( @$ary );
		$swm->{ prtcls } = $ary;
		#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
		$swm->_updateVelocities( $iter );
		#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
		[
			$swm->{ prtcls 			},
		    $swm->{ bestBest 		},
		]
		#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	} $self->_chunks;

	#-------------------------------------------------------------------
	#my $cnt = 0;
	#@{ $self->{ prtcls } } = map {
	#	$_->{ id } = $cnt++;
	#	$_
	#} map {
	#	@{ $_->[ 0 ] }
	#} @lst;

	# Faster and smaller memory consumption...
	my $cnt = 0;
	@{ $self->{ prtcls } } = map { @{ $_->[ 0 ] } } @lst;
	$_->{ id } = $cnt++ for @{ $self->{ prtcls } };

	#-------------------------------------------------------------------
	$self->{ bestBest } = min grep { defined $_ } map { $_->[ 1 ] } @lst;

	#-------------------------------------------------------------------
	return;
}
#=======================================================================
sub _moveParticles {
    my ( $self, $iter ) = @_;

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

	my $tpl = $self->_tpl;

	my @lst = mce_map {
		#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
		my $ary = $_;
		#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
		my $arg = clone( $tpl );
		$arg->{ -numParticles } = 1;

		my $swm = AI::ParticleSwarmOptimization->new( %$arg );
		$swm->init;
		$swm->{ numParticles } = scalar( @$ary );
		$swm->{ prtcls } = $ary;
		#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
		[
			$swm->_moveParticles( $iter ),
			$swm->{ prtcls }
		]
		#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	} $self->_chunks;

	#-------------------------------------------------------------------
	#my $cnt = 0;
	#@{ $self->{ prtcls } } = map {
	#	$_->{ id } = $cnt++;
	#	$_
	#} map {
	#	@{ $_->[ 1 ] }
	#} @lst;

	# Faster and smaller memory consumption...
	my $cnt = 0;
	@{ $self->{ prtcls } } = map { @{ $_->[ 1 ] } } @lst;
	$_->{ id } = $cnt++ for @{ $self->{ prtcls } };

	#-------------------------------------------------------------------
	return unless grep { defined $_ } map { $_->[ 0 ] } @lst;
	return 1;
}
#=======================================================================
1;

__END__