-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Axis.Floating
-- Copyright   :  (c) Tim Docker 2010, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- Calculate and render floating value axes
-- including doubles with linear, log, and percentage scaling.
--

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Graphics.Rendering.Chart.Axis.Floating(
    Percent(..),
    LinearAxisParams(..),
    LogValue(..),
    LogAxisParams(..),
    scaledAxis,
    autoScaledAxis,
    autoScaledLogAxis,
    autoSteps,

    la_labelf,
    la_nLabels,
    la_nTicks,

    loga_labelf
) where

import Data.List(minimumBy)
import Data.Ord (comparing)
import Data.Default.Class
import Numeric (showEFloat, showFFloat)

import Control.Lens
import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Utils
import Graphics.Rendering.Chart.Axis.Types

-- Note: the following code uses explicit Integer types
-- to avoid -Wall 'defaulting to Integer' messages.

instance PlotValue Double where
    toValue  = id
    fromValue= id
    autoAxis = autoScaledAxis def

instance PlotValue Float where
    toValue  = realToFrac
    fromValue= realToFrac
    autoAxis = autoScaledAxis def

-- | A wrapper class for doubles used to indicate they are to
-- be plotted against a percentage axis.
newtype Percent = Percent {unPercent :: Double}
    deriving (Eq,Ord,Num,Real,Fractional,RealFrac,Floating,RealFloat)

instance Show Percent where
    show (Percent d) = showD (d*100) ++ "%"

instance PlotValue Percent where
    toValue  = unPercent
    fromValue= Percent
    autoAxis = autoScaledAxis def {-_la_labelf=-}

-- | A wrapper class for doubles used to indicate they are to
-- be plotted against a log axis.
newtype LogValue = LogValue Double
    deriving (Eq, Ord, Num, Real, Fractional, RealFrac, Floating, RealFloat)

instance Show LogValue where
    show (LogValue x) = show x

instance PlotValue LogValue where
    toValue (LogValue x) = log x
    fromValue d          = LogValue (exp d)
    autoAxis             = autoScaledLogAxis def

-- | Show a list of axis labels.
-- If some are too big or all are too small, switch to scientific notation for all.
-- If the range is much smaller than the mean, use an offset.
-- TODO: show this offset only once, not on every label.
-- When thinking about improving this function,
-- https://github.com/matplotlib/matplotlib/blob/master/lib/matplotlib/ticker.py
-- is a good read.
--
-- >>> showDs [0, 1, 2 :: Double]
-- ["0","1","2"]
--
-- >>> showDs [0, 1000000, 2000000 :: Double]
-- ["0.0e0","1.0e6","2.0e6"]
--
-- >>> showDs [0, 0.001, 0.002 :: Double]
-- ["0","0.001","0.002"]
--
-- >>> showDs [-10000000, -1000000, 9000000 :: Double]
-- ["-1.0e7","-1.0e6","9.0e6"]
--
-- >>> showDs [10, 11, 12 :: Double]
-- ["10","11","12"]
--
-- >>> showDs [100, 101, 102 :: Double]
-- ["100","101","102"]
--
-- >>> showDs [100000, 100001, 100002 :: Double]
-- ["100000","100001","100002"]
--
-- >>> showDs [1000000, 1000001, 1000002 :: Double]
-- ["1.0e6 + 0","1.0e6 + 1","1.0e6 + 2"]
--
-- >>> showDs [10000000, 10000001, 10000002 :: Double]
-- ["1.0e7 + 0","1.0e7 + 1","1.0e7 + 2"]
--
-- >>> showDs [-10000000, -10000001, -10000002 :: Double]
-- ["-1.0e7 + 2","-1.0e7 + 1","-1.0e7 + 0"]
--
-- prop> let [s0, s1] = showDs [x, x + 1.0 :: Double] in s0 /= s1
showDs :: forall d . (RealFloat d) => [d] -> [String]
showDs xs = case showWithoutOffset xs of
  (s0:others)
    | anyEqualNeighbor s0 others -> map addShownOffset $ showWithoutOffset (map (\x -> x - offset) xs)
  s -> s
  where
    anyEqualNeighbor z0 (z1:others)
      | z0 == z1 = True
      | otherwise = anyEqualNeighbor z1 others
    anyEqualNeighbor _ [] = False

    -- Use the min for offset. Another good choice could be the mean.
    offset :: d
    offset = minimum xs
    shownOffset = case showWithoutOffset [offset] of
      [r] -> r
      rs -> error $ "showDs: shownOffset expected 1 element, got " ++ show (length rs)

    addShownOffset :: String -> String
    addShownOffset ('-':x) = shownOffset ++ " - " ++ x
    addShownOffset x = shownOffset ++ " + " ++ x

