From: Ian Jackson Date: Thu, 10 Sep 2009 18:50:06 +0000 (+0100) Subject: Merge branch 'stable-3.x' X-Git-Tag: 5.0^2~143 X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.main.git;a=commitdiff_plain;h=555b3391b3cd9967a29b219fff242b583137d2b8;hp=991427d6209887f957d818367cf7643352093f1f Merge branch 'stable-3.x' --- diff --git a/yarrg/Commods.pm b/yarrg/Commods.pm index b58471c..9c82818 100644 --- a/yarrg/Commods.pm +++ b/yarrg/Commods.pm @@ -35,7 +35,8 @@ BEGIN { @ISA = qw(Exporter); @EXPORT = qw(&parse_info_clientside &fetch_with_rsync &parse_info_serverside &parse_info_serverside_ocean - %oceans %commods %clients %routes %route_mysteries + %oceans %commods %clients + %vessels %shotname2damage &parse_pctb_commodmap %pctb_commodmap @pctb_commodmap &get_our_version &check_tsv_line &pipethrough_prep &pipethrough_run @@ -52,8 +53,10 @@ our $masterinfoversion= 2; # version we understand our %oceans; # eg $oceans{'Midnight'}{'Ruby'}{'Eta Island'}= $sources; our %clients; # eg $clients{'ypp-sc-tools'}= [ qw(last-page) ]; -our %routes; # eg $routes{'Midnight'}{'Orca'}{'Tinga'}= $sources NB abbrevs! -our %route_mysteries; # eg $route_mysteries{'Midnight'}{'Norse'}= 3 +our %vessels; # eg $vessels{'War Brig'}{Shot}='medium' + # $vessels{'War Brig'}{Volume}= 81000 + # $vessels{'War Brig'}{Mass}= 54000 +our %shotname2damage; # eg $shotname2damage{'medium'}= 3; # $sources = 's[l]b'; # 's' = Special Circumstances; 'l' = local ; B = with Bleach @@ -102,11 +105,24 @@ sub parse_info1 ($$$) { $oceans{$ocean}{$arch}{$_} .= $src; }; }); - } elsif (m/^routes (\w+)$/) { - my $ocean= $1; + } elsif (m/^vessels$/) { + @ctx= (sub { + return if m/^[-+|]+$/; + m/^ \| \s* ([A-Z][a-z\ ]+[a-z]) \s* + \| \s* (small|medium|large) \s* + \| \s* ([1-9][0-9,]+) \s* + \| \s* ([1-9][0-9,]+) \s* + \| $/x + or die; + my $name= $1; + my $v= { Shot => $2, Volume => $3, Mass => $4 }; + foreach my $vm (qw(Volume Mass)) { $v->{$vm} =~ s/,//g; } + $vessels{$name}= $v; + }); + } elsif (m/^shot$/) { @ctx= (sub { - m/^(\S[^\t]*\S),\s*(\S[^\t]*\S),\s*([1-9][0-9]{0,2})$/ or die; - $routes{$ocean}{$1}{$2}= $3; + m/^ ([a-z]+) \s+ (\d+) $/x or die; + $shotname2damage{$1}= $2; }); } elsif (m/^client (\S+.*\S)$/) { my $client= $1; @@ -161,22 +177,6 @@ sub parse_info1 ($$$) { } }; foreach (@rawcm) { &$ca($_,$src); } - - foreach my $on (keys %routes) { - my $routes= $routes{$on}; - my $ocean= $oceans{$on}; - die unless defined $ocean; - - my @allislands; - foreach my $an (sort keys %$ocean) { - my $arch= $ocean->{$an}; - push @allislands, sort keys %$arch; - } - parse_info_maproutes($on, \@allislands, $routes); - foreach my $route (values %$routes) { - parse_info_maproutes($on, \@allislands, $route); - } - } } sub parse_info_clientside () { @@ -201,21 +201,6 @@ sub fetch_with_rsync ($) { return $local; } -sub parse_info_maproutes ($$$) { - my ($on, $allislands, $routemap) = @_;; - foreach my $k (sort keys %$routemap) { - my @ok= grep { index($_,$k) >= 0 } @$allislands; - die "ambiguous $k" if @ok>1; - if (!@ok) { - $route_mysteries{$on}{$k}++; - delete $routemap->{$k}; - } elsif ($ok[0] ne $k) { - $routemap->{$ok[0]}= $routemap->{$k}; - delete $routemap->{$k}; - } - } -} - sub parse_info_serverside () { parse_info1('source-info.txt','s',0); } diff --git a/yarrg/TODO b/yarrg/TODO index 6b227eb..99c42d4 100644 --- a/yarrg/TODO +++ b/yarrg/TODO @@ -27,19 +27,12 @@ WEBSITE multi-visit routes / circular routes - adjustable potential cost of losses (rather than fixed - 1e-BIG per league) - use power formula (compound interest) - suggest 0.5% + allow unticking based on minimum margin or minimum profit initial/final stocks feature - max volume/mass - max capital - better documentation - printable voyage trading plan diff --git a/yarrg/db-idempotent-populate b/yarrg/db-idempotent-populate index 143e2ef..1d106f2 100755 --- a/yarrg/db-idempotent-populate +++ b/yarrg/db-idempotent-populate @@ -102,6 +102,13 @@ db_doall(<commit; } -#---------- island list ---------- -#---------- routes ---------- -# now done by yppedia-chart-parser - -__DATA__ +#---------- vessel types ---------- +{ + my $idempotent= $dbh->prepare(<<'END') + INSERT OR REPLACE INTO vessels (name, shot, mass, volume) + VALUES (?,?,?,?) +END + ; + foreach my $name (sort keys %vessels) { + my $v= $vessels{$name}; + my $shotdamage= $shotname2damage{$v->{Shot}}; + die "no shot damage for shot $v->{Shot} for vessel $name" + unless defined $shotdamage; + my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume)); + $idempotent->execute(@qa); + } + $dbh->commit; +} diff --git a/yarrg/ocean-topology-graph b/yarrg/ocean-topology-graph index 55d15d9..e609e35 100755 --- a/yarrg/ocean-topology-graph +++ b/yarrg/ocean-topology-graph @@ -20,7 +20,9 @@ $dbh->disconnect(); #print Dumper($results); print "strict graph $ocean {\n"; -#print " nodesep=10;\n"; +print " splines=true;\n"; +print " nslimit=10;\n"; +print " mclimit=10;\n"; foreach my $row (@$islands) { my ($id,$str) = @$row; @@ -29,8 +31,8 @@ foreach my $row (@$islands) { } foreach my $row (@$routes) { my ($ia,$ib,$dist) = @$row; - print " n$ia -- n$ib [ len=2, label=$dist ];\n"; - #len=$dist, minlen=$dist, weight=".(1.0/$dist).", len=".($dist*0.25+1).", + print " n$ia -- n$ib [ w=".(1.0/($dist*$dist)).", len=".(0.5*$dist+1).", label=$dist ];\n"; + #len=$dist, minlen=$dist, , , #w=".(1.0/$dist).", } diff --git a/yarrg/source-info.txt b/yarrg/source-info.txt index b7d285b..88b9311 100644 --- a/yarrg/source-info.txt +++ b/yarrg/source-info.txt @@ -1,4 +1,36 @@ +vessels +#| Ship Name |Gun Size|Volume | Mass | + |Sloop |small |20,250 |13,500 | + |----------------+--------+-------+-------| + |Cutter |small |60,750 |40,500 | + |----------------+--------+-------+-------| + |Dhow |medium |20,250 |13,500 | + |----------------+--------+-------+-------| + |Longship |small |20,250 |13,500 | + |----------------+--------+-------+-------| + |Baghlah |medium |27,000 |18,000 | + |----------------+--------+-------+-------| + |Merchant brig |medium |135,000|90,000 | + |----------------+--------+-------+-------| + |War brig |medium |81,000 |54,000 | + |----------------+--------+-------+-------| + |Merchant galleon|large |405,000|270,000| + |----------------+--------+-------+-------| + |Xebec |medium |182,250|121,500| + |----------------+--------+-------+-------| + |War frigate |large |324,000|216,000| + |----------------+--------+-------+-------| + |Grand frigate |large |810,000|540,000| +# From http://yppedia.puzzlepirates.com/Ship; when updating, +# delete unused columns and check heading is the same as above. +# If fields reordered must change parser in Commods.pm. + +shot + small 2 + medium 3 + large 4 + commods kraken's blood 1kg %c dye 1kg diff --git a/yarrg/update-master-info b/yarrg/update-master-info index c0bbbff..e2b0973 100755 --- a/yarrg/update-master-info +++ b/yarrg/update-master-info @@ -95,7 +95,7 @@ sub process_some_info ($$$) { next if $h =~ m/^nocommods/; } next if $sfn =~ m/source-info/ && $h =~ m/^ocean\b/; - next if $h =~ m/^client\b/; + next if $h =~ m/^client|^vessels|^shot\b/; print $df $_, "\n" or die $!; } diff --git a/yarrg/web/check_capacitystring b/yarrg/web/check_capacitystring index 3d8f7a5..13403b1 100644 --- a/yarrg/web/check_capacitystring +++ b/yarrg/web/check_capacitystring @@ -34,6 +34,8 @@ <%attr> +maxambig => 2 +abbrev_initials => 1 <%method preparse> @@ -42,47 +44,179 @@ $h <%perl> -my $def= sub { - my ($what,$val) = @_; - if (defined $h->{$what}) { - $h->{Emsg}= "Multiple definitions of maximum $what."; +my $parse_numeric= sub { + # returns (mass,volume,emsg) + my ($string,$default)= @_; + + my @mve= (undef,undef,undef); + + if ($string !~ m/\d/) { + return (undef,undef, + 'Adjustments to capacity must contain digits.'); + } + + my $def= sub { + my ($ix,$what,$val) = @_; + if (defined $h->{$what}) { + $mve[2]= "\`$string' specifies $what more than once."; + } + print STDERR "SET $what $val\n"; + $mve[$ix]= $val; + }; + +print STDERR "PAN \`$string'\n"; + local $_; + foreach $_ (split /\s+/, $string) { + print STDERR "ITEM \`$_'\n"; + next unless length; + if (m/^([1-9]\d{0,8})l$/) { + $def->(1, 'volume', $1); + } elsif (m/^([1-9]\d{0,8})kg$/) { + $def->(0, 'mass', $1); + } elsif (m/^([1-9]\d{0,5}(?:\.\d{0,3})?)kl/) { + $def->(1, 'volume', $1 * 1000); + } elsif (m/^([1-9]\d{0,5}(?:\.\d{0,3})?)t/) { + $def->(0, 'mass', $1 * 1000); + } else { + $mve[2]= "Cannot understand item \`$_'". + " in numeric capacity"; + } + } +# foreach my $ix (qw(0 1)) { +# $mve[$ix]= $default unless defined $mve[$ix]; +# } + return @mve; +}; + +my @mv_names= qw(mass volume); +my $canon_numeric= $h->{'canon_numeric'}= sub { + print STDERR "CANNUM @_\n"; + my $sep= ''; + my $out= ''; + foreach my $ix (qw(0 1)) { + next unless defined $_[$ix]; + $out .= $sep; $sep= ' '; + $out .= sprintf "%g%s", $_[$ix], (qw(kg l))[$ix]; } - print STDERR "SET $what $val\n"; - $h->{$what}= $val; + return $out; }; -foreach $_ (split /\s+/, ${ $h->{String} }) { - print STDERR "ITEM \`$_'\n"; - next unless length; - if (m/^([1-9]\d{0,8})l$/) { - $def->('volume', $1); - } elsif (m/^([1-9]\d{0,8})kg$/) { - $def->('mass', $1); - } elsif (m/^([1-9]\d{0,5}(?:\.\d{0,3})?)kl/) { - $def->('volume', $1 * 1000); - } elsif (m/^([1-9]\d{0,5}(?:\.\d{0,3})?)t/) { - $def->('mass', $1 * 1000); +$h->{'deltas'}= [ ]; +print STDERR "NDELTA0 $#{ $h->{'deltas'} }\n"; + +local ($_)= ${ $h->{String} }; +while (m/^(.*)(\bminus\b|-|\bplus\b|\+)/) { + my ($lhs,$rhs)= ($1,$'); + print STDERR "TERM L=\`$1' M=\`$2' R=\`$''\n"; + my ($signum,$signopstr)= + $2 =~ m/^p|^\+/ ? (+1,'plus') : (-1,'minus'); + my @mveco; + if ($rhs =~ m/^\s*(\d{1,2}(?:\.\d{0,4})?)\%\s*$/) { + my $pct= 100.0 + $signum * $1; + @mveco= ($pct,$pct,undef); + push @mveco, sprintf "%s %g%%", $signopstr, $1; + push @mveco, sub { + return undef unless defined $_[0]; + $_[0] * $_[1] / 100.0 + }; } else { - ${ $h->{Emsg} }= "Cannot understand capacity \`$_'."; - last; + @mveco= $parse_numeric->($rhs, 0); + if (!defined $mveco[2]) { + push @mveco, $signopstr.' '.$canon_numeric->(@mveco); + push @mveco, sub { + ${ $h->{Emsg} }= "Cannot add or subtract". + " mass to/from volume" + unless defined $_[0]; + $_[0] + $_[1] * $signum + }; + } } + ${ $h->{Emsg} }= $mveco[2] if defined $mveco[2]; + unshift @{ $h->{'deltas'} }, [ @mveco ]; + print STDERR "NDELTA $#{ $h->{'deltas'} }\n"; + $_= $lhs; } + +s/^\s+//; s/\s+$//; + +if (m/^[a-z ]+$/) { + push @{ $h->{Specs} }, $_; +} elsif (m/\d/) { + my (@mve)= $parse_numeric->($_, undef); + if (defined $mve[2]) { ${ $h->{Emsg} }= $mve[2]; return; } + $h->{'initial'}= \@mve; +} elsif (m/\S/) { + ${ $h->{Emsg} }= "Cannot understand capacity specification \`$_'."; +} else { + $h->{'initial'}= [undef,undef]; +} + +<%method sqlstmt> +SELECT name,mass,volume + FROM vessels WHERE name LIKE ? + + +<%method nomatch> + Did not understand ship name. + + +<%method ambiguous> + Ambiguous - could be <% $ARGS{couldbe} |h %> + + +<%method manyambig> + Too many matching ship types. + + <%method postquery> <%args> $h <%perl> -if (defined $h->{'mass'} or defined $h->{'volume'}) { - @{ $h->{Results} } = [ $h->{'mass'}, $h->{'volume'} ]; +my $canon_numeric= $h->{'canon_numeric'}; + +return if length ${ $h->{Emsg} }; - ${ $h->{Canon} }= - 'mass limit: '.(defined $h->{'mass'} ? $h->{'mass'} .'kg' : 'none').'; '. - 'volume limit: '.(defined $h->{'volume'} ? $h->{'volume'} .'l' : 'none').'.'; +my @mv; +my @mv_names= qw(mass volume); +if (@{ $h->{Specs} }) { + @mv= @{ $h->{Results}[0] }[1,2]; +} else { + @mv= @{ $h->{'initial'} }; + ${ $h->{Canon} }= $canon_numeric->(@mv); } +print STDERR "INITIAL @mv\n"; + +print STDERR "NDELTAE $#{ $h->{'deltas'} }\n"; +foreach my $delta (@{ $h->{'deltas'} }) { + print STDERR "DELTA @$delta\n"; + die if defined $delta->[2]; # emsg + foreach my $ix (qw(0 1)) { + next unless defined $delta->[$ix]; + print STDERR "DELTA I $ix\n"; + $mv[$ix] = $delta->[4]->($mv[$ix], $delta->[$ix]); + return if length ${ $h->{Emsg} }; + } + ${ $h->{Canon} }.= ' '.$delta->[3]; +} + +if (@{ $h->{Specs} } || @{ $h->{'deltas'} }) { + ${ $h->{Canon} }.= " [= ". $canon_numeric->(@mv). "]"; +} + +foreach my $ix (qw(0 1)) { + next unless defined $mv[$ix]; + next if $mv[$ix] >= 0; + ${ $h->{Emsg} }= sprintf "%s limit is negative: %s", + ucfirst($mv_names[$ix]), $canon_numeric->(@mv); + return; +} + +@{ $h->{Results} }= [ @mv ]; diff --git a/yarrg/web/docs b/yarrg/web/docs index cbb1c0d..6f754bf 100755 --- a/yarrg/web/docs +++ b/yarrg/web/docs @@ -101,7 +101,7 @@ After getting the results, you can untick various trades individually, and select `Update' to get a new plan. The unticked trades will be excluded from the voyage plan (if any) and also from the totals. -

Vessel capacity

+

Vessel capacity

If you don't specify a vessel or a vessel capacity, the trading plan will not take into account the fact that your voyage will be on a ship @@ -110,13 +110,36 @@ which trades excessively cumbersome goods (eg. hemp, wood, iron).

-So you should specify your vessel capacity. Currently you must -specify the actual mass and volume, as two numbers each with units. -The system understands the units t (tonnes), kg, l and kl -(kilolitres). There should be a space between the two limits, and no -space before the unit. +So you should specify your vessel capacity. You can enter things +like: +

+
sloop +
The capacity of a sloop, leaving no allowance for rum and shot +
wb - 1% +
The capacity of a war brig minus 1% +
13t 20kl +
13 tonnes (13,000kg), 20 kilolitres (20,000l) +
sloop - 100l 100kg +
The capacity of a sloop minus 100l, minus 100kg +
2t plus 500kg minus 200kg +
2300kg, with no limit on volume +
+Evaluation is strictly from left to right. -

Expected losses

+

+ +Formally, the capacity is a list of terms, all but the first preceded +by one of -, minus, +, +plus. Each term may specify a mass and/or a volume +(separated by a space), as a number followed (without an intervening +space) by a unit (t, kg, kl or +l). Alternatively each term except the first may specify a +percentage, which is applied as a percentage change to the answer from +all the preceding terms. The first term may be a ship name or +abbrevation instead. If the first term specifies only one of mass or +volume, all the subsequent terms may only adjust that same value. + +

Expected losses

In theory if you were guaranteed to have a trouble-free voyage it would be worth trading goods at very low margins. However, in @@ -134,14 +157,15 @@ to do.

-Trades whose margin is less than the expected loss are never selected. -For example, if you select 1% loss per league, and plan a voyage of 5 -leagues, then any trade with a margin of less than 5.15% would be -completely excluded (5.15% not 5% because the loss works like compound -interest). Theoretically very profitable trades which are close to -the expected break-even point because of the distance can also be -rejected by the optimiser in favour of shorter distance trades with -theoretically smaller margins. +Trades whose margin is less than the expected loss are never included +in the suggested plan. For example, if you select 1% loss per league, +and plan a voyage of 5 leagues, then any trade with a margin of less +than 5.15% would be completely excluded (5.15% not 5% because the loss +works like compound interest). Theoretically very profitable trades +which are close to the expected break-even point because of the +distance can also be rejected by the optimiser in favour of shorter +distance trades with theoretically smaller margins, if it's not +possible to do both.

diff --git a/yarrg/web/qtextstring b/yarrg/web/qtextstring index 639e9ab..d57f863 100644 --- a/yarrg/web/qtextstring +++ b/yarrg/web/qtextstring @@ -42,6 +42,7 @@ $thingstring $emsgstore $perresult $prefix => 'ts'; +$helpref => undef; <%perl> my $stringval= $qa->{$thingstring}; @@ -97,7 +98,7 @@ register_onload(<%$p%>Needed); id="<% $thingstring %>" name="<% $thingstring %>" onchange="<%$p%>Needed();" onkeyup="<%$p%>Later();" value="<% $stringval |h %>" - > + ><% defined($helpref) ? "[?]" : '' %>

 

diff --git a/yarrg/web/qtextstringcheck b/yarrg/web/qtextstringcheck index a489d8e..686a506 100755 --- a/yarrg/web/qtextstringcheck +++ b/yarrg/web/qtextstringcheck @@ -94,7 +94,11 @@ foreach my $each (@specs) { my $err= sub { $emsg= $_[0]; last; }; my %m; my $results; - foreach my $pat ("$each", "$each\%", "\%$each\%") { + my @pats= ("$each", "$each\%", "\%$each\%"); + if ($chk->attr_exists('abbrev_initials')) { + push @pats, join ' ', map { "$_%" } split //, $each; + } + foreach my $pat (@pats) { $sth->execute(($pat) x @sqlstmt_qs); $results= $sth->fetchall_arrayref(); last if @$results==1; diff --git a/yarrg/web/query_route b/yarrg/web/query_route index ea48357..9a6ca08 100644 --- a/yarrg/web/query_route +++ b/yarrg/web/query_route @@ -97,11 +97,12 @@ Enter route (islands, or archipelagoes, separated by |s or commas; Vessel or capacity: <&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'cs', thingstring => 'capacitystring', emsgstore => \$emsg, + helpref => 'capacity', perresult => sub { - ($max_volume,$max_mass) = @_; + ($max_mass,$max_volume) = @_; } &> - size=30 + size=40 @@ -113,9 +114,10 @@ Expected losses: <&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'll', thingstring => 'lossperleague', emsgstore => \$emsg, + helpref => 'losses', perresult => sub { ($lossperleaguepct)= @_; } &> - size=10 + size=9 diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade index 397e385..0da1fd8 100644 --- a/yarrg/web/routetrade +++ b/yarrg/web/routetrade @@ -264,6 +264,8 @@ foreach my $v (qw(MaxMass MaxVolume)) { <%perl> +my @total_massvol; + if (!@flows) { print 'No profitable trading opportunities were found.'; return; @@ -442,7 +444,7 @@ foreach my $ci (0..($#islandids-1)) { foreach my $mv (qw(mass volume)) { my $max_vn= "max_$mv"; my $max= $mv eq 'mass' ? $max_mass : $max_volume; - next unless defined $max; + $max= 1e9 unless defined $max; #print " DEFINED MAX $mv $max "; $cplex .= " ". sprintf("%-10s","${mv}_$ci:")." ". @@ -483,31 +485,54 @@ if ($qa->{'debug'}) { print "
\n" if $qa->{'debug'};
 	my $found_section= 0;
 	my $glpsol_out= '';
+	my $continuation='';
 	while (<$output>) {
 		$glpsol_out.= $_;
 		print encode_entities($_) if $qa->{'debug'};
-		if (m/^\s*No\.\s+Column name\s+(?:St\s+)?Activity\s/) {
-			die if $found_section>0;
+		if (m/^\s*No\.\s+(Row|Column) name\s+(?:St\s+)?Activity\s/) {
+			die "$_ $found_section ?" if $found_section>0;
 			$found_section= 1;
 			next;
 		}
 		next unless $found_section==1;
-		next if m/^[- ]+$/;
-		if (!/\S/) {
-			$found_section= 2;
-			next;
+		if (!length $continuation) {
+			next if !$continuation &&  m/^[- ]+$/;
+			if (!/\S/) {
+				$found_section= 0;
+				next;
+			}
+			if (m/^ \s* \d+ \s+ \w+ $/x) {
+				$continuation= $&;
+				next;
+			}
+		}
+		$_= $continuation.$_;
+		$continuation= '';
+		my ($varname, $qty) = m/^
+			\s* \d+ \s+
+			(\w+) \s+ (?: [A-Z*]+ \s+ )?
+			([0-9.]+) \s
+			/x or die "$_ ?";
+		if ($varname =~ m/^f(\d+)$/) {
+			my ($ix) = $1;
+			my $flow= $flows[$ix] or die;
+			$flow->{OptQty}= $qty;
+			$flow->{OptProfit}= $flow->{'unitprofit'} * $qty;
+			$flow->{OptCapital}= $flow->{OptQty} *
+				$flow->{'org_price'};
+		} elsif ($varname =~ m/^(mass|volume)_(\d+)$/) {
+			my ($mv,$ix) = ($1,$2);
+			$total_massvol[$ix]{$mv}= $qty;
 		}
-		my ($ix, $qty) =
-			m/^\s*\d+\s+f(\d+)\s+\S+\s+(\d+)\s/ or die "$_ ?";
-		my $flow= $flows[$ix] or die;
-		$flow->{OptQty}= $qty;
-		$flow->{OptProfit}= $flow->{'unitprofit'} * $qty;
-		$flow->{OptCapital}= $flow->{OptQty} * $flow->{'org_price'};
 	}
 	print "
\n" if $qa->{'debug'}; my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n "; pipethrough_run_finish($output,$prerr); - die $prerr unless $found_section; + map { defined $_->{OptQty} or die "$prerr $_->{Ix}" } @flows; +# map { defined +# die $prerr if grep { ! } @flows; +# map { die +# die $prerr if map { }; $addcols->({ DoReverse => 1, Special => sub { @@ -696,17 +721,40 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw( } } - my $total; + my ($total, $total_to_show); my $dline= 0; - my $show_flows= sub { - my ($od,$arbitrage,$collectdeliver) = @_; + my $show_total= sub { + my ($totaldesc, $sign) = @_; + if (defined $total) { + die if defined $total_to_show; + $total_total += $sign * $total; + $total_to_show= [ $totaldesc, $total ]; + $total= undef; + } + $dline= 0; + }; + my $show_total_now= sub { + my ($xinfo) = @_; + return unless defined $total_to_show; + my ($totaldesc,$totalwas) = @$total_to_show; -% + + +<% $xinfo %> +<% $totaldesc %> +<% $totalwas |h %> total +<%perl> + $total_to_show= undef; + }; + +% my $show_flows= sub { +% my ($od,$arbitrage,$collectdeliver) = @_; % my $todo= $flowlists{$od}; % return unless $todo; % foreach my $tkey (sort keys %$todo) { % my $t= $todo->{$tkey}; % next if $t->{"${od}Arbitrage"} != $arbitrage; +% $show_total_now->(''); % if (!$age_reported++) { % my $age= $now - $t->{Timestamp}; % my $cellid= "da_${i}"; @@ -743,25 +791,29 @@ $addcols->({ Total => 0, DoReverse => 1 }, qw( % $dline ^= 1; % } % }; -% my $show_total= sub { -% my ($totaldesc, $sign)= @_; -% if (defined $total) { - - -<% $totaldesc %> -<% $total |h %> total -% $total_total += $sign * $total; -% } -% $total= undef; -% $dline= 0; <%perl> - }; $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1); $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1); $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1); $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1); - + my $totals= ''; + if ($i < $#islandids) { + $totals .= "In hold $total_massvol[$i]{mass} kg,". + " $total_massvol[$i]{volume} l"; + my $delim= '; spare '; + my $domv= sub { + my ($max, $got, $units) = @_; + return unless defined $max; + $totals .= $delim; + $totals .= sprintf "%g %s", ($max-$got), $units; + $delim= ', '; + }; + $domv->($max_mass, $total_massvol[$i]{mass}, 'kg'); + $domv->($max_volume, $total_massvol[$i]{volume}, 'l'); + $totals .= ".\n"; + } + $show_total_now->($totals); }