chiark / gitweb /
~yarrgweb / ypp-sc-tools.db-test.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Slightly clearer headings on multi-leg financial table
[ypp-sc-tools.db-test.git] / ypp-restock-rum
diff --git a/ypp-restock-rum b/ypp-restock-rum
index 0fe47f98ebd289b23c5805941d1ec31002a84f28..569f461e36ee9bbe649b5c20ba386a5cded916f9 100755 (executable)
--- a/ypp-restock-rum
+++ b/ypp-restock-rum
@@ -17,12 +17,10 @@ Each of which may appear only once, except \`have' which may appear
 more than once which case we calculate the differences and the profit
 for each one.
 
 more than once which case we calculate the differences and the profit
 for each one.
 
-If /<shot> is not specified at all, relevant information about shot is
-not reported.  For have and want, specifying an empty string means
-zero.  Entirely Missing <swill>/<grog>/ is taken as if both were
-specified and zero.
+If <shot> is not specified at all, relevant information about shot is
+not reported.  For have and want, missing entries count as zero.
 
 
-In price, missing entries mean the commodity is unavailable.
+In price, \`x' means the commodity is unavailable.
 END
 ;
 
 END
 ;
 
@@ -35,7 +33,7 @@ sub parse_info ($$$\@$) {
     badusage("$what: specified more than once")
        if defined $storeary->[2];
     my (@v) = ();
     badusage("$what: specified more than once")
        if defined $storeary->[2];
     my (@v) = ();
-    while (@ARGV and $ARGV[0] =~ m/^\d/) {
+    while (@ARGV and $ARGV[0] =~ m/^\d|^x$/) {
        $_ = shift @ARGV;
        push @v, $_;
     }
        $_ = shift @ARGV;
        push @v, $_;
     }
@@ -53,13 +51,17 @@ sub parse_info ($$$\@$) {
        push @v, $default;
     }
     if (@v != 4) {
        push @v, $default;
     }
     if (@v != 4) {
-       badusage("$what: invalid syntax (wrong number of /s)");
+       badusage("$what: invalid syntax (wrong number of parameters)");
     }
     my $i=0;
     foreach $_ (@v) {
     }
     my $i=0;
     foreach $_ (@v) {
-       $_ = $default if !length;
-       m/^0*(\d+)$/ or badusage("$what: $kinds[$i] \`$_': bad syntax");
-       $_= $1;
+       if ($default>0 and m/^x$/) {
+           $_ = $default;
+       } elsif (m/^0*(\d+)$/) {
+           $_= $1;
+       } else {
+           badusage("$what: $kinds[$i] \`$_': bad syntax");
+       }
        $i++;
     }
     @$storeary = @v;
        $i++;
     }
     @$storeary = @v;
@@ -76,7 +78,7 @@ sub parse_args () {
        } elsif (m/^want$/) {
            parse_info(1,0,0, @want, 'want');
        } elsif (m/^price$/) {
        } elsif (m/^want$/) {
            parse_info(1,0,0, @want, 'want');
        } elsif (m/^price$/) {
-           parse_info(0,1e6,0, @price, 'price');
+           parse_info(0,1e7,0, @price, 'price');
        } else {
            badusage("unknown information argument \`$_'");
        }
        } else {
            badusage("unknown information argument \`$_'");
        }
@@ -93,7 +95,7 @@ our $ff = '%6.1f';
 
 sub valid ($) {
     my ($x) = @_;
 
 sub valid ($) {
     my ($x) = @_;
-    defined $x and $x>0 and $x<1e4;
+    defined $x and $x and $x<1e5;
 }    
 
 sub prvff ($$\@$) {
 }    
 
 sub prvff ($$\@$) {
@@ -121,7 +123,19 @@ sub pr1 ($$) {
     my ($k,$v) = @_;
     printf "%-20s %s\n", "$k:", $v;
 }
     my ($k,$v) = @_;
     printf "%-20s %s\n", "$k:", $v;
 }
+sub fmt_stock_index ($) {
+    my ($si) = @_;
+    @have==1 ? '' : ' #'.$si;
+}
 
 
+sub rum_total (\@) {
+    my ($rums) = @_;
+    my $total= 0;
+    foreach my $i (qw(0 1 2)) {
+       $total += $rums->[$i] * $proofs[$i] / 100;
+    }
+    return $total;
+}
 
 our @norm_price;
 our ($best, $best_norm_price);
 
 our @norm_price;
 our ($best, $best_norm_price);
@@ -132,8 +146,8 @@ sub print_inputs () {
     print "\n\n";
     pr('prices', @price, 'poe ea.') if valid(@price);
     pr('target stocks', @want, 'units') if valid(@want);
     print "\n\n";
     pr('prices', @price, 'poe ea.') if valid(@price);
     pr('target stocks', @want, 'units') if valid(@want);
-    my $i=0; for my $stocks (@have) {
-       pr('actual stocks'.(@have==1 ? '' : ' #'.++$i),
+    my $si=0; for my $stocks (@have) {
+       pr('actual stocks'.fmt_stock_index(++$si),
           @$stocks, 'units');
     }
     print "\n";
           @$stocks, 'units');
     }
     print "\n";
@@ -146,7 +160,7 @@ sub compute_cheapest_rum() {
     prf('equiv. ordering price', @perorder, 'poe/order');
 
     $best= undef;
     prf('equiv. ordering price', @perorder, 'poe/order');
 
     $best= undef;
-    my $best_norm_price= 1e5;
+    $best_norm_price= 1e6;
     for my $i (qw(0 1 2)) {
        next unless $price[$i];
        $norm_price[$i] = $price[$i] * 100 / $proofs[$i];
     for my $i (qw(0 1 2)) {
        next unless $price[$i];
        $norm_price[$i] = $price[$i] * 100 / $proofs[$i];
@@ -170,85 +184,133 @@ sub compute_cheapest_rum() {
     print "\n";
 }
 
     print "\n";
 }
 
-parse_args();
-print_inputs();
-compute_cheapest_rum();
+sub pr1s ($) {
+    my ($x) = @_;
+    if (valid($x)) {
+       printf ' %9.1f', $x;
+    } else {
+       printf "          ";
+    }
+}
 
 
-__DATA__
+sub compute_stock_values() {
+    return unless @have;
+    print @have>1 ? <<END
 
 
-#    if (defined $price{Swill}) {
-#      map { $price{$_}= undef if $price{$_} eq 'x' } @rums;
-#    }
-#    if (defined $have{Swill}) {
-#      $have_proof= 0;
-#      map { $have_proof += $have{$_} * $proof{$_} } @rums;
-#    }
+                _____Rum_____      ___Shot___      total      _____Profit___
+             fine equiv.  value   qty    value     value     per leg     total
+END
+: <<END
+                             Rum      Rum             Shot    Shot     total
+                            equiv.   value           stocks   value    value
+END
+;
 
 
-our ($best);
+    my $initial_value;
+    my $last_value;
+    my $si=0; for my $stocks (@have) {
+       my $stock_rum = rum_total(@$stocks);
+       my $rum_value= defined($best) ? $stock_rum * $best_norm_price : 0;
+       my $shot_value= valid($price[3]) ? $stocks->[3] * $price[3] : 0;
+       my $total_value= $rum_value + $shot_value;
+
+       printf "%-10s ", 'stocks'.fmt_stock_index(++$si).':';
+       print '            ' if @have==1;
+       pr1s($stock_rum);
+       pr1s($rum_value);
+       print '        ' if @have==1;
+       printf "%6s", $stocks->[3] ? $stocks->[3] : '';
+       pr1s($shot_value);
+       pr1s($total_value);
+       
+       if (defined $last_value) {
+           printf(" %10.1f %10.1f",
+                  $total_value - $last_value,
+                  $total_value - $initial_value);
+       }
+       $initial_value= $total_value unless defined $initial_value;
+       $last_value= $total_value;
+       print "\n";
+    }
+    print "\n" if @have>1;
+    print "\n";
+}
 
 
-our $have_proof;
+sub pr2 ($$$) {
+    my ($k,$v1,$v2) = @_;
+    printf "%-25s %-23s %s\n", "$k:", $v1, $v2;
+}
 
 
-our ($need_proof, %need, %buy);
+sub pr2rs ($$$) {
+    my ($k,$rum,$shot) = @_;
+    pr2($k,
+       valid($rum) ? sprintf("%12.1f fine equiv", $rum) : '',
+       valid($shot) ? sprintf("%10d shot", $shot) : '');
+}
 
 sub compute_restock_requirements () {
 
 sub compute_restock_requirements () {
-    if ($ship =~ m/^\d+/) {
-       $need{Fine} = $ship;
-    } else {
-       $ship =~ y/_/ /;
-       open F, "/home/ian/private/puzzle-pirates" or die $!;
-       my $this_ship= 0;
-       my $the_ship;
-       while (<F>) {
-           if (!m/\S/ || m/^\s*\#/) {
-               $this_ship= 0;
-               next;
-           }
-           if (!m/^\@/) {
-               next;
-           }
-           if (m/^\@(( [A-Z][-a-z]+){2,})\s*$/) {
-               $this_ship= (uc $1 eq uc " $ship" or
-                            uc $+ eq uc " $ship");
-               $the_ship= $1;
-               next;
+    return unless @want;
+    
+    my $rum_want= rum_total(@want);
+
+    my $stocks= @have ? $have[-1] : [qw(0 0 0 0)];
+    my $rum_have= rum_total(@$stocks);
+    
+    pr2rs('desired stock level', $rum_want, $want[3]);
+
+    my $rum_need = $rum_want - $rum_have;
+    my $shot_need = $want[3] - $stocks->[3];
+
+    if (@have) {
+       pr2rs('current stock', $rum_have, $stocks->[3]);
+       pr2rs('restock requirement', $rum_need, $shot_need);
+       print "\n";
+    }
+
+    if (@price) {
+       my ($rum_buy,$shot_buy) = ('','');
+       my ($rum_bill,$shot_bill) = qw(0 0);
+       my $ok=1;
+       if ($rum_need > 0) {
+           if (defined $best) {
+               my $rum_qty= $rum_need * 100 / $proofs[$best];
+               $rum_qty= ceil($rum_qty);
+               $rum_buy= sprintf('%12s %-11s  ',
+                                 "** $rum_qty","$kinds[$best] **");
+               $rum_bill= $rum_qty * $price[$best];
+           } else {
+               $rum_buy= '   (rum unavailable)';
+               $ok= 0;
            }
            }
-           next unless $this_ship;
-           if (m/^\@\s+(\d+)\s+fine\s*/) {
-               $need{Fine} = $1;
-               last;
+       }
+       if ($shot_need > 0) {
+           if (valid($price[3])) {
+               $shot_buy= sprintf('%7s shot **', "** $shot_need");
+               $shot_bill= $shot_need * $price[3];
+           } else {
+               $shot_buy= '  (shot unavailable)';
+               $ok= 0;
            }
        }
            }
        }
-       die $! if F->error;
-       die "unknown ship $ship" unless defined $need{Fine};
-       if (defined $ship) {
-           pr1("vessel",$the_ship);
+       if (length($rum_buy) or length($shot_buy)) {
+           pr2($ok
+               ? sprintf('for a total of %d poe', $rum_bill + $shot_bill)
+               : 'for',
+               $rum_bill ? sprintf("%12d poe       ", $rum_bill) : '',
+               $shot_bill ? sprintf("%10d poe", $shot_bill) : '');
+           pr2('BUY', $rum_buy, $shot_buy);
+       } else {
+           print "stocks are sufficient.\n";
        }
        }
+       print "\n";
     }
     }
-    pr1('desired stock level', sprintf("%4d fine rum", $need{Fine}));
-    $need_proof= $need{Fine} * $proof{Fine} - $have_proof;
-    map {
-       $buy{$_} = $need_proof / $proof{$_};
-    } @rums;
-    pr1("stock equivalent", sprintf "$ff fine rum", $have_proof / $proof{Fine});
-    pr1("restock equivalent", sprintf "$ff fine rum", $need_proof / $proof{Fine});
-    prf('would need', %buy, 'rum');
-}
-
-sub compute_restock_cheapest_rum() {
-    my %bill;
-    map {
-       $bill{$_} = $buy{$_} * $price{$_} if defined $price{$_};
-    } @rums;
-    prf('nominal bill', %bill, 'poe');
-    print "\n";
-    if ($need_proof < 0) {
-       printf "stocks are sufficient";
-    } else {
-       my $buy= ceil($buy{$best});
-       printf "buy %d %s at %d poe each for %d poe",
-           $buy, $best, $price{$best}, $buy * $price{$best};
-    }
-    print "\n\n";
 }
 
 }
 
-main();
+parse_args();
+print_inputs();
+compute_cheapest_rum();
+compute_stock_values();
+compute_restock_requirements();
+
+STDOUT->error and die $!;
+close STDOUT or die $!;
yarrg testing database