showWithoutOffset :: RealFloat d => [d] -> [String]
showWithoutOffset xs
  | useScientificNotation = map (\x -> showEFloat' (Just 1) x) xs
  | otherwise = map showD xs
  where
    -- use scientific notation if max value is too big or too small
    useScientificNotation = maxAbs >= 1e6 || maxAbs <= 1e-6
    maxAbs = maximum (map abs xs)


-- | Changes the behavior of showEFloat to drop more than one trailings 0.
-- Instead of 1.000e4 you get 1.0e4
showEFloat' :: forall d . RealFloat d => Maybe Int -> d -> String
showEFloat' mdigits x = reverse $ cleanup0 (reverse shown0)
  where
    shown0 = showEFloat mdigits x ""

    -- wait until we get the "e"
    cleanup0 :: String -> String
    cleanup0 (e@'e':ys) = e:cleanup1 ys
    cleanup0 (y:ys) = y : cleanup0 ys
    cleanup0 [] = reverse shown0 -- something went wrong, just return the original

    -- get rid of redundant 0s before the '.'
    cleanup1 :: String -> String
    cleanup1 ('0':ys@('0':_)) = cleanup1 ys
    cleanup1 y = y


showD :: (RealFloat d) => d -> String
showD x = case reverse $ showFFloat Nothing x "" of
            '0':'.':r -> reverse r
            r         -> reverse r

data LinearAxisParams a = LinearAxisParams {
    -- | The function used to show the axes labels.
    _la_labelf  :: [a] -> [String],

    -- | The target number of labels to be shown.
    _la_nLabels :: Int,

    -- | The target number of ticks to be shown.
    _la_nTicks  :: Int
}

instance (Show a, RealFloat a) => Default (LinearAxisParams a) where
  def = LinearAxisParams 
    { _la_labelf    = showDs
    , _la_nLabels   = 5
    , _la_nTicks    = 50
    }

-- | Generate a linear axis with the specified bounds
scaledAxis :: RealFloat a => LinearAxisParams a -> (a,a) -> AxisFn a
scaledAxis lap rs@(minV,maxV) ps0 = makeAxis' realToFrac realToFrac
                                         (_la_labelf lap) (labelvs,tickvs,gridvs)
  where
    ps        = filter isValidNumber ps0
    range []  = (0,1)
    range _   | minV == maxV = if minV==0 then (-1,1) else
                               let d = abs (minV * 0.01) in (minV-d,maxV+d)
              | otherwise    = rs
    labelvs   = map fromRational $ steps (fromIntegral (_la_nLabels lap)) r
    tickvs    = map fromRational $ steps (fromIntegral (_la_nTicks lap))
                                         (minimum labelvs,maximum labelvs)
    gridvs    = labelvs
    r         = range ps

-- | Generate a linear axis automatically, scaled appropriately for the
-- input data.
autoScaledAxis :: RealFloat a => LinearAxisParams a -> AxisFn a
autoScaledAxis lap ps0 = scaledAxis lap rs ps
  where
    ps = filter isValidNumber ps0
    rs = (minimum ps,maximum ps)

steps :: RealFloat a => a -> (a,a) -> [Rational]
steps nSteps rs@(minV,maxV) = map ((s*) . fromIntegral) [min' .. max']
  where
    s    = chooseStep nSteps rs
    min' :: Integer
    min' = floor   $ realToFrac minV / s
    max' = ceiling $ realToFrac maxV / s

chooseStep :: RealFloat a => a -> (a,a) -> Rational
chooseStep nsteps (x1,x2) = minimumBy (comparing proximity) stepVals
  where
    delta = x2 - x1
    mult  | delta == 0 = 1  -- Otherwise the case below will use all of memory
          | otherwise  = 10 ^^ ((floor $ log10 $ delta / nsteps)::Integer)
    stepVals = map (mult*) [0.1,0.2,0.25,0.5,1.0,2.0,2.5,5.0,10,20,25,50]
    proximity x = abs $ delta / realToFrac x - nsteps

-- | Given a target number of values, and a list of input points,
--   find evenly spaced values from the set {1*X, 2*X, 2.5*X, 5*X} (where
--   X is some power of ten) that evenly cover the input points.
autoSteps :: Int -> [Double] -> [Double]
autoSteps nSteps vs = map fromRational $ steps (fromIntegral nSteps) r
  where
    range []  = (0,1)
    range _   | minV == maxV = (minV-0.5,minV+0.5)
              | otherwise    = rs
    rs@(minV,maxV) = (minimum ps,maximum ps)
    ps        = filter isValidNumber vs
    r         = range ps

----------------------------------------------------------------------

instance (Show a, RealFloat a) => Default (LogAxisParams a) where
  def = LogAxisParams 
    { _loga_labelf = showDs
    }

-- | Generate a log axis automatically, scaled appropriate for the
-- input data.
autoScaledLogAxis :: RealFloat a => LogAxisParams a -> AxisFn a
autoScaledLogAxis lap ps0 =
    makeAxis' (realToFrac . log) (realToFrac . exp)
              (_loga_labelf lap) (wrap rlabelvs, wrap rtickvs, wrap rgridvs)
        where
          ps        = filter (\x -> isValidNumber x && 0 < x) ps0
          (minV,maxV) = (minimum ps,maximum ps)
          wrap      = map fromRational
          range []  = (3,30)
          range _   | minV == maxV = (realToFrac $ minV/3, realToFrac $ maxV*3)
                    | otherwise    = (realToFrac $ minV,   realToFrac $ maxV)
          (rlabelvs, rtickvs, rgridvs) = logTicks (range ps)


data LogAxisParams a = LogAxisParams {
    -- | The function used to show the axes labels.
    _loga_labelf :: [a] -> [String]
}

{-
 Rules: Do not subdivide between powers of 10 until all powers of 10
          get a major ticks.
        Do not subdivide between powers of ten as [1,2,4,6,8,10] when
          5 gets a major ticks
          (ie the major ticks need to be a subset of the minor tick)
-}
logTicks :: Range -> ([Rational],[Rational],[Rational])
logTicks (low,high) = (major,minor,major)
 where
  pf :: RealFrac a => a -> (Integer, a)
  pf = properFraction

  -- frac :: (RealFrac a, Integral b) => a -> (b, a)
  frac :: (RealFrac a) => a -> (Integer, a)
  frac x | 0 <= b    = (a,b)
         | otherwise = (a-1,b+1)
    where
      (a,b) = properFraction x

  ratio      = high/low
  lower a l  = let (i,r) = frac (log10 a) in
               maximum (1:filter (\x -> log10 (fromRational x) <= r) l)*10^^i
  upper a l  = let (i,r) = pf (log10 a) in
               minimum (10:filter (\x -> r <= log10 (fromRational x)) l)*10^^i
               
  powers           :: (Double,Double) -> [Rational] -> [Rational]
  powers (x,y) l    = [ a*10^^p | p <- [(floor (log10 x))..(ceiling (log10 y))] :: [Integer]
                                , a <- l ]
  midselection r l  = filter (inRange r l) (powers r l)
  inRange (a,b) l x = (lower a l <= x) && (x <= upper b l)
  
  logRange = (log10 low, log10 high)
  
  roundPow x = 10^^(round x :: Integer)
  
  major | 17.5 < log10 ratio = map roundPow $
                               steps (min 5 (log10 ratio)) logRange
        | 12 < log10 ratio   = map roundPow $
                               steps (log10 ratio / 5) logRange
        | 6 < log10 ratio    = map roundPow $
                               steps (log10 ratio / 2) logRange
        | 3 < log10 ratio    = midselection (low,high) [1,10]
        | 20 < ratio         = midselection (low,high) [1,5,10]
        | 6 < ratio          = midselection (low,high) [1,2,4,6,8,10]
        | 3 < ratio          = midselection (low,high) [1..10]
        | otherwise          = steps 5 (low,high)

  (l',h')   = (minimum major, maximum major)
  (dl',dh') = (fromRational l', fromRational h')
  ratio' :: Double
  ratio' = fromRational (h'/l')
  filterX = filter (\x -> l'<=x && x <=h') . powers (dl',dh') 
  
  minor | 50 < log10 ratio' = map roundPow $
                              steps 50 (log10 dl', log10 dh')
        | 6 < log10 ratio'  = filterX [1,10]
        | 3 < log10 ratio'  = filterX [1,5,10]
        | 6 < ratio'        = filterX [1..10]
        | 3 < ratio'        = filterX [1,1.2..10]
        | otherwise         = steps 50 (dl', dh')


log10 :: (Floating a) => a -> a
log10 = logBase 10

$( makeLenses ''LinearAxisParams )
$( makeLenses ''LogAxisParams )