X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fweb%2Froutetrade;h=0adf9920bbbc6bb96bd0f05ad0f7d4fa78ece764;hb=f6d7a4d627f3ecc0624649bb895dbf8e59afcf47;hp=c5c2ab7e3b8d042de5660aaef9f4f96d2940865b;hpb=2007f48bd68be9218b8f41acd9ba32d378a1b22c;p=ypp-sc-tools.db-live.git

diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade
index c5c2ab7..0adf992 100644
--- a/yarrg/web/routetrade
+++ b/yarrg/web/routetrade
@@ -32,6 +32,21 @@
  This Mason component is the core trade planner for a specific route.
 
 
+========== TODO ==========
+16:36 <ceb> alpha,byrne,papaya,turtle,jorvik,luthien is my example
+
+16:46 <ceb> Also trading plan not functional but I guess you know that :-)
+
+use POST for update.  Hrrm.
+
+LATER OR NOT AT ALL
+
+adjustable potential cost of losses (rather than fixed 1e-BIG per league)
+
+max volume/mass
+
+========== TODO ==========
+
 </%doc>
 <%args>
 $dbh
@@ -41,6 +56,8 @@ $qa
 </%args>
 <%perl>
 
+my $loss_per_league= 1e-7;
+
 my @flow_conds;
 my @query_params;
 
@@ -98,9 +115,11 @@ my $stmt= "
 	SELECT  sell_islands.islandname				org_name,
 		sell_islands.islandid				org_id,
 		sell.price					org_price,
+		sell_uploads.timestamp				org_timestamp,
 		buy_islands.islandname				dst_name,
 		buy_islands.islandid				dst_id,
 		buy.price					dst_price,
+		buy_uploads.timestamp				dst_timestamp,
 ".($qa->{ShowStalls} ? "
 		sell.stallid					org_stallid,
 		sell_stalls.stallname				org_stallname,
@@ -116,16 +135,20 @@ my $stmt= "
 		commods.commodid				commodid,
 		commods.unitmass				unitmass,
 		commods.unitvolume				unitvolume,
+		dist						dist,
 		buy.price - sell.price				unitprofit
 	FROM commods
-	JOIN buy  on commods.commodid = buy.commodid
-	JOIN sell on commods.commodid = sell.commodid
-	JOIN islands as sell_islands on sell.islandid = sell_islands.islandid
-	JOIN islands as buy_islands  on buy.islandid  = buy_islands.islandid
+	JOIN buy  ON commods.commodid = buy.commodid
+	JOIN sell ON commods.commodid = sell.commodid
+	JOIN islands AS sell_islands ON sell.islandid = sell_islands.islandid
+	JOIN islands AS buy_islands  ON buy.islandid  = buy_islands.islandid
+	JOIN uploads AS sell_uploads ON sell.islandid = sell_uploads.islandid
+	JOIN uploads AS buy_uploads  ON buy.islandid  = buy_uploads.islandid
 ".($qa->{ShowStalls} ? "
-	JOIN stalls  as sell_stalls  on sell.stallid  = sell_stalls.stallid
-	JOIN stalls  as buy_stalls   on buy.stallid   = buy_stalls.stallid
+	JOIN stalls  AS sell_stalls  ON sell.stallid  = sell_stalls.stallid
+	JOIN stalls  AS buy_stalls   ON buy.stallid   = buy_stalls.stallid
 " : "")."
