mirror of
git://projects.qi-hardware.com/eda-tools.git
synced 2024-11-23 01:32:49 +02:00
134 lines
3.2 KiB
Perl
Executable File
134 lines
3.2 KiB
Perl
Executable File
#!/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;
|
|
}
|