view release on metacpan or  search on metacpan

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

                  / (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__