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