AI-SimulatedAnnealing

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN


Revision history for the AI-SimulatedAnnealing distribution:

    Version    Date          Description
    -------    ----          -----------

    1.01       2010-10-06    Initial upload

    1.02       2010-10-09    In t/annealing_tests.t, added a missing
                             "exit" call that will never get used but
                             looked incorrect when it was missing :-)

README  view on Meta::CPAN

AI::SimulatedAnnealing version 1.02

DESCRIPTION

    This distribution includes the following modules:

        AI::SimulatedAnnealing - Exports a single public function,
        anneal(), for optimizing a list of numbers according to a
        specified cost function.

REQUIREMENTS

    These modules require Perl 5, version 5.10.1 or later.

INSTALLATION

    To install the modules included in this distribution, simply copy
    the "AI" directory, with "SimulatedAnnealing.pm" inside it, to a
    location in @INC (for example, "/etc/perl" or "C:\Perl\site\lib").

AUTHOR

    Benjamin Fitch <blernflerkl@yahoo.com>

COPYRIGHT AND LICENSE

    Copyright 2010 by Benjamin Fitch

    This library is free software; you can redistribute it and/or
    modify it under the same terms as Perl itself.

lib/AI/SimulatedAnnealing.htm  view on Meta::CPAN

<?xml version="1.0"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
  <head>
    <title>AI::SimulatedAnnealing &#8211; optimize a list of numbers
      according to a specified cost function.</title>
    <meta http-equiv="content-type" content="text/html; charset=utf-8"/>
    <link href="mailto:" rev="made"/>
  </head>
  <body style="background-color: white">
    <ul>
      <li><a href="#name">NAME</a></li>
      <li><a href="#synopsis">SYNOPSIS</a></li>
      <li><a href="#description">DESCRIPTION</a></li>
      <li><a href="#prerequisites">PREREQUISITES</a></li>
      <li><a href="#methods">METHODS</a></li>
      <li><a href="#author">AUTHOR</a></li>
      <li><a href="#copyright_and_license">COPYRIGHT AND LICENSE</a></li>
    </ul>
    <hr/>
    <h1><a name="name">NAME</a></h1>
    <p>AI::SimulatedAnnealing &#8211; optimize a list of numbers according
      to a specified cost function.</p>
    <hr/>
    <h1><a name="synopsis">SYNOPSIS</a></h1>
    <pre>
  <span class="keyword">use</span> <span class="variable">AI::SimulatedAnnealing</span><span class="operator">;</span>
