chiark / gitweb /
96e6867f7ad0564cdc518a64dec2e8c5b3894eba
[ypp-sc-tools.db-live.git] / ypp-restock-rum
1 #!/usr/bin/perl -w
2 use strict qw(vars);
3 use IO::Handle;
4 use POSIX;
5
6 my $usage = <<END
7 usage:
8   .../ypp-restock-rum [<information> ...]
9
10 where <information> is
11
12   have  [<swill> <grog>] <fine> [<hold_shot>+<loaded_shot>]
13   want  [<swill> <grog>] <fine> [<shot>]
14   price  <swill> <grog>  <fine> [<shot>]
15
16 Each of which may appear only once, except \`have' which may appear
17 more than once which case we calculate the differences and the profit
18 for each one.
19
20 If <shot> is not specified at all, relevant information about shot is
21 not reported.  For have and want, missing entries count as zero.
22
23 In price, \`x' means the commodity is unavailable.
24 END
25 ;
26
27 our (@kinds) = qw(Swill Grog Fine Shot);
28 our (@proofs) = qw(40 60 100);
29
30 sub parse_info ($$$\@$) {
31     my ($omitswgok,$default,$multishot, $storeary, $what) = @_;
32     @ARGV or badusage("missing value for information argument \`$_'");
33     badusage("$what: specified more than once")
34         if defined $storeary->[2];
35     my (@v) = ();
36     while (@ARGV and $ARGV[0] =~ m/^\d|^x$/) {
37         $_ = shift @ARGV;
38         push @v, $_;
39     }
40     if (@v==1 or @v==2) {
41         badusage("$what: swill and grog amounts must be specified")
42             unless $omitswgok;
43         @v=($default,$default,@v);
44     }
45     if ($multishot and @v==4 and length $v[3]) {
46         $v[3] =~ m/^0*(\d+)\+0*(\d+)$/ or
47             badusage("$what: shot must be specified as <hold>+<loaded>");
48         $v[3] = $1 + $2;
49     }
50     if (@v==3) {
51         push @v, $default;
52     }
53     if (@v != 4) {
54         badusage("$what: invalid syntax (wrong number of parameters)");
55     }
56     my $i=0;
57     foreach $_ (@v) {
58         if ($default>0 and m/^x$/) {
59             $_ = $default;
60         } elsif (m/^0*(\d+)$/) {
61             $_= $1;
62         } else {
63             badusage("$what: $kinds[$i] \`$_': bad syntax");
64         }
65         $i++;
66     }
67     @$storeary = @v;
68 }
69
70 our (@have,@want,@price);
71
72 sub parse_args () {
73     @ARGV or badusage("need some information to go on");
74     while (@ARGV) {
75         $_ = shift @ARGV;
76         if (m/^have$/) {
77             parse_info(1,0,1, @{ $have[@have] }, 'have');
78         } elsif (m/^want$/) {
79             parse_info(1,0,0, @want, 'want');
80         } elsif (m/^price$/) {
81             parse_info(0,1e7,0, @price, 'price');
82         } else {
83             badusage("unknown information argument \`$_'");
84         }
85     }
86 }
87
88 sub badusage ($) {
89     my ($m) = @_;
90     print STDERR "\nbad usage: $m\n\n$usage\n";
91     exit 16;
92 }
93
94 our $ff = '%6.1f';
95
96 sub valid ($) {
97     my ($x) = @_;
98     defined $x and $x and $x<1e5;
99 }    
100
101 sub prvff ($$\@$) {
102     my ($what, $format, $ary, $unit) = @_;
103     printf("%-25s", "$what:");
104     for my $i (qw(0 1 2 3)) {
105         my $x= $ary->[$i];
106         my $y= valid($x) ? sprintf $format, $x : '    ';
107         printf " %-9s", $y;
108     }
109     printf "  %s\n", $unit;
110 }
111
112 sub pr ($\@$) {
113     my ($what, $ary, $unit) = @_;
114     prvff($what, '%4d  ', @$ary, $unit);
115 }
116
117 sub prf ($\@$) {
118     my ($what, $ary, $unit) = @_;
119     prvff($what, $ff, @$ary, $unit);
120 }
121
122 sub pr1 ($$) {
123     my ($k,$v) = @_;
124     printf "%-20s %s\n", "$k:", $v;
125 }
126 sub fmt_stock_index ($) {
127     my ($si) = @_;
128     @have==1 ? '' : ' #'.$si;
129 }
130
131 sub rum_total (\@) {
132     my ($rums) = @_;
133     my $total= 0;
134     foreach my $i (qw(0 1 2)) {
135         $total += $rums->[$i] * $proofs[$i] / 100;
136     }
137     return $total;
138 }
139
140 our @norm_price;
141 our ($best, $best_norm_price);
142
143 sub print_inputs () {
144     printf("%25s",'');
145     map { printf " %5s    ", $_ } @kinds;
146     print "\n\n";
147     pr('prices', @price, 'poe ea.') if valid(@price);
148     pr('target stocks', @want, 'units') if valid(@want);
149     my $si=0; for my $stocks (@have) {
150         pr('actual stocks'.fmt_stock_index(++$si),
151            @$stocks, 'units');
152     }
153     print "\n";
154 }
155
156 sub compute_cheapest_rum() {
157     return unless @price;
158
159     my (@perorder) = map { $_*10 } @price;
160     prf('equiv. ordering price', @perorder, 'poe/order');
161
162     $best= undef;
163     $best_norm_price= 1e6;
164     for my $i (qw(0 1 2)) {
165         next unless $price[$i];
166         $norm_price[$i] = $price[$i] * 100 / $proofs[$i];
167         if ($norm_price[$i] <= $best_norm_price) {
168             $best= $i;
169             $best_norm_price= $norm_price[$i];
170         }
171     };
172     prf('normalised prices', @norm_price, 'poe/fine');
173
174     if (defined $best) {
175         printf "best is %-10s%*s^^\n",
176             $kinds[$best],
177             $best*10+10, '';
178         my (@bestperorder) = map {
179             $best_norm_price * $proofs[$_] / 100 * 10;
180         } qw(0 1 2);
181         #push @bestperorder, $perorder[3];
182         prf('best is equiv. ordering', @bestperorder, 'poe/order');
183     }
184     print "\n";
185 }
186
187 sub pr1s ($) {
188     my ($x) = @_;
189     if (valid($x)) {
190         printf ' %9.1f', $x;
191     } else {
192         printf "          ";
193     }
194 }
195
196 sub compute_stock_values() {
197     return unless @have;
198     print @have>1 ? <<END
199                  Rum      Rum     Shot    Shot     total      Profit    Profit
200                 equiv.   value   stocks   value    value      this leg   total
201 END
202 : <<END
203                              Rum      Rum             Shot    Shot     total
204                             equiv.   value           stocks   value    value
205 END
206 ;
207
208     my $initial_value;
209     my $last_value;
210     my $si=0; for my $stocks (@have) {
211         my $stock_rum = rum_total(@$stocks);
212         my $rum_value= defined($best) ? $stock_rum * $best_norm_price : 0;
213         my $shot_value= valid($price[3]) ? $stocks->[3] * $price[3] : 0;
214         my $total_value= $rum_value + $shot_value;
215
216         printf "%-10s ", 'stocks'.fmt_stock_index(++$si).':';
217         print '            ' if @have==1;
218         pr1s($stock_rum);
219         pr1s($rum_value);
220         print '        ' if @have==1;
221         printf "%6s", $stocks->[3] ? $stocks->[3] : '';
222         pr1s($shot_value);
223         pr1s($total_value);
224         
225         if (defined $last_value) {
226             printf(" %10.1f %10.1f",
227                    $total_value - $last_value,
228                    $total_value - $initial_value);
229         }
230         $initial_value= $total_value unless defined $initial_value;
231         $last_value= $total_value;
232         print "\n";
233     }
234     print @have>1 ? <<END
235                  fine      poe    units    poe       poe     delta-poe     poe
236 END
237 : <<END
238                              fine      poe            units    poe       poe
239 END
240 ;
241     print "\n";
242 }
243
244 sub pr2 ($$$) {
245     my ($k,$v1,$v2) = @_;
246     printf "%-25s %-23s %s\n", "$k:", $v1, $v2;
247 }
248
249 sub pr2rs ($$$) {
250     my ($k,$rum,$shot) = @_;
251     pr2($k,
252         valid($rum) ? sprintf("%12.1f fine equiv", $rum) : '',
253         valid($shot) ? sprintf("%10d shot", $shot) : '');
254 }
255
256 sub compute_restock_requirements () {
257     return unless @want;
258     
259     my $rum_want= rum_total(@want);
260
261     my $stocks= @have ? $have[-1] : [qw(0 0 0 0)];
262     my $rum_have= rum_total(@$stocks);
263     
264     pr2rs('desired stock level', $rum_want, $want[3]);
265
266     my $rum_need = $rum_want - $rum_have;
267     my $shot_need = $want[3] - $stocks->[3];
268
269     if (@have) {
270         pr2rs('current stock', $rum_have, $stocks->[3]);
271         pr2rs('restock requirement', $rum_need, $shot_need);
272         print "\n";
273     }
274
275     if (@price) {
276         my ($rum_buy,$shot_buy) = ('','');
277         my ($rum_bill,$shot_bill) = qw(0 0);
278         my $ok=1;
279         if ($rum_need > 0) {
280             if (defined $best) {
281                 my $rum_qty= $rum_need * 100 / $proofs[$best];
282                 $rum_qty= ceil($rum_qty);
283                 $rum_buy= sprintf('%12s %-11s  ',
284                                   "** $rum_qty","$kinds[$best] **");
285                 $rum_bill= $rum_qty * $price[$best];
286             } else {
287                 $rum_buy= '   (rum unavailable)';
288                 $ok= 0;
289             }
290         }
291         if ($shot_need > 0) {
292             if (valid($price[3])) {
293                 $shot_buy= sprintf('%7s shot **', "** $shot_need");
294                 $shot_bill= $shot_need * $price[3];
295             } else {
296                 $shot_buy= '  (shot unavailable)';
297                 $ok= 0;
298             }
299         }
300         if (length($rum_buy) or length($shot_buy)) {
301             pr2($ok
302                 ? sprintf('for a total of %d poe', $rum_bill + $shot_bill)
303                 : 'for',
304                 $rum_bill ? sprintf("%12d poe       ", $rum_bill) : '',
305                 $shot_bill ? sprintf("%10d poe", $shot_bill) : '');
306             pr2('BUY', $rum_buy, $shot_buy);
307         } else {
308             print "stocks are sufficient.\n";
309         }
310         print "\n";
311     }
312 }
313
314 parse_args();
315 print_inputs();
316 compute_cheapest_rum();
317 compute_stock_values();
318 compute_restock_requirements();
319
320 STDOUT->error and die $!;
321 close STDOUT or die $!;