view release on metacpan or  search on metacpan

lib/Algorithm/SpiralSearch.pm  view on Meta::CPAN

package Algorithm::SpiralSearch;

#use 5.004;
use strict;
use warnings;
use Carp;
#use Math::Gradient 0.01;
use Math::Gradient;


require Exporter;

our @ISA         = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
our @EXPORT_OK   = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT      = qw(spiral_search);
our $VERSION     = '1.20';

sub spiral_search {
   my $usage = '($opt_x, $opt_y) = spiral_search($lower_boundx,$upper_boundx,' .
               '$lower_boundy,$upper_boundy,$iterations,$function,' .
               "'MAX|MIN')";

   my ($lbx, $ubx, $lby, $uby, $iters, $f, $max_or_min) = @_;

   croak 'A valid input/output funtion reference must be passed in'
      unless $f =~ /CODE/;

   croak 'Two or more iterations are required : ' if $iters < 2;
   croak 'Upper boundary on first parameter must be non-zero : ' if $ubx == 0.0;
   croak 'Upper boundary on second parameter must be non-zero : '
      if $uby == 0.0;

   croak 'Final parameter must be set to MAX or MIN : '
      unless $max_or_min =~ /MAX|MIN/i;

   # Set the initial start points to half the distances of the search space
   # extrema.
   my $x_init = ($ubx - $lbx) / 2;
   my $y_init = ($uby - $lby) / 2;

   # Find the gradients of each axis.
   my @grad_x = Math::Gradient::gradient($lbx, $ubx, $iters);
   my @grad_y = Math::Gradient::gradient($lby, $uby, $iters);

   my @x             = ();
   my @y             = ();
   my @nrv_ary       = ();
   my $x_inc         = $grad_x[1] - $grad_x[0];
   my $y_inc         = $grad_y[1] - $grad_y[0];
   my $maximize      = $max_or_min =~ /^\s*MIN\s*$/i ? -1 : 1;
   my $ret_val       = 0;
   my $new_ret_val   = 0;
   my $theta         = 0;
   my $best_x        = 0;
   my $best_y        = 0;
   my $out_of_bounds = 0;

   # Increase the radius of the search by the following factor
   # if a better function evaluation is not found.
   my $rad_inc  = 1.2;

   my $bounded  = 1;
   my $radius_x = 1;
   my $radius_y = 1;

   for (my $t = $iters; $t >= 1; $t--) {
      # Follow the spiral inwards.
      $theta   = atan2($grad_y[$t-1], $grad_x[$t-1]);
      $x[$t-1] = $x_init + $radius_x * exp(-0.1 * $theta) * cos($t);
      $y[$t-1] = $y_init + $radius_y * exp(-0.1 * $theta) * sin($t);

      # Make sure our spiral is within boundaries.
      if ($bounded) {
         if ($x[$t-1] < $lbx || $x[$t-1] > $ubx || $y[$t-1] < $lby ||
             $y[$t-1] > $uby)
         {
            $out_of_bounds = 1;
         } else {
            $out_of_bounds = 0;
         }
      }

      # If our new evaluation point is out of bounds, do not proceed with the
      # function evaluation.  Otherwise, continue.
      if (! $out_of_bounds) {
         # Evaluate the new parameters.
         $nrv_ary[$t-1] = $new_ret_val = &{$f}($x[$t-1], $y[$t-1]);

         # If the new result was better than the previous, increase the spiral's
         # radius.