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 $!;