+	JOIN dists ON aiid = sell.islandid AND biid = buy.islandid
 	WHERE	(
 		".join("
 	   OR	", @flow_conds)."
@@ -142,16 +165,33 @@ my $sth= $dbh->prepare($stmt);
 $sth->execute(@query_params);
 my @flows;
 
-my @columns;
+my @cols= ({ NoSort => 1 });
+
+my $addcols= sub {
+	my $base= shift @_;
+	foreach my $name (@_) {
+		my $col= { Name => $name, %$base };
+		$col->{Numeric}=1 if !$col->{Text};
+		push @cols, $col;
+	}
+};
+
 if ($qa->{ShowStalls}) {
-	push @columns,	     qw(org_name org_stallname dst_name dst_stallname);
+	$addcols->({ Text => 1 }, qw(
+		org_name org_stallname
+		dst_name dst_stallname
+	));
 } else {
-	push @columns,	     qw(org_name dst_name);
+	$addcols->({Text => 1 }, qw(
+		org_name dst_name
+	));
 }
-push @columns,		     qw(commodname
-				org_price org_qty dst_price dst_qty
-				unitprofit PctProfit
-				MaxQty MaxCapital MaxProfit);
+$addcols->({ Text => 1 }, qw(commodname));
+$addcols->({ DoReverse => 1 },
+	qw(	org_price org_qty dst_price dst_qty
+		Margin unitprofit MaxQty
+		MaxCapital MaxProfit
+	));
 
 </%perl>
 
@@ -162,16 +202,104 @@ push @columns,		     qw(commodname
 </pre>
 % }
 
+<& dumptable:start, qa => $qa, sth => $sth &>
 % {
-<& dumptable:start, sth => $sth &>
-%   my $flow;
-%   while ($flow= $sth->fetchrow_hashref()) {
-%	$flow->{Ix}= @flows;
-%	$flow->{Var}= "f$flow->{Ix}";
-%	push @flows, $flow;
-<& dumptable:row, sth => $sth, row => $flow &>
+%   my $f;
+%   while ($f= $sth->fetchrow_hashref()) {
+<%perl>
+
+	$f->{Ix}= @flows;
+	$f->{Var}= "f$f->{Ix}";
+
+	$f->{MaxQty}= $f->{'org_qty'} < $f->{'dst_qty'}
+		? $f->{'org_qty'} : $f->{'dst_qty'};
+	$f->{MaxProfit}= $f->{MaxQty} * $f->{'unitprofit'};
+	$f->{MaxCapital}= $f->{MaxQty} * $f->{'org_price'};
+
+	$f->{Margin}= sprintf "%3.1f%%",
+		$f->{'dst_price'} * 100.0 / $f->{'org_price'} - 100.0;
+
+	$f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
+		if !$qa->{ShowStalls};
+
+	$f->{ExpectedUnitProfit}=
+		$f->{'dst_price'} * (1.0 - $loss_per_league) ** $f->{'dist'}
+		- $f->{'src_price'};
+
+	my @uid= $f->{commodid};
+	foreach my $od (qw(org dst)) {
+		push @uid,
+			$f->{"${od}_id"},
+			$f->{"${od}_price"};
+		push @uid,
+			$f->{"${od}_stallid"}
+				if $qa->{ShowStalls};
+	}
+	$f->{UidLong}= join '_', @uid;
+
+	my $base= 31;
+	my $cmpu= '';
+	map {
+		my $uue= $_;
+		my $first= $base;
+		do {
+			my $this= $uue % $base;
+print STDERR "uue=$uue this=$this ";
+			$uue -= $this;
+			$uue /= $base;
+			$this += $first;
+			$first= 0;
+			$cmpu .= chr($this + ($this < 26 ? ord('a') :
+					      $this < 52 ? ord('A')-26
+							 : ord('0')-52));
+print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
+die "$cmpu $uue ?" if length $cmpu > 20;
+		} while ($uue);
+		$cmpu;
+	} @uid;
+	$f->{UidShort}= $cmpu;
+
+	if ($qa->{'debug'}) {
+		my @outuid;
+		$_= $f->{UidShort};
+		my $mul;
+		while (m/./) {
+			my $v= m/^[a-z]/ ? ord($&)-ord('a') :
+			       m/^[A-Z]/ ? ord($&)-ord('A')+26 :
+			       m/^[0-9]/ ? ord($&)-ord('0')+52 :
+			       die "$_ ?";
+			if ($v >= $base) {
+				push @outuid, 0;
+				$v -= $base;
+				$mul= 1;
+#print STDERR "(next)\n";
+			}
+			die "$f->{UidShort} $_ ?" unless defined $mul;
+			$outuid[$#outuid] += $v * $mul;
+
+#print STDERR "$f->{UidShort}  $_  $&  v=$v  mul=$mul  ord()=".ord($&).
+#			"[vs.".ord('a').",".ord('A').",".ord('0')."]".
+#			"  outuid=@outuid\n";
+
+			$mul *= $base;
+			s/^.//;
+		}
+		my $recons_long= join '_', @outuid;
+		$f->{UidLong} eq $recons_long or
+			die "$f->{UidLong} = $f->{UidShort} = $recons_long ?";
+	}
+
+	if (defined $qa->{"R$f->{UidShort}"} &&
+	    !defined $qa->{"T$f->{UidShort}"}) {
+		$f->{Suppress}= 1;
+	}
+
+	push @flows, $f;
+
+</%perl>
+<& dumptable:row, qa => $qa, sth => $sth, row => $f &>
 %   }
-<& dumptable:end &>
+<& dumptable:end, qa => $qa &>
 % }
 
 % my $optimise= $specific && !$confusing && @islandids>1;
@@ -198,20 +326,31 @@ Maximize
 
   totalprofit:
                   ".(join " +
-                  ", map { "$_->{unit_profit} $_->{Var}" } @flows)."
+                  ", map {
+			sprintf "%.20f %s", $_->{ExpectedUnitProfit}, $_->{Var}
+			} @flows)."
 
 Subject To
 ";
 
 my %avail_csts;
 foreach my $flow (@flows) {
+	if ($flow->{Suppress}) {
+		$cplex .= "
+   $flow->{Var} = 0
+";
+		next;
+	}
 	foreach my $od (qw(org dst)) {
-		my $cstname= join '_',
+		my $cstname= join '_', (
 			'avail',
 			$flow->{'commodid'},
 			$od,
 			$flow->{"${od}_id"},
-			$flow->{"${od}_price"};
+			$flow->{"${od}_price"},
+			$flow->{"${od}_stallid"},
+		);
+			
 		push @{ $avail_csts{$cstname}{Flows} }, $flow->{Var};
 		$avail_csts{$cstname}{Qty}= $flow->{"${od}_qty"};
 	}
@@ -272,19 +411,35 @@ if ($qa->{'debug'}) {
 	die unless $found_section;
 };
 
-print join ' ', map { $_->{Optimal} } @flows;
-
-push @columns, qw(OptQty OptCapital OptProfit);
+$addcols->({ DoReverse => 1 }, qw(
+		OptQty
+	));
+$addcols->({ Total => 0, DoReverse => 1 }, qw(
+		OptCapital OptProfit
+	));
 
 </%perl>
 
 % } # ========== OPTIMISATION ==========
 
+% my %ts_sortkeys;
 % {
 %	my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
 %	my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
-<table>
-<tr>
+<table id="trades" rules=groups>
+<colgroup span=1>
+<colgroup span=2>
+<% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
+<colgroup span=1>
+<colgroup span=2>
+<colgroup span=2>
+<colgroup span=2>
+<colgroup span=3>
+%	if ($optimise) {
+<colgroup span=3>
+%	}
+<tr class="spong">
+<th>
 <th<% $cdspan %>>Collect
 <th<% $cdspan %>>Deliver
 <th>
@@ -293,10 +448,11 @@ push @columns, qw(OptQty OptCapital OptProfit);
 <th colspan=2>Profit
 <th colspan=3>Max
 %	if ($optimise) {
-<th colspan=3>Suggested
+<th colspan=3>Planned
 %	}
 
 <tr>
+<th>
 <th>Island <% $cdstall %>
 <th>Island <% $cdstall %>
 <th>Commodity
@@ -304,8 +460,8 @@ push @columns, qw(OptQty OptCapital OptProfit);
 <th>Qty
 <th>Price
 <th>Qty
-<th>Unit
 <th>Margin
+<th>Unit
 <th>Qty
 <th>Capital
 <th>Profit
@@ -316,20 +472,125 @@ push @columns, qw(OptQty OptCapital OptProfit);
 %	}
 % }
 
