{-# LANGUAGE OverloadedStrings #-}
module ProductMixAuction.Graphics.TQSSDemand
  ( tqssDemandChart
  , demandTQSSLineChart
  , normalisedBidsTQSSChart
  ) where

import Control.Arrow ((***))
import Control.Lens
import Data.List (nub, sortBy)
import Data.Maybe
import Data.Monoid hiding (All)
import Data.Ord (comparing, Down(..))
import qualified Data.Text as T
import Graphics.Plotly.Base hiding (x,y,z,i,j,k)
import Graphics.Plotly.Simple

import ProductMixAuction.Graphics.Types
import ProductMixAuction.LP
import ProductMixAuction.LP.Demand
import ProductMixAuction.LP.TQSS
import ProductMixAuction.Supply
import ProductMixAuction.Types


tqssDemandChart :: Ord bid => AuctionInput bid -> AuctionOutput bid -> [Plotly]
tqssDemandChart i o = case i ^. ac_tqss of
  Nothing -> []
  Just tqss -> case tqss ^. tqss_type of
                 TQSSAbsolute atqss -> [demandTQSSLineChart (tqss ^. tqss_fun) atqss (fromMaybe [] (o ^. ao_tqss_points))]
                 TQSSNormalised     -> [normalisedBidsTQSSChart i o (tqss ^. tqss_fun)]


-- Given a list of 2D points return two lists of 2D points.
-- The first list contains all the points of the input list with additional
-- gaps between any plateau (a gap tells plotly to stop connecting the points;
-- a plateau is any two consecutive points of same ordinate).
-- The second list contains only the pairs of plateau points separated by a
-- gap.
splitGaps :: [T2 Double] -> T2 [T2 Double]
splitGaps [] = ([], [])
splitGaps (xy0 : xys0) = go xy0 xys0
  where
    go (x0,y0) ((x1,y1) : xys)
      | y0 == y1  = ([(x0,y0),(x0,gap)] ++) *** ([(x0,y0),(x1,y1),(x1,gap)] ++) $ go (x1,y1) xys
      | otherwise = ((x0,y0) :) *** id $ go (x1,y1) xys
    go (x0,y0) [] = ([(x0,y0)], [])

    -- A Gap is Not a Number. Plotly treat any NaN as an instruction to stop
    -- connecting the points.
    gap :: Double
    gap = 0.0/0.0

-- | Generate a pair of traces for the given demand data, with solid
-- horizontal lines on plateaus and dashed diagonal lines elsewhere.
-- This is useful for calculated demand prices, where we know that
-- plateaus are accurate but diagonals are an approximation to
-- vertical lines.
demandLines :: Color -> T.Text -> [(Units,Double)] -> [Trace]
demandLines c n xs = [solid_t, dots_t]
  where
    dots_t  = linePlot ys & line ?~ (defLine & linecolor ?~ c & dash ?~ Dot)
                          & name ?~ (n <> " (dotted)")
                          & mode ?~ [Lines,Markers]
                          & traceshowlegend ?~ False
                          & hoverinfo ?~ HoverPlus [HoverX, HoverY]
    solid_t = linePlot zs & line ?~ (defLine & linecolor ?~ c & dash ?~ Solid)
                          & name ?~ n
                          & mode ?~ [Lines,Markers]
                          & hoverinfo ?~ HoverNone
    (ys, zs) = splitGaps (nub (sortBy (comparing (\ (x,y) -> (x, Down y))) [(_Units x, y) | (x,y) <- xs]))

-- | Plot a line chart of the TQSS and corresponding demand.
demandTQSSLineChart :: TQSSTable -> AbsoluteTQSS -> [TQSSPoint] -> Plotly
demandTQSSLineChart t atqss points =
  plotly "pma-demand-TQSS" trs
    & layout . title ?~ "TQSS and demand"
    & layout . xaxis ?~ axis "Auction size"
    & layout . yaxis ?~ axis (tqssTypeLabel (TQSSAbsolute atqss))
  where
    trs = tqssLine max_price t : demandLines lightred "Demand" [(_tqp_demand p, _tqp_price p) | p <- points]
    max_price =  round (1.1 * max (maybe 0 fromIntegral (maximumOf (traverse.step_price) t))
                                  (fromMaybe 0 (maximumOf (traverse.tqp_price) points)))

tqssLine :: Price -> TQSSTable -> Trace
tqssLine max_price t = linePlot (stepsToPoints max_price t)
             & line ?~ (defLine & linecolor ?~ lightblue & dash ?~ Solid)
             & name ?~ "Supply"


-- | Plot a chart showing the TQSS and the normalised total demand of
-- all bids in the auction.  See 'normalisedTotalDemandPoints' for how
-- this is calculated.  This is drawn only for a horizontal auction
-- with a normalised, constrained TQSS.
normalisedBidsTQSSChart :: Ord bid
                        => AuctionInput bid -> AuctionOutput bid -> TQSSTable
                        -> Plotly
normalisedBidsTQSSChart i o t
  = plotly "pma-normalised-bids-tqss" [tqssLine max_price t, tr]
      & layout . title ?~ "TQSS and (normalised) total demand"
      & layout . xaxis ?~ axis "Quantity"
      & layout . yaxis ?~ axis "Normalised price"
      & layout %~ addFooter ("When some bids are paired, graph of demand is approximate " <>
                             "for quantities exceeding total actually allocated.")
  where
    tr = linePlot pts
           & line ?~ (defLine & linecolor ?~ lightred)
           & name ?~ "Demand"

    max_price = round (1.1 * fromIntegral (max (fromMaybe 0 (maximumOf (traverse.step_price) t))
                                               (fromMaybe 0 (maximumOf (traverse._2) pts))) :: Double)

    pts    = normalisedTotalDemandPoints supply bids ps allocs
    supply = i ^. ac_supply
    bids   = flattenBidders (i ^. ac_bidders)
    ps     = o ^. ao_prices
    allocs = o ^. ao_bid_allocations