eda-tools/old-boom/part2order

#!/usr/bin/perl

require "parser.pl";
require "misc.pl";

$mult = shift(@ARGV);
&parse;


sub number
{
    local ($id) = @_;

    my $s = $inv{$id}[0];
    my $n = $want{$id}*$mult;
    return $n < $s ? $n : $s;

}


#
# The heuristics here aren't very nice. We give zero-cost stock priority over
# any other stock, when we go by stock size up to the quantity we need. The
# idea is to exhause local stock (zero-cost) first, then try to obtain the
# parts with as few orders as possible.
#
# It would be better to have some sort of priority, so that we can express a
# preference among stock we already own. Also, if non-zero-cost stock has widly
# different prices, the smallest order cost may not be a good indicator of
# which source we prefer.
#
# Furthermore, the algorithm doesn't consider the number of sources we use in
# total or things like lead time, shipping cost, customs, etc.
#

sub rank
{
    local ($a, $b) = @_;

    my $na = &number($a);	# min(number wanted, available)
    my $nb = &number($b);
    my $pa = $inv{$a}[3];	# per unit price for smallest quantum
    my $pb = $inv{$b}[3];

#print STDERR "a=$a b=$b na=$na nb=$nb pa=$pa pb=$pb\n";
    return 1 if $na && !$pa && $pb;
    return -1 if $nb && $pa && !$pb;
    return $na <=> $nb if $na != $nb;
    return $pb <=> $pa;
}


for (keys %parts) {
    $parts++;
}

print "#ORD\n";
for (sort { &rank($b, $a) } keys %want) {
    my $n = &number($_);
    $n -= $n % $mult;
    next unless $n;
    my @f = @{ $inv{$_} };
    my $max = shift @f;
    my $currency = shift @f;
    my @qty;
    my @price;
    my %index;
    my $best_qty;
    my $best_price = undef;
    while (@f) {
	my $q = shift @f;
	my $p = shift @f;
	if (defined $index{$q}) {
	    $price[$index{$q}] = $p;
	} else {
	    push(@qty, $q);
	    push(@price, $p);
	    $index{$q} = $#qty;
	    # @@@ this fails if smaller quantities following a large quantity
	    # differ from the quantities preceding them. E.g., 1 10 100 25
	    # wouldn't yield correct results.
	}
	for (my $i = $#qty; $i >= 0; $i--) {
	    my $order = 0;
	    my $price = 0;
	    my $left = $n;
	    for (my $j = $#qty; $j >= $i; $j--) {
		while ($left >= ($j == $i ? 1 : $qty[$j])) {
		    $left -= $qty[$j];
		    $order += $qty[$j];
		    $price += $price[$j]*$qty[$j];
		}
	    }
	    next if $order > $max;
	    if (!defined $best_price || $price < $best_price) {
		$best_price = $price;
		$best_qty = $order;
	    }
	}
    }
    next if !defined $best_price;
    print "$_ $best_qty $currency $best_price";
    my $id = $_;
    while (keys %{ $comps{$id} }) {
	last if $best_qty < $mult;
	$best_qty -= $mult;
	my $ref = (sort { &cmp_cref($a, $b); } keys %{ $comps{$id} })[0];
#print STDERR "$id: $ref + ", join("|", keys %{ $comps{$id} }), "\n";
	my @f = @{ $parts{$ref} };
	while (@f) {
	    my @id2 = splice(@f, 0, 2);
	    my $id2 = "$id2[0] $id2[1]";
	    $want{$id2}--;
	    delete $comps{$id2}{$ref};
	}
	print " $ref";
    }
    print "\n";
}

for my $id (sort { $want{$b} <=> $want{$a} } keys %want) {
    next unless $want{$id};
    print STDERR "$id";
    for (&eq($id)) {
#	next unless $want{$_};
	die "\n$_ ($want{$_}) vs. $id want ($want{$id})"
	  unless $want{$_} == $want{$id};
	print STDERR " $_";
	$want{$_} = 0;
    }
    print STDERR ": want $want{$id}\n";
    $want{$id} = 0;
}