-% foreach my $flow (@flows) {
-<tr>
-%	foreach my $col (@columns) {
-%		$flow->{MaxQty}= $flow->{'org_qty'} < $flow->{'dst_qty'}
-%			? $flow->{'org_qty'} : $flow->{'dst_qty'};
-%		$flow->{MaxProfit}= $flow->{MaxQty} * $flow->{'unitprofit'};
-%		$flow->{PctProfit}= sprintf "%3.1f%%",
-%			$flow->{'dst_price'} * 100.0 / $flow->{'org_price'}
-%			- 100.0;
-%		$flow->{MaxCapital}= $flow->{MaxQty} * $flow->{'org_price'};
-<td><% $flow->{$col} |h %>
+<tr id="trades_sort">
+% foreach my $col (@cols) {
+<th>
+% }
+
+% foreach my $flowix (0..$#flows) {
+%	my $flow= $flows[$flowix];
+%	my $rowid= "id_row_$flow->{UidShort}";
+<tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
+<td><input type=hidden   name=R<% $flow->{UidShort} %> value="">
+    <input type=checkbox name=T<% $flow->{UidShort} %> value=""
+       <% $flow->{Suppress} ? '' : 'checked' %> >
+%	foreach my $ci (1..$#cols) {
+%		my $col= $cols[$ci];
+%		my $v= $flow->{$col->{Name}};
+%		$col->{Total} += $v if defined $col->{Total};
+%		$v='' if !$col->{Text} && !$v;
+%		$ts_sortkeys{$ci}{$rowid}= $v;
+<td <% $col->{Text} ? '' : 'align=right' %>><% $v |h %>
+%	}
+% }
+<tr id="trades_total">
+<th>
+<th colspan=2>Total
+% foreach my $ci (3..$#cols) {
+%	my $col= $cols[$ci];
+<td align=right>
+%	if (defined $col->{Total}) {
+<% $col->{Total} |h %>
+%	}
+% }
+</table>
+
+<& tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
+	throw => 'trades_sort', tbrow => 'trades_total' &>
+<&| script &>
+  ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
+  function all_onload() {
+    ts_onload__trades();
+  }
+  window.onload= all_onload;
+</&script>
+
+<input type=submit name=update value="Update">
+
+% if ($optimise) { # ========== TRADING PLAN ==========
+%
+% my $iquery= $dbh->prepare('SELECT islandname FROM islands
+%				WHERE islandid = ?');
+%
+<h1>Voyage trading plan</h1>
+<table>
+% foreach my $i (0..$#islandids) {
+<tr><td colspan=4><strong>
+%	$iquery->execute($islandids[$i]);
+%	my ($islandname) = $iquery->fetchrow_array();
+%	if (!$i) {
+Start at <% $islandname |h %>
+%	} else {
+Sail to <% $islandname |h %>
+%	}
+</strong>
+%    foreach my $od (qw(dst org)) {
+%	my $sign= $od eq 'dst' ? -1 : +1;
+%	my %todo;
+%	foreach my $f (@flows) {
+%		next if $f->{Suppress};
+%		next unless $f->{"${od}_id"} == $islandids[$i];
+%		next unless $f->{OptQty};
+%		my $price= $f->{"${od}_price"};
+%		my $stallname= $f->{"${od}_stallname"};
+%		my $todo= \$todo{ $f->{'commodname'},
+%				  (sprintf "%07d", $price),
+%				  $stallname };
+%		$$todo= { } unless $$todo;
+%		$$todo->{'commodname'}= $f->{'commodname'};
+%		$$todo->{'stallname'}= $stallname;
+%		$$todo->{Price} += $price;
+%		$$todo->{Qty} += $f->{OptQty};
+%		$$todo->{Total} = $$todo->{Price} * $$todo->{Qty};
+%		$$todo->{Timestamp} = $f->{"${od}_timestamp"};
+%	}
+%	my $total= 0;
+%	my $dline= 0;
+%	foreach my $tkey (sort keys %todo) {
+%		my $t= $todo{$tkey};
+%		$total += $t->{Total};
+<tr class="datarow<% $dline %>"><td>
+%		if ($od eq 'org') {
+Collect
+%		} else {
+Deliver
+%		}
+<td><% $t->{'commodname'} |h %>
+<td align=right><% $t->{Price} |h %> each
+%		if ($qa->{ShowStalls}) {
+<td><% $t->{'stallname'} |h %>
+%		}
+<td align=right><% $t->{Qty} |h %> unit(s)
+<td align=right><% $t->{Total} |h %> total
+%		$dline ^= 1;
+%	}
+%	if (%todo) {
+<tr><td>
+<td colspan=<% 2+!!$qa->{ShowStalls} %>>
+<% (values %todo)[0]->{Timestamp} %>
+<td align=right>
+%		if ($od eq 'org') {
+Outlay
+%		} else {
+Proceeds
+%		}
+<td align=right><% $total |h %> total
 %	}
+%    }
 % }
 </table>
+%
+% } # ========== TRADING PLAN ==========
 
 <%init>
 use CommodsWeb;