comment on

camelcom,
The following heuristic approach does amazingly well with the given data set. It can be improved further by not calculating the last fragment since whatever is left must go in it. I left it the way it is in case it was possible that the total of all fragments was less than the total quantity.

The algorithm works as follows:

Fill the fragments with the fewest items to the most
Choose the item that will bring the average closest to the target average

The binary search could be improved and some of the math is duplicated so there are speed improvements to be had. There may also be bugs to be squashed as I wrote it in a hurry.

#!/usr/bin/perl
use strict;
use warnings;
use List::Util 'sum';

my @data;
while (<DATA>) {
    chomp;
    my ($quantity, $cost) = split /\s*@\s*/;
    push @data, ($cost) x $quantity;
}

@data = sort {$a <=> $b} @data;


my %fragment = (
    A => {count => 65, ave => 0, items => 0},
    B => {count => 12, ave => 0, items => 0},
    C => {count => 24, ave => 0, items => 0},
    D => {count => 19, ave => 0, items => 0},
);

my $tgt_ave = sum(@data) / @data;
for my $frag (sort {$fragment{$a}{count} <=> $fragment{$b}{count}} key
+s %fragment) {
    for (1 .. $fragment{$frag}{count}) {
        my ($cnt, $ave) = @{$fragment{$frag}}{qw/items ave/};
        my $best = ($tgt_ave * $cnt) + $tgt_ave - ($ave * $cnt);
        my $idx = find_best(\@data, $best, $ave, $tgt_ave, $cnt);
        my $val = splice(@data, $idx, 1);
        #push @{$fragment{$frag}{val}}, $val;
        ++$fragment{$frag}{items};
        $fragment{$frag}{ave} = (($ave * $cnt) + $val) / ($cnt + 1);
    }
}

use Data::Dumper;
print Dumper(\%fragment);

# if not exact match, pick the one that brings the average closest to 
+desired average
sub find_best {
    my ($data, $best, $ave, $tgt_ave, $cnt) = @_;

    my ($beg, $end, $mid) = (0, $#$data, undef);
    while ($beg <= $end) {
        $mid = $beg + ($end - $beg) / 2;
        my $val = $data->[$mid];
        if ($val > $best) {
            $end = $mid - 1;
        }
        elsif ($val < $best) {
            $beg = $mid + 1;
        }
        else {
            return $mid;
        }
    }
    $mid = int $mid;
    my $minus_1 = $mid > 0 ? $mid - 1 : undef;
    my $plus_1 = $mid < $#$data ? $mid + 1 : undef;
    my ($min, $idx);
    for ($minus_1, $mid, $plus_1) {
        next if ! defined $_;
        my $val = $data->[$_];
        my $new_ave = (($ave * $cnt) + $val) / ($cnt + 1);
        my $diff = abs($tgt_ave - $new_ave);
        if (! defined $min || $diff < $min) {
            ($min, $idx) = ($diff, $_);
        }
    }
    return $idx;
}
__DATA__
5 @ 93.8
20 @ 93.81
10 @ 93.82
15 @ 93.83
25 @ 93.84
5 @ 93.85
20 @ 93.87
5 @ 94
35 @ 94.1
10 @ 94.2
[download]

Cheers - L~R

In reply to Re: Average Price Algorithm by Limbic~Region
in thread Average Price Algorithm by camelcom

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Do you know where your variables are?
	PerlMonks