Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
executable file 366 lines (322 sloc) 12.9 KB
#!/usr/bin/perl
use strict;
use Carp;
use Client;
use Getopt::Long;
use IO::Handle;
use JSON::PP;
use List::Util qw(first min max sum);
autoflush STDOUT 1;
autoflush STDERR 1;
my $config_name = "config.json";
my @body_names;
my $ship_name;
my $equalize = 0;
my $themepark = 0;
my $debug = 0;
my $quiet = 0;
my $noaction = 0;
my $do_waste = 1;
my $use_chain = 0;
GetOptions(
"config=s" => \$config_name,
"body=s" => \@body_names,
"ship|name=s" => \$ship_name,
"debug" => \$debug,
"quiet" => \$quiet,
"noaction!" => \$noaction,
"waste!" => \$do_waste,
"use_chain|chain!" => \$use_chain,
) or die "$0 --config=foo.json --body=Bar\n";
my @foods = qw(algae apple bean beetle bread burger
cheese chip cider corn fungus lapis
meal milk pancake pie potato root
shake soup syrup wheat);
my @ores = qw(anthracite bauxite beryl chalcopyrite chromite
fluorite galena goethite gold gypsum
halite kerogen magnetite methane monazite
rutile sulfur trona uraninite zircon);
my @resources = (@foods, @ores, qw(water energy waste));
my @categories = qw(food energy ore waste water);
die "Must specify at least two bodies\n" unless @body_names >= 2;
$ship_name ||= join(" ", @body_names);
my $client = Client->new(config => $config_name);
my $planets = $client->empire_status->{planets};
my %vitals = get_vitals();
emit_json("vitals", \%vitals);
my %ideals = express_desires(%vitals);
emit_json("ideals", \%ideals);
my @moves = find_best_shipping(\%vitals, \%ideals);
emit_json("moves", \@moves);
push_resources(@moves);
sub get_vitals {
my $cached = $client->cache_read(type => "misc", id => "trade_vitals_@body_names");
return %{$cached->{vitals}} if $cached;
my %vitals;
for my $name (@body_names) {
my $body_id = first { $planets->{$_} =~ /$name/ } keys %$planets;
die "No matching planet for name $name\n" unless $body_id;
my $buildings = $client->body_buildings($body_id)->{buildings};
my $trade_id = first { $buildings->{$_}{name} eq 'Trade Ministry' } keys %$buildings;
my $theme_id = first { $buildings->{$_}{name} eq 'Theme Park' } keys %$buildings;
my $resources = $client->call(trade => get_stored_resources => $trade_id);
my $body = $resources->{status}{body};
my @ships = sort { $b->{hold_size} <=> $a->{hold_size} }
grep { $_->{name} =~ /$ship_name/ }
@{$client->call(trade => get_trade_ships => $trade_id)->{ships}};
exit(1) if $quiet && !@ships;
die "No ships available for name $ship_name on planet $planets->{$body_id}\n" unless @ships;
$vitals{$body_id} = {
body_id => $body_id,
trade_id => $trade_id,
theme_id => $theme_id,
resources => $resources->{resources},
capacities => { map { $_, int(max($body->{"${_}_capacity"} - $body->{"${_}_hour"} / 2,
$body->{"${_}_capacity"} / 2)) } @categories },
ship => $ships[0],
};
}
$client->cache_write(type => "misc", id => "trade_vitals_@body_names", invalid => time() + 600, data => { vitals => \%vitals });
return %vitals;
}
sub express_desires {
my %vitals = @_;
my %ideals;
my %totals;
my %capacities;
for my $body_id (keys %vitals) {
for my $res (@resources) {
$totals{$res} += $vitals{$body_id}{resources}{$res};
}
for my $cat (@categories) {
$capacities{$cat} += $vitals{$body_id}{capacities}{$cat};
}
}
emit("Distributing waste:") if $debug;
if ($do_waste) {
# Distribute waste proportionally
for my $body_id (keys %vitals) {
$ideals{$body_id}{waste} = int($totals{waste} * $vitals{$body_id}{capacities}{waste} / $capacities{waste});
}
} else {
# Leave waste where it is
for my $body_id (keys %vitals) {
$ideals{$body_id}{waste} = $vitals{$body_id}{resources}{waste};
}
}
emit("Waste: ".join(", ", map { "$planets->{$_} $ideals{$_}{waste}" } keys %vitals)) if $debug;
# Split water and energy as evenly as possible, maxing out the smaller capacities.
for my $res (qw(water energy)) {
emit("Distributing $res:") if $debug;
my @ids = sort { $vitals{$a}{capacities}{$res} <=> $vitals{$b}{capacities}{$res} } keys %vitals;
my $remain = $totals{$res};
while (@ids) {
$ideals{$ids[0]}{$res} = min(int($remain / @ids), $vitals{$ids[0]}{capacities}{$res});
$remain -= $ideals{$ids[0]}{$res};
shift @ids;
}
emit("$res: ".join(", ", map { "$planets->{$_} $ideals{$_}{$res}" } keys %vitals)) if $debug;
emit("$res: Original total $totals{$res}, distributed total ".sum(map { $ideals{$_}{$res} } keys %vitals)) if $debug;
}
# Split ores as evenly as possible, except where that overfills capacity.
# Where capacity is filled, take equal amounts of ores up to the equal distribution above.
{
my @ids = sort { $vitals{$a}{capacities}{ore} <=> $vitals{$b}{capacities}{ore} } keys %vitals;
my %remain = map { $_, $totals{$_} } grep { $totals{$_} } @ores;
while (@ids) {
my %partial = map { $_, int($remain{$_} / @ids) } grep { $remain{$_} >= @ids } keys %remain;
if (sum(values %partial) > $vitals{$ids[0]}{capacities}{ore}) {
my $space = $vitals{$ids[0]}{capacities}{ore};
my @res = sort { $partial{$a} <=> $partial{$b} } keys %partial;
while (@res) {
$ideals{$ids[0]}{$res[0]} = min(int($space / @res), $partial{$res[0]});
$remain{$res[0]} -= $ideals{$ids[0]}{$res[0]};
$space -= $ideals{$ids[0]}{$res[0]};
shift @res;
}
} else {
for my $res (keys %partial) {
$ideals{$ids[0]}{$res} = $partial{$res};
$remain{$res} -= $ideals{$ids[0]}{$res};
}
}
shift @ids;
}
}
# If there is a theme park on the planet, try for 1010 of each food,
# and split remaining capacity among 5 foods.
# Otherwise, split foods as evenly as possible, except where that overfills capacity.
# Where capacity is filled, take equal amounts of foods up to the equal distribution above.
{
my @ids = sort { !$vitals{$a}{theme_id} <=> !$vitals{$b}{theme_id} ||
$vitals{$a}{capacities}{food} <=> $vitals{$b}{capacities}{food} } keys %vitals;
my %remain = map { $_, $totals{$_} } grep { $totals{$_} } @foods;
while (@ids) {
if ($vitals{$ids[0]}{theme_id}) {
my @res = sort { $remain{$b} <=> $remain{$a} } grep { $remain{$_} >= 1010 } keys %remain;
my @head = splice(@res, 0, 5);
my $space = $vitals{$ids[0]}{capacities}{food};
while (@res) {
last if $space < 1010;
$ideals{$ids[0]}{$res[0]} = 1010;
$remain{$res[0]} -= 1010;
$space -= 1010;
shift @res;
}
@res = reverse @head;
while (@res) {
$ideals{$ids[0]}{$res[0]} = min(int($space / @res), $remain{$res[0]});
$remain{$res[0]} -= $ideals{$ids[0]}{$res[0]};
$space -= $ideals{$ids[0]}{$res[0]};
shift @res;
}
} else {
my %partial = map { $_, int($remain{$_} / @ids) } grep { $remain{$_} >= @ids } keys %remain;
if (sum(values %partial) > $vitals{$ids[0]}{capacities}{food}) {
my $space = $vitals{$ids[0]}{capacities}{food};
my @res = sort { $partial{$a} <=> $partial{$b} } keys %partial;
while (@res) {
$ideals{$ids[0]}{$res[0]} = min(int($space / @res), $partial{$res[0]});
$remain{$res[0]} -= $ideals{$ids[0]}{$res[0]};
$space -= $ideals{$ids[0]}{$res[0]};
shift @res;
}
} else {
for my $res (keys %partial) {
$ideals{$ids[0]}{$res} = $partial{$res};
$remain{$res} -= $ideals{$ids[0]}{$res};
}
}
}
shift @ids;
}
}
return %ideals;
}
sub find_best_chaining {
for my $resource (@resources) {
my @bodies = keys %vitals;
my %excess = map { $_, ($ideals{$_}{$resource} - $vitals{$_}{resources}{$resource}) } @bodies;
# for my $
}
}
sub find_best_shipping {
my %vitals = %{shift()};
my %ideals = %{shift()};
my @bodies = keys %vitals;
my $first = shift @bodies;
my @moves = order_helper(\%vitals, \%ideals, [ $first ], [ @bodies ]);
my $amount = sum(map { sum values %{$_->{items}} } @moves);
emit("Best total $amount with order ".join(", ", map { $planets->{$_->{source_id}} } @moves));
return @moves;
}
sub order_helper {
my $vitals = shift;
my $ideals = shift;
my $order = shift;
my $remain = shift;
return shipping_for_order($vitals, $ideals, $order) unless @$remain;
my $best_amount = 0;
my @best_moves = ();
for my $next (@$remain) {
next if grep { $next eq $_ } @$order;
my @moves = order_helper($vitals, $ideals, [ @$order, $next ], [ grep { $next ne $_ } @$remain ]);
my $amount = sum(map { sum values %{$_->{items}} } @moves);
if ($best_amount < $amount) {
$best_amount = $amount;
@best_moves = @moves;
}
}
return @best_moves;
}
sub shipping_for_order {
my %vitals = %{shift()};
my %ideals = %{shift()};
my @order = @{shift()};
# For each resource, find planet with most of it
# my %max = map { $_, (sort { $ideals{$b}{$_} - $vitals{$b}{resources}{$_} <=>
# $ideals{$a}{$_} - $vitals{$a}{resources}{$_} } keys %vitals)[0] } @resources;
my %max = map { $_, (sort { $vitals{$b}{resources}{$_} <=>
$vitals{$a}{resources}{$_} } keys %vitals)[0] } @resources;
# Map the order
my %next = map { $order[$_], $order[($_+1) % @order] } 0..$#order;
my %prev = reverse %next;
# Walk backwards through order, determining shipping quantities based on want and availability
my %moves;
for my $res (@resources) {
my $pos = $max{$res};
$moves{$prev{$pos}}{$res} = max(0, min($vitals{$prev{$pos}}{resources}{$res} - 10, $ideals{$pos}{$res} - $vitals{$pos}{resources}{$res}));
for ($pos = $prev{$max{$res}}; $pos ne $max{$res}; $pos = $prev{$pos}) {
$moves{$prev{$pos}}{$res} = max(0, min($vitals{$prev{$pos}}{resources}{$res} - 10, $ideals{$pos}{$res} - $vitals{$pos}{resources}{$res} + $moves{$pos}{$res}));
}
}
emit_json("first pass", \%moves);
# For each leg, detect over capacity for transport
for (;;) {
my %totals = map { $_, sum(values(%{$moves{$_}})) } keys %moves;
my %deltas = map { $_, $vitals{$_}{ship}{hold_size} - $totals{$_} } keys %totals;
my @violations = sort { $deltas{$a} <=> $deltas{$b} } grep { $deltas{$_} < 0 } keys %deltas;
last unless @violations;
my $bad = $violations[0];
my %stuff = %{$moves{$bad}};
$moves{$bad} = {};
my $limit = $vitals{$bad}{ship}{hold_size};
emit("Over shipping limit on $planets->{$bad}: want to move $totals{$bad}, limit $limit") unless $quiet;
# Transport resources evenly up to previously computed levels
my @res = sort { $stuff{$a} <=> $stuff{$b} } keys %stuff;
while (@res) {
$moves{$bad}{$res[0]} = min(int($limit / @res), $stuff{$res[0]});
$limit -= $moves{$bad}{$res[0]};
shift @res;
}
# Adjust cascaded shipping quantities as needed
for my $res (@resources) {
for (my $pos = $bad; $pos ne $next{$bad}; $pos = $prev{$pos}) {
$moves{$prev{$pos}}{$res} = max(0, min($moves{$prev{$pos}}{$res}, $vitals{$prev{$pos}}{resources}{$res} - 10, $ideals{$pos}{$res} - $vitals{$pos}{resources}{$res} + $moves{$pos}{$res}));
}
}
emit_json("after reduction pass", \%moves);
}
my $total_moves = sum(map { sum values %$_ } values %moves);
emit("Total $total_moves moved for order ".join(", ", map { $planets->{$_} } @order)) unless $quiet;
# Convert to move structure
my @moves = map {
{
source_id => $_,
target_id => $next{$_},
trade_id => $vitals{$_}{trade_id},
ship => $vitals{$_}{ship},
items => { %{$moves{$_}} },
}
} @order;
return @moves;
}
sub push_resources {
my @moves = @_;
for my $move (@moves) {
my @items = map { { type => $_, quantity => int($move->{items}{$_}) } } grep { $move->{items}{$_} } keys %{$move->{items}};
if (@items) {
my $item_text = join(", ", map { "$_->{quantity} $_->{type}" } @items);
emit(($noaction ? "Would send" : "Sending")." $item_text to $planets->{$move->{target_id}} on $move->{ship}{name}",
$planets->{$move->{source_id}});
my $result = eval {
$client->trade_push($move->{trade_id}, $move->{target_id}, \@items, { ship_id => $move->{ship}{id} }) unless $noaction;
};
} else {
emit("Nothing to send to $planets->{$move->{target_id}} on $move->{ship}{name}",
$planets->{$move->{source_id}});
}
}
}
sub emit {
my $message = shift;
my $name = shift;
print Client::format_time(time())." $name: $message\n";
}
sub emit_json {
return unless $debug;
my $message = shift;
my $hash = shift;
print Client::format_time(time())." $message:\n";
print JSON::PP->new->allow_nonref->canonical->pretty->encode($hash);
}