</pre>
    <pre>
  <span class="variable">$optimized_list</span> <span class="operator">=</span> <span class="variable">anneal</span><span class="operator">(</span><span class="variable">$number_specs</span><span class="operator">,</span> <span class="variable">$cost...
</pre>
    <hr/>
    <h1><a name="description">DESCRIPTION</a></h1>
    <p>This module provides a single public function, <a
      href="#anneal"><code>anneal()</code></a>, that optimizes a list of
      numbers according to a specified cost function.</p>
    <p>Each number to be optimized has a lower bound, an upper bound, and a
      precision, where the precision is an integer in the range 0&#8211;4
      that specifies the number of decimal places to which all instances of
      the number will be rounded. The upper bound must be greater than the
      lower bound but not greater than 10 to the power of
      <code>(4&#160;-&#160;p)</code>, where <code>p</code> is the precision.
      The lower bound must be not less than <code>-1</code> times the result
      of taking 10 to the power of <code>(4&#160;-&#160;p)</code>.</p>
    <p>A bound that has a higher degree of precision than that specified for
      the number to which the bound applies is rounded inward (that is,
      downward for an upper bound and upward for a lower bound) to the
      nearest instance of the specified precision.</p>
    <p>The attributes of a number (bounds and precision) are encapsulated
      within a number specification, which is a reference to a hash
      containing <code>&quot;LowerBound&quot;</code>,
      <code>&quot;UpperBound&quot;</code>, and
      <code>&quot;Precision&quot;</code> fields.</p>
    <p>The <a href="#anneal"><code>anneal()</code></a> function takes a
      reference to an array of number specifications, a cost function, and a
      positive integer specifying the number of randomization cycles per
      temperature to perform. The <code>anneal()</code> function returns a
      reference to an array having the same length as the array of number
      specifications. The returned list represents the optimal list of
      numbers matching the specified attributes, where &quot;optimal&quot;
      means producing the lowest cost.</p>
    <p>The cost function must take a reference to an array of numbers that
      match the number specifications. The function must return a single
      number representing a cost to be minimized.</p>
    <p>In order to work efficiently with the varying precisions, the
      <code>anneal()</code> function converts each bound to an integer by
      multiplying it by 10 to the power of the precision; then the function
      performs the temperature reductions and randomization cycles (which
      include tests performed via calls to the cost function) on integers in
      the resulting ranges. When passing an integer to the cost function or
      when storing the integer in a collection of numbers to be returned by
      the function, <code>anneal()</code> first converts the integer back to
      the appropriate decimal number by dividing the integer by 10 to the
      power of the precision.</p>
    <p>The initial temperature is the size of the largest range after the
      bounds have been converted to integers. During each temperature
      reduction, the <code>anneal()</code> function multiplies the
      temperature by 0.95 and then rounds the result down to the nearest
      integer (if the result isn&#39;t already an integer). When the
      temperature reaches zero, annealing is immediately terminated.</p>
    <p style="margin-left: 13px;"><b>Note:</b>  Annealing can sometimes
      complete before the temperature reaches zero if, after a particular
      temperature reduction, a brute-force optimization approach (that is,
      testing every possible combination of numbers within the subranges
      determined by the new temperature) would produce a number of tests
      that is less than or equal to the specified cycles per temperature.
      In that case, the <code>anneal()</code> function performs the
      brute-force optimization to complete the annealing process.</p>
    <p>After a temperature reduction, the <code>anneal()</code> function
      determines each new subrange such that the current optimal integer
      from the total range is as close as possible to the center of the new
      subrange. When there is a tie between two possible positions for the
      subrange within the total range, a &quot;coin flip&quot; decides.</p>
    <hr/>
    <h1><a name="prerequisites">PREREQUISITES</a></h1>
    <p>This module requires Perl 5, version 5.10.1 or later.</p>
    <hr/>
    <h1><a name="methods">METHODS</a></h1>
    <dl>
      <dt><strong><a class="item" name="anneal">anneal($number_specs,
        $cost_function, $cycles_per_temperature);</a></strong></dt>
      <dd>
        <p>The <code>anneal()</code> function takes a reference to an array
          of number specifications (which are references to hashes
          containing <code>&quot;LowerBound&quot;</code>,
          <code>&quot;UpperBound&quot;</code>, and
          <code>&quot;Precision&quot;</code> fields), a code reference
          pointing to a cost function (which takes a list of numbers
          matching the specifications and returns a number representing a
          cost to be minimized), and a positive integer specifying the
          number of randomization cycles to perform at each temperature.</p>
        <p>The function returns a reference to an array containing the
          optimized list of numbers.</p>
      </dd>
    </dl>
    <hr/>
    <h1><a name="author">AUTHOR</a></h1>
    <p>Benjamin Fitch, &lt;<a
      href="mailto:blernflerkl@yahoo.com">blernflerkl@yahoo.com</a>&gt;</p>
    <hr/>
    <h1><a name="copyright_and_license">COPYRIGHT AND LICENSE</a></h1>
    <p>Copyright 2010 by Benjamin Fitch.</p>
    <p>This library is free software; you can redistribute it and/or modify
      it under the same terms as Perl itself.</p>
  </body>
</html>

lib/AI/SimulatedAnnealing.pm  view on Meta::CPAN

use Scalar::Util ("looks_like_number");

use Exporter;

# Version:
our $VERSION = '1.02';

# Specify default exports:
our @ISA = ("Exporter");
our @EXPORT = (
  "anneal",
  );

# Constants:
my $POUND     = "#";
my $SQ        = "'";
my $DQ        = "\"";
my $SEMICOLON = ";";
my $CR        = "\r";
my $LF        = "\n";
my $SPACE     = " ";
my $EMPTY     = "";

lib/AI/SimulatedAnnealing.pm  view on Meta::CPAN

# specifications (which are references to hashes containing "LowerBound",
# "UpperBound", and "Precision" fields), a reference to a cost function
# (which takes a list of numbers matching the specifications and returns a
# number representing a cost to be minimized), and a positive integer
# specifying the number of randomization cycles to perform at each
# temperature during the annealing process.
#
# The function returns a reference to an array containing the
# optimized list of numbers.
sub anneal {
    my $number_specs = validate_number_specs($_[0]);
    my $cost_function = $_[1];
    my $cycles_per_temperature = $_[2];

    my $current_temperature;
    my $lowest_cost;

    my @integral_lower_bounds;
    my @integral_upper_bounds;
    my @optimized_list;

    $current_temperature = 1;

    for my $number_spec (@{ $number_specs }) {
        push @integral_lower_bounds, int($number_spec->{"LowerBound"}
          * (10 ** $number_spec->{"Precision"}));
        push @integral_upper_bounds, int($number_spec->{"UpperBound"}
          * (10 ** $number_spec->{"Precision"}));

        if ($integral_upper_bounds[-1] - $integral_lower_bounds[-1]
          > $current_temperature) {
            $current_temperature
              = $integral_upper_bounds[-1] - $integral_lower_bounds[-1];
        } # end if
    } # next $number_spec

    while ($current_temperature > 0) {
        my @adjusted_lower_bounds;
        my @adjusted_upper_bounds;

        # Calculate the temperature-adjusted bounds:
        for my $dex (0..$#integral_lower_bounds) {
            if ($current_temperature >= $integral_upper_bounds[$dex]
              - $integral_lower_bounds[$dex] || !defined($lowest_cost)) {
                push @adjusted_lower_bounds, $integral_lower_bounds[$dex];
                push @adjusted_upper_bounds, $integral_upper_bounds[$dex];
            }
            else {
                my $adjusted_lower_bound;
                my $adjusted_upper_bound;
                my $half_range = $current_temperature / 2.0;

                if (floor($half_range) != $half_range) {
                    my $rand = rand();

                    if ($rand >= 0.5) {
                        $half_range = ceil($half_range);
                    }
                    else {
                        $half_range = floor($half_range);
                    } # end if
                } # end if

                $adjusted_lower_bound = int($optimized_list[$dex]
                  * (10 ** $number_specs->[$dex]->{"Precision"})
                  - $half_range);

                if ($adjusted_lower_bound < $integral_lower_bounds[$dex]) {
                    $adjusted_lower_bound = $integral_lower_bounds[$dex];
                }
                elsif ($adjusted_lower_bound + $current_temperature
                  > $integral_upper_bounds[$dex]) {
                    $adjusted_lower_bound = $integral_upper_bounds[$dex]
                      - $current_temperature;
                } # end if

                $adjusted_upper_bound
                  = $adjusted_lower_bound + $current_temperature;

                push @adjusted_lower_bounds, $adjusted_lower_bound;
                push @adjusted_upper_bounds, $adjusted_upper_bound;
            } # end if
        } # next $dex

        # Determine whether brute force is appropriate, and if so, use it:
        my $combinations
          = 1 + $adjusted_upper_bounds[0] - $adjusted_lower_bounds[0];

        for my $dex (1..$#adjusted_upper_bounds) {
            if ($combinations > $cycles_per_temperature) {
                $combinations = 0;
                last;
            } # end if

            $combinations *= (1 + $adjusted_upper_bounds[$dex]
              - $adjusted_lower_bounds[$dex]);
        } # next $dex

        if ($combinations > 0 && $combinations <= $cycles_per_temperature) {
            my @adjusted_number_specs;

            # Create the adjusted number specifications:
            for my $dex (0..$#{ $number_specs }) {
                push @adjusted_number_specs, {
                  "LowerBound" => $adjusted_lower_bounds[$dex]
                  / (10 ** $number_specs->[$dex]->{"Precision"}),
                  "UpperBound" => $adjusted_upper_bounds[$dex]
                  / (10 ** $number_specs->[$dex]->{"Precision"}),
                  "Precision" => $number_specs->[$dex]->{"Precision"}};
            } # next $dex

            # Perform the brute-force analysis:
            @optimized_list = @{ use_brute_force(
              \@adjusted_number_specs, $cost_function) };

            # Break out of the temperature-reduction loop:
            last;
        } # end if

        # Perform randomization cycles:
        for (1..$cycles_per_temperature) {
            my @candidate_list;
            my $cost;

            for my $dex (0..$#adjusted_lower_bounds) {
                my $rand = rand();
                my $addend = floor($rand * (1 + $adjusted_upper_bounds[$dex]
                  - $adjusted_lower_bounds[$dex]));

                push @candidate_list,
                  ($adjusted_lower_bounds[$dex] + $addend)
                  / (10 ** $number_specs->[$dex]->{"Precision"});
            } # next $dex

            $cost = $cost_function->(\@candidate_list);

            unless (defined($lowest_cost) && $cost >= $lowest_cost) {
                $lowest_cost = $cost;
                @optimized_list = @candidate_list;
            } # end unless
        } # next cycle

        # Reduce the temperature:
        $current_temperature = floor(
          $current_temperature * $TEMPERATURE_MULTIPLIER);
    } # end while

    return \@optimized_list;
} # end sub

####
# Private helper functions for use by this module:

# The use_brute_force() function takes a reference to an array of number
# specifications (which are references to hashes containing "LowerBound",
# "UpperBound", and "Precision" fields) and a reference to a cost function
# (which takes a list of numbers matching the specifications and returns a
# number representing a cost to be minimized).  The method tests every
# possible combination of numbers matching the specifications and returns a
# reference to an array containing the optimal numbers, where "optimal"
# means producing the lowest cost.
sub use_brute_force {
    my $number_specs = validate_number_specs($_[0]);
    my $cost_function = $_[1];

    my @optimized_list;
    my @lists;
    my @cursors;

    # Populate the list of lists of numbers:
    for my $number_spec (@{ $number_specs }) {
        my @list;
        my $num = $number_spec->{"LowerBound"};

        while ($num <= $number_spec->{"UpperBound"}) {
            push @list, $num;
            $num += 1 / (10 ** $number_spec->{"Precision"});
        } # end while

        push @lists, \@list;
    } # next $number_spec

    # Populate @cursors with the starting position for each list of numbers:
    for (0..$#lists) {
        push @cursors, 0;
    } # next

    # Perform the tests:
    my $lowest_cost = undef;
    my $finished = $FALSE;

    do {
        # Perform a test using the current cursors:
        my @candidate_list;
        my $cost;

        for my $dex (0..$#lists) {
            push @candidate_list, $lists[$dex]->[$cursors[$dex]];
        } # next $dex

        $cost = $cost_function->(\@candidate_list);

        unless (defined($lowest_cost) && $cost >= $lowest_cost) {
            $lowest_cost = $cost;
            @optimized_list = @candidate_list;
        } # end unless

        # Adjust the cursors for the next test if not finished:
        for my $dex (reverse(0..$#lists)) {
            my $cursor = $cursors[$dex];

            if ($cursor < $#{ $lists[$dex] }) {
                $cursor++;
                $cursors[$dex] = $cursor;
                last;
            }
            elsif ($dex == 0) {
                $finished = $TRUE;
                last;
            }
            else {
                $cursors[$dex] = 0;
            } # end if
        } # next $dex
    } until ($finished);

    # Return the result:
    return \@optimized_list;
} # end sub

# The validate_number_specs() function takes a reference to an array of
# number specifications (which are references to hashes with "LowerBound",
# "UpperBound", and "Precision" fields) and returns a reference to a version
# of the array in which bounds with higher precision than that specified
# have been rounded inward.  If a number specification is not valid, the
# function calls "die" with an error message.
sub validate_number_specs {
    my $raw_number_specs = $_[0];
    my @processed_number_specs = @{ $raw_number_specs };

    for my $number_spec (@processed_number_specs) {
        my $lower_bound = $number_spec->{"LowerBound"};
        my $upper_bound = $number_spec->{"UpperBound"};
        my $precision = $number_spec->{"Precision"};

        unless (looks_like_number($precision)
          && int($precision) == $precision
          && $precision >= 0 && $precision <= 4) {
            die "ERROR:  In a number specification, the precision must be "
              . "an integer in the range 0 to 4.\n";
        } # end unless

        unless (looks_like_number($lower_bound)
          && looks_like_number($upper_bound)
          && $upper_bound > $lower_bound
          && $upper_bound <= 10 ** (4 - $precision)
          && $lower_bound >= -1 * (10 ** (4 - $precision))) {
            die "ERROR:  In a number specification, the lower and upper "
              . "bounds must be numbers such that the upper bound is "
              . "greater than the lower bound, the upper bound is not "
              . "greater than 10 to the power of (4 - p) where p is the "
              . "precision, and the lower bound is not less than -1 times "
              . "the result of taking 10 to the power of (4 - p).\n";
        } # end unless

        # Round the bounds inward as necessary:
        my $integral_lower_bound = ceil( $lower_bound * (10 ** $precision));
        my $integral_upper_bound = floor($upper_bound * (10 ** $precision));

        $number_spec->{"LowerBound"}
          = $integral_lower_bound / (10 ** $precision);
        $number_spec->{"UpperBound"}
          = $integral_upper_bound / (10 ** $precision);
    } # next $number_spec

    return \@processed_number_specs;
} # end sub

# Module return value:
1;
__END__

=head1 NAME

AI::SimulatedAnnealing - optimize a list of numbers according to a specified
cost function.

=head1 SYNOPSIS

  use AI::SimulatedAnnealing;

  $optimized_list = anneal(
    $number_specs, $cost_function, $cycles_per_temperature);

=head1 DESCRIPTION

This module provides a single public function, anneal(), that optimizes
a list of numbers according to a specified cost function.

Each number to be optimized has a lower bound, an upper bound, and a
precision, where the precision is an integer in the range 0 to 4 that
specifies the number of decimal places to which all instances of the
number will be rounded.  The upper bound must be greater than the

lib/AI/SimulatedAnnealing.pm  view on Meta::CPAN

converts the integer back to the appropriate decimal number by
dividing the integer by 10 to the power of the precision.

The initial temperature is the size of the largest range after the
bounds have been converted to integers.  During each temperature
reduction, the anneal() function multiplies the temperature by 0.95
and then rounds the result down to the nearest integer (if the result
isn't already an integer).  When the temperature reaches zero,
annealing is immediately terminated.

  NOTE:  Annealing can sometimes complete before the temperature
  reaches zero if, after a particular temperature reduction, a
  brute-force optimization approach (that is, testing every possible
  combination of numbers within the subranges determined by the new
  temperature) would produce a number of tests that is less than or
  equal to the specified cycles per temperature.  In that case, the
  anneal() function performs the brute-force optimization to complete
  the annealing process.

After a temperature reduction, the anneal() function determines each
new subrange such that the current optimal integer from the total
range is as close as possible to the center of the new subrange.
When there is a tie between two possible positions for the subrange
within the total range, a "coin flip" decides.

=head1 PREREQUISITES

This module requires Perl 5, version 5.10.1 or later.

t/annealing_tests.t  view on Meta::CPAN

my $FALSE     = 0;

my $CYCLES_PER_TEMPERATURE = 1_250;

# Main script:

# Get the input file path:
my $bsv_file_path = $ARGV[0];

unless (scalar @ARGV) {
    die "ERROR:  No command-line argumment.  Please provide the path to a "
      . "valid BSV (or simple CSV) file containing market distances.\n";
} # end unless

# Create a reader for the BSV file:
my $bsv_file_reader;

eval {
    $bsv_file_reader = Text::BSV::BsvFileReader->new($bsv_file_path);
};

if ($EVAL_ERROR) {
    my $exception = $EVAL_ERROR;

    given ($exception->get_type()) {
        when ($Text::BSV::Exception::FILE_NOT_FOUND) {
            say STDERR "$DQ$bsv_file_path$DQ is not a valid file path.";
            exit(1);
        }
        when ($Text::BSV::Exception::IO_ERROR) {
            say STDERR "Couldn't open $DQ$bsv_file_path$DQ for reading.";
            exit(1);
        }
        when ($Text::BSV::Exception::INVALID_DATA_FORMAT) {
            say STDERR "Invalid BSV data:  " . $exception->get_message();
            exit(1);
        }
        default {
            say STDERR $exception->get_message();
            exit(1);
        } # end when
    } # end given
} # end if

# Generate a list of distances for each probability from the data in the
# BSV file:
my $field_names = $bsv_file_reader->get_field_names();
my @mapped_distances; # indexes 2-5 = Probability constants;
                      # values = references to number arrays

for my $p (2..5) {
    $mapped_distances[$p] = [];
} # next $p

unless ($field_names->[0] eq "Time"
  && $field_names->[1] =~ /$Probability::ONE_FIFTH\z/s
  && $field_names->[2] =~ /$Probability::ONE_FOURTH\z/s
  && $field_names->[3] =~ /$Probability::ONE_THIRD\z/s
  && $field_names->[4] =~ /$Probability::ONE_HALF\z/s) {
    die "ERROR:  The input file does not contain market-distance data in "
      . "the expected format.\n";
} # end unless

while ($bsv_file_reader->has_next()) {
    my $record;
    my $dex;

    eval {
        $record = $bsv_file_reader->get_record();
    };

    if ($EVAL_ERROR) {
        given ($EVAL_ERROR->get_type()) {
            when ($Text::BSV::Exception::INVALID_DATA_FORMAT) {
                die "ERROR:  Invalid BSV data:  "
                  . $EVAL_ERROR->get_message() . $LF;
            }
            default {
                die "ERROR:  " . $EVAL_ERROR->get_message() . $LF;
            } # end when
        } # end given
    } # end if

    $dex = $record->{"Time"} - 3;

    unless ($dex >= 0
      && $dex <= scalar($mapped_distances[$Probability::ONE_FIFTH])) {
        die "ERROR:  The input file does not contain market-distance data "
          . "in the expected format.\n";
    } # end unless

    for my $p (2..5) {
        push @{ $mapped_distances[$p] }, $record->{$field_names->[6 - $p]};
    } # next $p
} # end while

unless (scalar @{ $mapped_distances[$Probability::ONE_FIFTH] } == 61) {
    die "ERROR:  The input file does not contain the expected number of "
      . "records.\n";
} # end unless

# Perform simulated annealing to optimize the coefficients for each of the
# four probabilities, and then print the results to the console:
for my $p (2..5) {
    my $cost_function = cost_function_factory($mapped_distances[$p]);
    my $optimized_coefficients;
    my @number_specs;

    push @number_specs,
      {"LowerBound" =>  0.0, "UpperBound" => 3.0, "Precision" => 3};
    push @number_specs,
      {"LowerBound" => -1.0, "UpperBound" => 5.0, "Precision" => 3};
    push @number_specs,
      {"LowerBound" => -4.0, "UpperBound" => 0.0, "Precision" => 3};

    $optimized_coefficients = anneal(
      \@number_specs, $cost_function, $CYCLES_PER_TEMPERATURE);

    # Print the results for this probability to the console:
    say "\nProbability:  1/$p";
    printf("Coefficients:  a = %1.3f; b = %1.3f; c= %1.3f\n",
      $optimized_coefficients->[0],
      $optimized_coefficients->[1],
      $optimized_coefficients->[2]);
    say "Cost:  " . $cost_function->($optimized_coefficients);
} # next $p

# Perform an annealing test with integers that triggers brute-force analysis
# and uses an anonymous cost function that minimizes this sum:
#
#     (10 * abs(23 - val)) + (the total range of a, b, and c)
#
# where "val" is the result of following expression:
#
#     (a * (x ** 2)) + bx + c
#
# in which x = 3:
my $abc;
my @number_specs;

push @number_specs,
  {"LowerBound" =>  1.9, "UpperBound" => 4, "Precision" => 0};
push @number_specs,
  {"LowerBound" =>  0.0, "UpperBound" => 2, "Precision" => 0};
push @number_specs,
  {"LowerBound" => -4.0, "UpperBound" => 8, "Precision" => 0};

$abc = anneal(\@number_specs,
  sub {
    my $nums = $_[0];
    my $range = max(@{ $nums }) - min(@{ $nums });
    my $val = ($nums->[0] * 9) + ($nums->[1] * 3) + $nums->[2];
    my $cost = $range + (10 * abs(23 - $val));

    return $cost;
  }, 120);

say "\nHere are a, b, and c:  " . $abc->[0] . ", "
  . $abc->[1] . ", " . $abc->[2];

# Helper functions:

# The cost_function_factory() takes a reference to an array containing
# real-world market distances and returns a reference to a cost function.
# The cost function takes a reference to an array of three coefficients,
# and returns the mean absolute percentage deviation of the calculated
# results from the real-world results based on this formula:
#
#     (a * sqrt(x + b)) + c
#
# where x is a number of trading days in the range 3 to 63.
sub cost_function_factory {
    my $real_world_distances = $_[0];
    my $current_coefficients;

    my $calculate_distance
      = sub {
        my $trading_days = $_[0];
        my $distance = ($current_coefficients->[0]
          * sqrt($trading_days + $current_coefficients->[1]))
          + $current_coefficients->[2];

        return $distance;
      };

    my $cost_function
      = sub {
        my $coefficients = $_[0];

        my @calculated_distances;
        my $cumulative_deviation;
        my $cost;

        $current_coefficients = $coefficients;

        for my $trading_days (3..63) {
            push @calculated_distances,
              $calculate_distance->($trading_days);
        } # next $trading_days

        for my $dex (0..60) {
            $cumulative_deviation
              += (100 * abs($calculated_distances[$dex]
              - $real_world_distances->[$dex])
              / $real_world_distances->[$dex]);
        } # next $dex

        $cost = $cumulative_deviation / 61;

        return $cost;
      };

    return $cost_function;
} # end sub



( run in 0.272 second using v1.01-cache-2.11-cpan-4d50c553e7e )