{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}

module Perf.Chart where

import Chart
import Control.Category ((>>>))
import Data.Bifunctor
import Data.Bool
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as Text
import GHC.Generics
import Optics.Core
import Options.Applicative
import Perf.Stats as Perf
import Prettychart

--     m <- fromDump defaultPerfDumpOptions
data PerfChartOptions
  = PerfChartOptions
  { PerfChartOptions -> Bool
doChart :: Bool,
    PerfChartOptions -> FilePath
chartFilepath :: FilePath,
    PerfChartOptions -> Double
truncateAt :: Double,
    PerfChartOptions -> Bool
doSmallChart :: Bool,
    PerfChartOptions -> Bool
doBigChart :: Bool,
    PerfChartOptions -> Bool
doHistChart :: Bool,
    PerfChartOptions -> Bool
doAveragesLegend :: Bool,
    PerfChartOptions -> Style
averagesStyle :: Style,
    PerfChartOptions -> Int
averagesPaletteStart :: Int,
    PerfChartOptions -> LegendOptions
averagesLegend :: LegendOptions,
    PerfChartOptions -> Style
smallStyle :: Style,
    PerfChartOptions -> HudOptions
smallHud :: HudOptions,
    PerfChartOptions -> Style
bigStyle :: Style,
    PerfChartOptions -> HudOptions
bigHud :: HudOptions,
    PerfChartOptions -> Double
titleSize :: Double,
    PerfChartOptions -> Int
histGrain :: Int,
    PerfChartOptions -> Double
bigWidth :: Double,
    PerfChartOptions -> Bool
excludeZeros :: Bool
  }
  deriving (PerfChartOptions -> PerfChartOptions -> Bool
(PerfChartOptions -> PerfChartOptions -> Bool)
-> (PerfChartOptions -> PerfChartOptions -> Bool)
-> Eq PerfChartOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PerfChartOptions -> PerfChartOptions -> Bool
== :: PerfChartOptions -> PerfChartOptions -> Bool
$c/= :: PerfChartOptions -> PerfChartOptions -> Bool
/= :: PerfChartOptions -> PerfChartOptions -> Bool
Eq, Int -> PerfChartOptions -> ShowS
[PerfChartOptions] -> ShowS
PerfChartOptions -> FilePath
(Int -> PerfChartOptions -> ShowS)
-> (PerfChartOptions -> FilePath)
-> ([PerfChartOptions] -> ShowS)
-> Show PerfChartOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PerfChartOptions -> ShowS
showsPrec :: Int -> PerfChartOptions -> ShowS
$cshow :: PerfChartOptions -> FilePath
show :: PerfChartOptions -> FilePath
$cshowList :: [PerfChartOptions] -> ShowS
showList :: [PerfChartOptions] -> ShowS
Show, (forall x. PerfChartOptions -> Rep PerfChartOptions x)
-> (forall x. Rep PerfChartOptions x -> PerfChartOptions)
-> Generic PerfChartOptions
forall x. Rep PerfChartOptions x -> PerfChartOptions
forall x. PerfChartOptions -> Rep PerfChartOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PerfChartOptions -> Rep PerfChartOptions x
from :: forall x. PerfChartOptions -> Rep PerfChartOptions x
$cto :: forall x. Rep PerfChartOptions x -> PerfChartOptions
to :: forall x. Rep PerfChartOptions x -> PerfChartOptions
Generic)

defaultPerfChartOptions :: PerfChartOptions
defaultPerfChartOptions :: PerfChartOptions
defaultPerfChartOptions = Bool
-> FilePath
-> Double
-> Bool
-> Bool
-> Bool
-> Bool
-> Style
-> Int
-> LegendOptions
-> Style
-> HudOptions
-> Style
-> HudOptions
-> Double
-> Int
-> Double
-> Bool
-> PerfChartOptions
PerfChartOptions Bool
False FilePath
"other/perf.svg" Double
10 Bool
True Bool
True Bool
True Bool
True (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.05) Int
2 (LegendOptions
defaultLegendOptions LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Place Place
-> Place -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Place Place
#place Place
PlaceBottom LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Int Int
-> Int -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Int Int
#numStacks Int
3 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#scaleChartsBy Double
0.2 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#legendSize Double
0.3 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Align Align
-> Align -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Align Align
#alignCharts Align
AlignLeft LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#hgap (-Double
0.2) LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#vgap (-Double
0.1)) (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.01 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> (Colour -> Colour) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Style Style Colour Colour
#color (Colour -> Colour -> Colour
rgb (Int -> Colour
palette Int
0)) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx Style Style Colour Colour
#color Optic A_Lens NoIx Style Style Colour Colour
-> Optic A_Lens NoIx Colour Colour Double Double
-> Optic A_Lens NoIx Style Style Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Colour Colour Double Double
opac') Double
0.3 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx Style Style Colour Colour
#borderColor Optic A_Lens NoIx Style Style Colour Colour
-> Optic A_Lens NoIx Colour Colour Double Double
-> Optic A_Lens NoIx Style Style Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Colour Colour Double Double
opac') Double
0.3 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape (Int -> GlyphShape
gpalette Int
0)) HudOptions
defaultHudOptions (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.06 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> (Colour -> Colour) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Style Style Colour Colour
#color (Colour -> Colour -> Colour
rgb (Int -> Colour
palette Int
0)) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape (Int -> GlyphShape
gpalette Int
0) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx Style Style Colour Colour
#color Optic A_Lens NoIx Style Style Colour Colour
-> Optic A_Lens NoIx Colour Colour Double Double
-> Optic A_Lens NoIx Style Style Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Colour Colour Double Double
opac') Double
0.3 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx Style Style Colour Colour
#borderColor Optic A_Lens NoIx Style Style Colour Colour
-> Optic A_Lens NoIx Colour Colour Double Double
-> Optic A_Lens NoIx Style Style Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Colour Colour Double Double
opac') Double
1) (HudOptions
defaultHudOptions HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic A_Traversal (Int : NoIx) HudOptions HudOptions Double Double
-> Double -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> Optic
     A_Traversal
     (Int : NoIx)
     [Priority AxisOptions]
     [Priority AxisOptions]
     (Priority AxisOptions)
     (Priority AxisOptions)
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     (Priority AxisOptions)
     (Priority AxisOptions)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  (Int : NoIx)
  [Priority AxisOptions]
  [Priority AxisOptions]
  (Priority AxisOptions)
  (Priority AxisOptions)
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  (Priority AxisOptions)
  (Priority AxisOptions)
-> Optic
     A_Lens
     NoIx
     (Priority AxisOptions)
     (Priority AxisOptions)
     AxisOptions
     AxisOptions
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     AxisOptions
     AxisOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority AxisOptions)
  (Priority AxisOptions)
  AxisOptions
  AxisOptions
#item Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  AxisOptions
  AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Traversal (Int : NoIx) HudOptions HudOptions Ticks Ticks
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Traversal (Int : NoIx) HudOptions HudOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     (Maybe TickStyle)
     (Maybe TickStyle)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#textTick Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic A_Lens NoIx TickStyle TickStyle Style Style
-> Optic A_Traversal (Int : NoIx) HudOptions HudOptions Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic A_Lens NoIx TickStyle TickStyle Style Style
#style Optic A_Traversal (Int : NoIx) HudOptions HudOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic
     A_Traversal (Int : NoIx) HudOptions HudOptions Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) Double
0.07 HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> ([Priority AxisOptions] -> [Priority AxisOptions])
-> HudOptions
-> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes (Int -> [Priority AxisOptions] -> [Priority AxisOptions]
forall a. Int -> [a] -> [a]
drop Int
1) HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  (Maybe Int)
  (Maybe Int)
-> Maybe Int -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> Optic
     A_Traversal
     (Int : NoIx)
     [Priority AxisOptions]
     [Priority AxisOptions]
     (Priority AxisOptions)
     (Priority AxisOptions)
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     (Priority AxisOptions)
     (Priority AxisOptions)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  (Int : NoIx)
  [Priority AxisOptions]
  [Priority AxisOptions]
  (Priority AxisOptions)
  (Priority AxisOptions)
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  (Priority AxisOptions)
  (Priority AxisOptions)
-> Optic
     A_Lens
     NoIx
     (Priority AxisOptions)
     (Priority AxisOptions)
     AxisOptions
     AxisOptions
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     AxisOptions
     AxisOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority AxisOptions)
  (Priority AxisOptions)
  AxisOptions
  AxisOptions
#item Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  AxisOptions
  AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Traversal (Int : NoIx) HudOptions HudOptions Ticks Ticks
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Traversal (Int : NoIx) HudOptions HudOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Traversal (Int : NoIx) HudOptions HudOptions Tick Tick
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick Optic A_Traversal (Int : NoIx) HudOptions HudOptions Tick Tick
-> Optic A_Lens NoIx Tick Tick (Maybe Int) (Maybe Int)
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     (Maybe Int)
     (Maybe Int)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Tick Tick (Maybe Int) (Maybe Int)
numTicks') (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)) Double
0.08 Int
100 Double
0.2 Bool
True

-- | Parse charting options.
parsePerfChartOptions :: PerfChartOptions -> Parser PerfChartOptions
parsePerfChartOptions :: PerfChartOptions -> Parser PerfChartOptions
parsePerfChartOptions PerfChartOptions
def =
  (\Bool
c FilePath
fp Double
trunAt Bool
small Bool
big Bool
hist Bool
avs -> Bool
-> FilePath
-> Double
-> Bool
-> Bool
-> Bool
-> Bool
-> Style
-> Int
-> LegendOptions
-> Style
-> HudOptions
-> Style
-> HudOptions
-> Double
-> Int
-> Double
-> Bool
-> PerfChartOptions
PerfChartOptions Bool
c FilePath
fp Double
trunAt Bool
small Bool
big Bool
hist Bool
avs (Optic' A_Lens NoIx PerfChartOptions Style
-> PerfChartOptions -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Style
#averagesStyle PerfChartOptions
def) (Optic' A_Lens NoIx PerfChartOptions Int -> PerfChartOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Int
#averagesPaletteStart PerfChartOptions
def) (Optic' A_Lens NoIx PerfChartOptions LegendOptions
-> PerfChartOptions -> LegendOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions LegendOptions
#averagesLegend PerfChartOptions
def) (Optic' A_Lens NoIx PerfChartOptions Style
-> PerfChartOptions -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Style
#smallStyle PerfChartOptions
def) (Optic' A_Lens NoIx PerfChartOptions HudOptions
-> PerfChartOptions -> HudOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions HudOptions
#smallHud PerfChartOptions
def) (Optic' A_Lens NoIx PerfChartOptions Style
-> PerfChartOptions -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Style
#bigStyle PerfChartOptions
def) (Optic' A_Lens NoIx PerfChartOptions HudOptions
-> PerfChartOptions -> HudOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions HudOptions
#bigHud PerfChartOptions
def) (Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#titleSize PerfChartOptions
def) (Optic' A_Lens NoIx PerfChartOptions Int -> PerfChartOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Int
#histGrain PerfChartOptions
def) (Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#bigWidth PerfChartOptions
def) (Optic' A_Lens NoIx PerfChartOptions Bool
-> PerfChartOptions -> Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Bool
#excludeZeros PerfChartOptions
def))
    (Bool
 -> FilePath
 -> Double
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> PerfChartOptions)
-> Parser Bool
-> Parser
     (FilePath
      -> Double -> Bool -> Bool -> Bool -> Bool -> PerfChartOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"chart" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"chart the result")
    Parser
  (FilePath
   -> Double -> Bool -> Bool -> Bool -> Bool -> PerfChartOptions)
-> Parser FilePath
-> Parser
     (Double -> Bool -> Bool -> Bool -> Bool -> PerfChartOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (Optic' A_Lens NoIx PerfChartOptions FilePath
-> PerfChartOptions -> FilePath
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions FilePath
#chartFilepath PerfChartOptions
def) Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"chartpath" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"chart file name")
    Parser (Double -> Bool -> Bool -> Bool -> Bool -> PerfChartOptions)
-> Parser Double
-> Parser (Bool -> Bool -> Bool -> Bool -> PerfChartOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Double
forall a. Read a => ReadM a
auto (Double -> Mod OptionFields Double
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#truncateAt PerfChartOptions
def) Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> (Double -> FilePath) -> Mod OptionFields Double
forall a (f :: * -> *). (a -> FilePath) -> Mod f a
showDefaultWith Double -> FilePath
forall a. Show a => a -> FilePath
show Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"truncateat" Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"truncate chart data (multiple of median)")
    Parser (Bool -> Bool -> Bool -> Bool -> PerfChartOptions)
-> Parser Bool -> Parser (Bool -> Bool -> Bool -> PerfChartOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"small")
    Parser (Bool -> Bool -> Bool -> PerfChartOptions)
-> Parser Bool -> Parser (Bool -> Bool -> PerfChartOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"big")
    Parser (Bool -> Bool -> PerfChartOptions)
-> Parser Bool -> Parser (Bool -> PerfChartOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"histogram")
    Parser (Bool -> PerfChartOptions)
-> Parser Bool -> Parser PerfChartOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"averages")

perfCharts :: PerfChartOptions -> Maybe [Text] -> Map.Map Text [[Double]] -> ChartOptions
perfCharts :: PerfChartOptions
-> Maybe [Text] -> Map Text [[Double]] -> ChartOptions
perfCharts PerfChartOptions
cfg Maybe [Text]
labels Map Text [[Double]]
m = ChartOptions -> ChartOptions -> Bool -> ChartOptions
forall a. a -> a -> Bool -> a
bool (Int -> Align -> Align -> Double -> [ChartOptions] -> ChartOptions
stackCO Int
stackn Align
AlignLeft Align
NoAlign Double
0.1 [ChartOptions]
cs) ([ChartOptions] -> ChartOptions
forall a. HasCallStack => [a] -> a
head [ChartOptions]
cs) ([ChartOptions] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ChartOptions]
cs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)
  where
    stackn :: Int
stackn = [ChartOptions] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ChartOptions]
cs Int -> (Int -> Double) -> Double
forall a b. a -> (a -> b) -> b
& Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Double -> (Double -> Double) -> Double
forall a b. a -> (a -> b) -> b
& forall a. Floating a => a -> a
sqrt @Double Double -> (Double -> Int) -> Int
forall a b. a -> (a -> b) -> b
& Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
    cs :: [ChartOptions]
cs = (Text -> [Double] -> ChartOptions)
-> (Text, [Double]) -> ChartOptions
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (PerfChartOptions -> Text -> [Double] -> ChartOptions
perfChart PerfChartOptions
cfg) ((Text, [Double]) -> ChartOptions)
-> [(Text, [Double])] -> [ChartOptions]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, [Double])]
ps'
    ps :: [(Text, [Double])]
ps = [[(Text, [Double])]] -> [(Text, [Double])]
forall a. Monoid a => [a] -> a
mconcat ([[(Text, [Double])]] -> [(Text, [Double])])
-> [[(Text, [Double])]] -> [(Text, [Double])]
forall a b. (a -> b) -> a -> b
$ ((Text, [[Double]]) -> [(Text, [Double])])
-> [(Text, [[Double]])] -> [[(Text, [Double])]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Text] -> [[Double]] -> [(Text, [Double])])
-> ([Text], [[Double]]) -> [(Text, [Double])]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Text] -> [[Double]] -> [(Text, [Double])]
forall a b. [a] -> [b] -> [(a, b)]
zip (([Text], [[Double]]) -> [(Text, [Double])])
-> ((Text, [[Double]]) -> ([Text], [[Double]]))
-> (Text, [[Double]])
-> [(Text, [Double])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text])
-> ([[Double]] -> [[Double]])
-> (Text, [[Double]])
-> ([Text], [[Double]])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (\Text
t -> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": ") <>) ([Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Text
Text.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show @Int (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 ..]) Maybe [Text]
labels)) [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
List.transpose) (Map Text [[Double]] -> [(Text, [[Double]])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text [[Double]]
m)
    ps' :: [(Text, [Double])]
ps' = ((Text, [Double]) -> Bool)
-> [(Text, [Double])] -> [(Text, [Double])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0) (Double -> Bool)
-> ((Text, [Double]) -> Double) -> (Text, [Double]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double)
-> ((Text, [Double]) -> [Double]) -> (Text, [Double]) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [Double]) -> [Double]
forall a b. (a, b) -> b
snd) [(Text, [Double])]
ps

perfChart :: PerfChartOptions -> Text -> [Double] -> ChartOptions
perfChart :: PerfChartOptions -> Text -> [Double] -> ChartOptions
perfChart PerfChartOptions
cfg Text
t [Double]
xs = ChartOptions
finalChart
  where
    xsSmall :: [Point Double]
xsSmall = [Double]
xs [Double] -> ([Double] -> [Point Double]) -> [Point Double]
forall a b. a -> (a -> b) -> b
& [Double] -> [Point Double]
xify [Point Double]
-> ([Point Double] -> [Point Double]) -> [Point Double]
forall a b. a -> (a -> b) -> b
& (Point Double -> Bool) -> [Point Double] -> [Point Double]
forall a. (a -> Bool) -> [a] -> [a]
filter (Point Double -> Double
forall a. Point a -> a
_y (Point Double -> Double)
-> (Double -> Bool) -> Point Double -> Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
upperCutoff)) [Point Double]
-> ([Point Double] -> [Point Double]) -> [Point Double]
forall a b. a -> (a -> b) -> b
& (Point Double -> Bool) -> [Point Double] -> [Point Double]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Point Double
x -> Optic' A_Lens NoIx PerfChartOptions Bool
-> PerfChartOptions -> Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Bool
#excludeZeros PerfChartOptions
cfg Bool -> Bool -> Bool
&& (Point Double -> Double
forall a. Point a -> a
_y Point Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0))
    xsBig :: [Point Double]
xsBig = [Double]
xs [Double] -> ([Double] -> [Point Double]) -> [Point Double]
forall a b. a -> (a -> b) -> b
& [Double] -> [Point Double]
xify [Point Double]
-> ([Point Double] -> [Point Double]) -> [Point Double]
forall a b. a -> (a -> b) -> b
& (Point Double -> Bool) -> [Point Double] -> [Point Double]
forall a. (a -> Bool) -> [a] -> [a]
filter (Point Double -> Double
forall a. Point a -> a
_y (Point Double -> Double)
-> (Double -> Bool) -> Point Double -> Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
upperCutoff))
    med :: Double
med = [Double] -> Double
median [Double]
xs
    best :: Double
best = [Double] -> Double
tenth [Double]
xs
    av :: Double
av = [Double] -> Double
Perf.average [Double]
xs
    upperCutoff :: Double
upperCutoff = Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#truncateAt PerfChartOptions
cfg Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
med

    labels :: [Text]
labels =
      [ Text
"average: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> Double -> Text
comma (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) Double
av,
        Text
"median: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> Double -> Text
comma (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) Double
med,
        Text
"best: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> Double -> Text
comma (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) Double
best
      ]
    (Rect Double
_ Double
_ Double
y' Double
w') = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ [Element (Rect Double)] -> Maybe (Rect Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 [Point Double]
[Element (Rect Double)]
xsSmall
    (Range Double
x' Double
z') = Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
forall a. Additive a => a
zero (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs)
    rectx :: Chart
rectx = Style -> [Rect Double] -> Chart
BlankChart Style
defaultStyle [Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
x' Double
z' Double
y' Double
w']
    averagesCT :: ChartTree
averagesCT = Text -> [Chart] -> ChartTree
named Text
"averages" ([Chart] -> ChartTree) -> [Chart] -> ChartTree
forall a b. (a -> b) -> a -> b
$ (Double -> Int -> Chart) -> [Double] -> [Int] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
x Int
i -> Style -> [Point Double] -> Chart
GlyphChart (Optic' A_Lens NoIx PerfChartOptions Style
-> PerfChartOptions -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Style
#averagesStyle PerfChartOptions
cfg Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Colour
palette Int
i) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor (Int -> Colour
palette Int
i) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape (Int -> GlyphShape
gpalette Int
i)) [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
forall a. Additive a => a
zero Double
x]) [Double
av, Double
med, Double
best] [(Optic' A_Lens NoIx PerfChartOptions Int -> PerfChartOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Int
#averagesPaletteStart PerfChartOptions
cfg) ..]

    (ChartOptions
smallDot, ChartOptions
smallHist) = Int
-> Style
-> ChartOptions
-> [Point Double]
-> (ChartOptions, ChartOptions)
dotHistChart (Optic' A_Lens NoIx PerfChartOptions Int -> PerfChartOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Int
#histGrain PerfChartOptions
cfg) (Optic' A_Lens NoIx PerfChartOptions Style
-> PerfChartOptions -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Style
#smallStyle PerfChartOptions
cfg) (forall a. Monoid a => a
mempty @ChartOptions ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (ChartTree
averagesCT ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> Text -> [Chart] -> ChartTree
named Text
"xrange" [Chart
rectx]) ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions (Optic' A_Lens NoIx PerfChartOptions HudOptions
-> PerfChartOptions -> HudOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions HudOptions
#smallHud PerfChartOptions
cfg)) [Point Double]
xsSmall

    minb :: Double
minb = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Point Double -> Double
forall a. Point a -> a
_y (Point Double -> Double) -> [Point Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
xsBig)
    bigrange :: Rect Double
bigrange = Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
x' Double
z' (Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
minb Double
forall a. Additive a => a
zero ([Point Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point Double]
xsBig Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)) Double
minb
    (ChartOptions
bigDot, ChartOptions
bigHist) = Int
-> Style
-> ChartOptions
-> [Point Double]
-> (ChartOptions, ChartOptions)
dotHistChart (Optic' A_Lens NoIx PerfChartOptions Int -> PerfChartOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Int
#histGrain PerfChartOptions
cfg) (Optic' A_Lens NoIx PerfChartOptions Style
-> PerfChartOptions -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Style
#bigStyle PerfChartOptions
cfg) (forall a. Monoid a => a
mempty @ChartOptions ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions (Optic' A_Lens NoIx PerfChartOptions HudOptions
-> PerfChartOptions -> HudOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions HudOptions
#bigHud PerfChartOptions
cfg) ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"xrange" [Style -> [Rect Double] -> Chart
BlankChart Style
defaultStyle [Rect Double
bigrange]])) [Point Double]
xsBig

    (Rect Double
bdX Double
bdW Double
_ Double
_) = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' (ChartOptions -> ChartTree
asChartTree ChartOptions
bigDot)
    bdr :: Maybe (Rect Double)
bdr = Rect Double -> Maybe (Rect Double)
forall a. a -> Maybe a
Just (Rect Double -> Maybe (Rect Double))
-> Rect Double -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
bdX Double
bdW (-(Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#bigWidth PerfChartOptions
cfg)) (Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#bigWidth PerfChartOptions
cfg)
    (Rect Double
bdhX Double
bdhW Double
_ Double
_) = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' (ChartOptions -> ChartTree
asChartTree ChartOptions
bigHist)
    bhr :: Maybe (Rect Double)
bhr = Rect Double -> Maybe (Rect Double)
forall a. a -> Maybe a
Just (Rect Double -> Maybe (Rect Double))
-> Rect Double -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
bdhX Double
bdhW (-(Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#bigWidth PerfChartOptions
cfg)) (Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#bigWidth PerfChartOptions
cfg)

    finalChart :: ChartOptions
finalChart =
      forall a. Monoid a => a
mempty @ChartOptions
        ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
          #chartTree
          ( Int -> Align -> Align -> Double -> [ChartTree] -> ChartTree
stack
              Int
2
              Align
NoAlign
              Align
NoAlign
              Double
0
              ( [ChartTree] -> [ChartTree] -> Bool -> [ChartTree]
forall a. a -> a -> Bool -> a
bool (ChartOptions -> ChartTree
asChartTree ChartOptions
bigDot ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> Maybe (Rect Double) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' Maybe (Rect Double)
bdr ChartTree -> (ChartTree -> [ChartTree]) -> [ChartTree]
forall a b. a -> (a -> b) -> b
& ChartTree -> [ChartTree]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [ChartTree]
forall a. Monoid a => a
mempty ([Point Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Point Double]
xsBig)
                  [ChartTree] -> [ChartTree] -> [ChartTree]
forall a. Semigroup a => a -> a -> a
<> [ChartTree] -> [ChartTree] -> Bool -> [ChartTree]
forall a. a -> a -> Bool -> a
bool (ChartOptions -> ChartTree
asChartTree ChartOptions
bigHist ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> Maybe (Rect Double) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' Maybe (Rect Double)
bhr ChartTree -> (ChartTree -> [ChartTree]) -> [ChartTree]
forall a b. a -> (a -> b) -> b
& ChartTree -> [ChartTree]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [ChartTree]
forall a. Monoid a => a
mempty ([Point Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Point Double]
xsBig)
                  [ChartTree] -> [ChartTree] -> [ChartTree]
forall a. Semigroup a => a -> a -> a
<> [ ChartOptions -> ChartTree
asChartTree ChartOptions
smallDot,
                       ChartOptions -> ChartTree
asChartTree ChartOptions
smallHist
                     ]
              )
          )
        ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> [Priority LegendOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
          (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
#legends)
          [Double -> LegendOptions -> Priority LegendOptions
forall a. Double -> a -> Priority a
Priority Double
10 (Optic' A_Lens NoIx PerfChartOptions LegendOptions
-> PerfChartOptions -> LegendOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions LegendOptions
#averagesLegend PerfChartOptions
cfg LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
-> [(Text, [Chart])] -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
#legendCharts ((Text -> Chart -> (Text, [Chart]))
-> [Text] -> [Chart] -> [(Text, [Chart])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
t' Chart
c -> (Text
t', [Chart
c])) [Text]
labels (Optic' A_Traversal NoIx ChartTree Chart -> ChartTree -> [Chart]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf Optic' A_Traversal NoIx ChartTree Chart
chart' ChartTree
averagesCT)))]
        ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
-> [Priority TitleOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
          (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority TitleOptions]
     [Priority TitleOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority TitleOptions]
     [Priority TitleOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
#titles)
          [Double -> TitleOptions -> Priority TitleOptions
forall a. Double -> a -> Priority a
Priority Double
5 (Text -> TitleOptions
defaultTitleOptions Text
t TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Double Double
-> Double -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx TitleOptions TitleOptions Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) (Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#titleSize PerfChartOptions
cfg))]

dotHistChart :: Int -> Style -> ChartOptions -> [Point Double] -> (ChartOptions, ChartOptions)
dotHistChart :: Int
-> Style
-> ChartOptions
-> [Point Double]
-> (ChartOptions, ChartOptions)
dotHistChart Int
grain Style
gstyle ChartOptions
co [Point Double]
xs = (ChartOptions
dotCO, ChartOptions
histCO)
  where
    dotCT :: ChartTree
dotCT = Text -> [Chart] -> ChartTree
named Text
"dot" [Style -> [Point Double] -> Chart
GlyphChart Style
gstyle [Point Double]
xs]
    ys :: [Double]
ys = (Point Double -> Double) -> [Point Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point Double -> Double
forall a. Point a -> a
_y [Point Double]
xs
    (Range Double
l Double
u) = Range Double -> Maybe (Range Double) -> Range Double
forall a. a -> Maybe a -> a
fromMaybe Range Double
forall a. Multiplicative a => a
one ([Element (Range Double)] -> Maybe (Range Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 [Double]
[Element (Range Double)]
ys)
    r' :: Range Double
r' = Range Double -> Range Double -> Bool -> Range Double
forall a. a -> a -> Bool -> a
bool (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
l Double
u) (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
0 Double
l) (Double
l Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
u)
    r :: Range Double
r = Range Double -> Tick -> Range Double
computeRangeTick Range Double
r' (Tick -> Maybe Tick -> Tick
forall a. a -> Maybe a -> a
fromMaybe Tick
defaultTick (ChartOptions
co ChartOptions -> (ChartOptions -> Maybe Tick) -> Maybe Tick
forall a b. a -> (a -> b) -> b
& Optic' An_AffineTraversal NoIx ChartOptions Tick
-> ChartOptions -> Maybe Tick
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> Optic
     (IxKind [Priority AxisOptions])
     NoIx
     [Priority AxisOptions]
     [Priority AxisOptions]
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index [Priority AxisOptions]
-> Optic
     (IxKind [Priority AxisOptions])
     NoIx
     [Priority AxisOptions]
     [Priority AxisOptions]
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index [Priority AxisOptions]
1 Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  (IxValue [Priority AxisOptions])
  (IxValue [Priority AxisOptions])
-> Optic
     A_Lens
     NoIx
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
     AxisOptions
     AxisOptions
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     AxisOptions
     AxisOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue [Priority AxisOptions])
  (IxValue [Priority AxisOptions])
  AxisOptions
  AxisOptions
#item Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  AxisOptions
  AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     An_AffineTraversal NoIx ChartOptions ChartOptions Ticks Ticks
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic An_AffineTraversal NoIx ChartOptions ChartOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic' An_AffineTraversal NoIx ChartOptions Tick
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick)))
    (Double
y, Double
w) = let (Range Double
y' Double
w') = Range Double
r in (Double, Double) -> (Double, Double) -> Bool -> (Double, Double)
forall a. a -> a -> Bool -> a
bool (Double
y', Double
w') (Double
y' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.5, Double
y' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.5) (Double
y' Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
w')

    histCO :: ChartOptions
histCO = Range Double -> Int -> [Double] -> ChartOptions
hhistChart Range Double
r Int
grain [Double]
ys ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
-> ChartAspect -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) (Double -> ChartAspect
CanvasAspect Double
0.3) ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> (ChartTree -> ChartTree) -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> [Chart] -> ChartTree
unnamed [Style -> [Rect Double] -> Chart
BlankChart Style
defaultStyle [Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 Double
0 Double
y Double
w]])
    dotCO :: ChartOptions
dotCO = ChartOptions
co ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> (ChartTree -> ChartTree) -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (ChartTree
dotCT <>)

compareCharts :: [(PerfChartOptions, Text, [Double])] -> ChartOptions
compareCharts :: [(PerfChartOptions, Text, [Double])] -> ChartOptions
compareCharts [(PerfChartOptions, Text, [Double])]
xs = ChartOptions
finalChart
  where
    xs' :: [[Double]]
xs' = [(PerfChartOptions, Text, [Double])]
xs [(PerfChartOptions, Text, [Double])]
-> ([(PerfChartOptions, Text, [Double])] -> [[Double]])
-> [[Double]]
forall a b. a -> (a -> b) -> b
& ((PerfChartOptions, Text, [Double]) -> [Double])
-> [(PerfChartOptions, Text, [Double])] -> [[Double]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(PerfChartOptions
_, Text
_, [Double]
x) -> [Double]
x)
    cfg' :: [PerfChartOptions]
cfg' = [(PerfChartOptions, Text, [Double])]
xs [(PerfChartOptions, Text, [Double])]
-> ([(PerfChartOptions, Text, [Double])] -> [PerfChartOptions])
-> [PerfChartOptions]
forall a b. a -> (a -> b) -> b
& ((PerfChartOptions, Text, [Double]) -> PerfChartOptions)
-> [(PerfChartOptions, Text, [Double])] -> [PerfChartOptions]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(PerfChartOptions
x, Text
_, [Double]
_) -> PerfChartOptions
x)
    t' :: [Text]
t' = [(PerfChartOptions, Text, [Double])]
xs [(PerfChartOptions, Text, [Double])]
-> ([(PerfChartOptions, Text, [Double])] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& ((PerfChartOptions, Text, [Double]) -> Text)
-> [(PerfChartOptions, Text, [Double])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(PerfChartOptions
_, Text
x, [Double]
_) -> Text
x)
    cfg :: PerfChartOptions
cfg = [PerfChartOptions] -> PerfChartOptions
forall a. HasCallStack => [a] -> a
head [PerfChartOptions]
cfg'
    xsSmall :: [[Point Double]]
xsSmall = [[Double]]
xs' [[Double]] -> ([[Double]] -> [[Point Double]]) -> [[Point Double]]
forall a b. a -> (a -> b) -> b
& ([Double] -> [Point Double]) -> [[Double]] -> [[Point Double]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Double] -> [Point Double]
xify ([Double] -> [Point Double])
-> ([Point Double] -> [Point Double]) -> [Double] -> [Point Double]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Point Double -> Bool) -> [Point Double] -> [Point Double]
forall a. (a -> Bool) -> [a] -> [a]
filter (Point Double -> Double
forall a. Point a -> a
_y (Point Double -> Double)
-> (Double -> Bool) -> Point Double -> Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
upperCutoff)) ([Point Double] -> [Point Double])
-> ([Point Double] -> [Point Double])
-> [Point Double]
-> [Point Double]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Point Double -> Bool) -> [Point Double] -> [Point Double]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Point Double
x -> Optic' A_Lens NoIx PerfChartOptions Bool
-> PerfChartOptions -> Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Bool
#excludeZeros PerfChartOptions
cfg Bool -> Bool -> Bool
&& (Point Double -> Double
forall a. Point a -> a
_y Point Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0)))
    xsBig :: [[Point Double]]
xsBig = [[Double]]
xs' [[Double]] -> ([[Double]] -> [[Point Double]]) -> [[Point Double]]
forall a b. a -> (a -> b) -> b
& ([Double] -> [Point Double]) -> [[Double]] -> [[Point Double]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Double] -> [Point Double]
xify ([Double] -> [Point Double])
-> ([Point Double] -> [Point Double]) -> [Double] -> [Point Double]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Point Double -> Bool) -> [Point Double] -> [Point Double]
forall a. (a -> Bool) -> [a] -> [a]
filter (Point Double -> Double
forall a. Point a -> a
_y (Point Double -> Double)
-> (Double -> Bool) -> Point Double -> Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
upperCutoff)))
    med :: [Double]
med = [Double] -> Double
median ([Double] -> Double) -> [[Double]] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]]
xs'
    upperCutoff :: Double
upperCutoff = Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#truncateAt PerfChartOptions
cfg Double -> Double -> Double
forall a. Num a => a -> a -> a
* [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
med

    (Rect Double
_ Double
_ Double
y' Double
w') = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ [Element (Rect Double)] -> Maybe (Rect Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 ([Element (Rect Double)] -> Maybe (Rect Double))
-> [Element (Rect Double)] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [[Point Double]] -> [Point Double]
forall a. Monoid a => [a] -> a
mconcat [[Point Double]]
xsSmall
    (Range Double
x' Double
z') = Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
forall a. Additive a => a
zero (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> [[Double]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]]
xs'))
    rectx :: Chart
rectx = Style -> [Rect Double] -> Chart
BlankChart Style
defaultStyle [Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
x' Double
z' Double
y' Double
w']

    (ChartOptions
smallDot, ChartOptions
smallHist) = Int
-> ChartOptions
-> [(Style, [Point Double])]
-> (ChartOptions, ChartOptions)
dotHistCharts (Optic' A_Lens NoIx PerfChartOptions Int -> PerfChartOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Int
#histGrain PerfChartOptions
cfg) (forall a. Monoid a => a
mempty @ChartOptions ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions (Optic' A_Lens NoIx PerfChartOptions HudOptions
-> PerfChartOptions -> HudOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions HudOptions
#smallHud PerfChartOptions
cfg) ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree ([Chart] -> ChartTree
unnamed [Chart
rectx])) ([Style] -> [[Point Double]] -> [(Style, [Point Double])]
forall a b. [a] -> [b] -> [(a, b)]
zip (Optic' A_Lens NoIx PerfChartOptions Style
-> PerfChartOptions -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Style
#smallStyle (PerfChartOptions -> Style) -> [PerfChartOptions] -> [Style]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PerfChartOptions]
cfg') [[Point Double]]
xsSmall)

    minb :: Double
minb = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Point Double -> Double
forall a. Point a -> a
_y (Point Double -> Double) -> [Point Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Point Double]] -> [Point Double]
forall a. Monoid a => [a] -> a
mconcat [[Point Double]]
xsBig)
    bigrange :: Rect Double
bigrange = Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
x' Double
z' (Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
minb Double
forall a. Additive a => a
zero ([Point Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Point Double]] -> [Point Double]
forall a. Monoid a => [a] -> a
mconcat [[Point Double]]
xsBig) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)) Double
minb
    (ChartOptions
bigDot, ChartOptions
bigHist) = Int
-> ChartOptions
-> [(Style, [Point Double])]
-> (ChartOptions, ChartOptions)
dotHistCharts (Optic' A_Lens NoIx PerfChartOptions Int -> PerfChartOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Int
#histGrain PerfChartOptions
cfg) (forall a. Monoid a => a
mempty @ChartOptions ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions (Optic' A_Lens NoIx PerfChartOptions HudOptions
-> PerfChartOptions -> HudOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions HudOptions
#bigHud PerfChartOptions
cfg) ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"xrange" [Style -> [Rect Double] -> Chart
BlankChart Style
defaultStyle [Rect Double
bigrange]])) ([Style] -> [[Point Double]] -> [(Style, [Point Double])]
forall a b. [a] -> [b] -> [(a, b)]
zip (Optic' A_Lens NoIx PerfChartOptions Style
-> PerfChartOptions -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Style
#bigStyle (PerfChartOptions -> Style) -> [PerfChartOptions] -> [Style]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PerfChartOptions]
cfg') [[Point Double]]
xsBig)

    (Rect Double
bdX Double
bdW Double
_ Double
_) = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' (ChartOptions -> ChartTree
asChartTree ChartOptions
bigDot)
    bdr :: Maybe (Rect Double)
bdr = Rect Double -> Maybe (Rect Double)
forall a. a -> Maybe a
Just (Rect Double -> Maybe (Rect Double))
-> Rect Double -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
bdX Double
bdW (-(Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#bigWidth PerfChartOptions
cfg)) (Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#bigWidth PerfChartOptions
cfg)
    (Rect Double
bdhX Double
bdhW Double
_ Double
_) = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' (ChartOptions -> ChartTree
asChartTree ChartOptions
bigHist)
    bhr :: Maybe (Rect Double)
bhr = Rect Double -> Maybe (Rect Double)
forall a. a -> Maybe a
Just (Rect Double -> Maybe (Rect Double))
-> Rect Double -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
bdhX Double
bdhW (-(Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#bigWidth PerfChartOptions
cfg)) (Optic' A_Lens NoIx PerfChartOptions Double
-> PerfChartOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Double
#bigWidth PerfChartOptions
cfg)

    finalChart :: ChartOptions
finalChart =
      forall a. Monoid a => a
mempty @ChartOptions
        ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
          #chartTree
          ( Int -> Align -> Align -> Double -> [ChartTree] -> ChartTree
stack
              Int
2
              Align
NoAlign
              Align
NoAlign
              Double
0
              ( [ChartTree] -> [ChartTree] -> Bool -> [ChartTree]
forall a. a -> a -> Bool -> a
bool (ChartOptions -> ChartTree
asChartTree ChartOptions
bigDot ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> Maybe (Rect Double) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' Maybe (Rect Double)
bdr ChartTree -> (ChartTree -> [ChartTree]) -> [ChartTree]
forall a b. a -> (a -> b) -> b
& ChartTree -> [ChartTree]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [ChartTree]
forall a. Monoid a => a
mempty ([[Point Double]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Point Double]]
xsBig)
                  [ChartTree] -> [ChartTree] -> [ChartTree]
forall a. Semigroup a => a -> a -> a
<> [ChartTree] -> [ChartTree] -> Bool -> [ChartTree]
forall a. a -> a -> Bool -> a
bool (ChartOptions -> ChartTree
asChartTree ChartOptions
bigHist ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> Maybe (Rect Double) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' Maybe (Rect Double)
bhr ChartTree -> (ChartTree -> [ChartTree]) -> [ChartTree]
forall a b. a -> (a -> b) -> b
& ChartTree -> [ChartTree]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [ChartTree]
forall a. Monoid a => a
mempty ([[Point Double]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Point Double]]
xsBig)
                  [ChartTree] -> [ChartTree] -> [ChartTree]
forall a. Semigroup a => a -> a -> a
<> [ ChartOptions -> ChartTree
asChartTree ChartOptions
smallDot,
                       ChartOptions -> ChartTree
asChartTree ChartOptions
smallHist
                     ]
              )
          )
        ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> [Priority LegendOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
          (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
#legends)
          [Double -> LegendOptions -> Priority LegendOptions
forall a. Double -> a -> Priority a
Priority Double
10 (Optic' A_Lens NoIx PerfChartOptions LegendOptions
-> PerfChartOptions -> LegendOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions LegendOptions
#averagesLegend PerfChartOptions
cfg LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
-> [(Text, [Chart])] -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
#legendCharts ((Text -> Chart -> (Text, [Chart]))
-> [Text] -> [Chart] -> [(Text, [Chart])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
t'' Chart
c -> (Text
t'', [Chart
c])) [Text]
t' (Optic' A_Traversal NoIx ChartOptions Chart
-> ChartOptions -> [Chart]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> Optic' A_Traversal NoIx ChartTree Chart
-> Optic' A_Traversal NoIx ChartOptions Chart
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic' A_Traversal NoIx ChartTree Chart
chart') ChartOptions
smallDot)))]

dotHistCharts :: Int -> ChartOptions -> [(Style, [Point Double])] -> (ChartOptions, ChartOptions)
dotHistCharts :: Int
-> ChartOptions
-> [(Style, [Point Double])]
-> (ChartOptions, ChartOptions)
dotHistCharts Int
grain ChartOptions
co [(Style, [Point Double])]
xs = (ChartOptions
dotCO, ChartOptions
histCO)
  where
    dotCTs :: ChartTree
dotCTs = Text -> [Chart] -> ChartTree
named Text
"dot" ((Style -> [Point Double] -> Chart)
-> (Style, [Point Double]) -> Chart
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Style -> [Point Double] -> Chart
GlyphChart ((Style, [Point Double]) -> Chart)
-> [(Style, [Point Double])] -> [Chart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Style, [Point Double])]
xs)
    ys :: [[Double]]
ys = (Point Double -> Double) -> [Point Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point Double -> Double
forall a. Point a -> a
_y ([Point Double] -> [Double])
-> ((Style, [Point Double]) -> [Point Double])
-> (Style, [Point Double])
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style, [Point Double]) -> [Point Double]
forall a b. (a, b) -> b
snd ((Style, [Point Double]) -> [Double])
-> [(Style, [Point Double])] -> [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Style, [Point Double])]
xs
    (Range Double
l Double
u) = Range Double -> Maybe (Range Double) -> Range Double
forall a. a -> Maybe a -> a
fromMaybe Range Double
forall a. Multiplicative a => a
one ([Element (Range Double)] -> Maybe (Range Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 ([[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat [[Double]]
ys))
    r' :: Range Double
r' = Range Double -> Range Double -> Bool -> Range Double
forall a. a -> a -> Bool -> a
bool (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
l Double
u) (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
0 Double
l) (Double
l Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
u)
    r :: Range Double
r = Range Double -> Tick -> Range Double
computeRangeTick Range Double
r' (Tick -> Maybe Tick -> Tick
forall a. a -> Maybe a -> a
fromMaybe Tick
defaultTick (ChartOptions
co ChartOptions -> (ChartOptions -> Maybe Tick) -> Maybe Tick
forall a b. a -> (a -> b) -> b
& Optic' An_AffineTraversal NoIx ChartOptions Tick
-> ChartOptions -> Maybe Tick
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> Optic
     (IxKind [Priority AxisOptions])
     NoIx
     [Priority AxisOptions]
     [Priority AxisOptions]
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index [Priority AxisOptions]
-> Optic
     (IxKind [Priority AxisOptions])
     NoIx
     [Priority AxisOptions]
     [Priority AxisOptions]
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index [Priority AxisOptions]
1 Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  (IxValue [Priority AxisOptions])
  (IxValue [Priority AxisOptions])
-> Optic
     A_Lens
     NoIx
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
     AxisOptions
     AxisOptions
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     AxisOptions
     AxisOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue [Priority AxisOptions])
  (IxValue [Priority AxisOptions])
  AxisOptions
  AxisOptions
#item Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  AxisOptions
  AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     An_AffineTraversal NoIx ChartOptions ChartOptions Ticks Ticks
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic An_AffineTraversal NoIx ChartOptions ChartOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic' An_AffineTraversal NoIx ChartOptions Tick
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick)))
    (Double
y, Double
w) = let (Range Double
y' Double
w') = Range Double
r in (Double, Double) -> (Double, Double) -> Bool -> (Double, Double)
forall a. a -> a -> Bool -> a
bool (Double
y', Double
w') (Double
y' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.5, Double
y' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.5) (Double
y' Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
w')

    histCO :: ChartOptions
histCO = Range Double -> Int -> [(Style, [Double])] -> ChartOptions
hhistCharts Range Double
r Int
grain ([Style] -> [[Double]] -> [(Style, [Double])]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Style, [Point Double]) -> Style
forall a b. (a, b) -> a
fst ((Style, [Point Double]) -> Style)
-> [(Style, [Point Double])] -> [Style]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Style, [Point Double])]
xs) [[Double]]
ys) ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
-> ChartAspect -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) (Double -> ChartAspect
CanvasAspect Double
0.3) ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> (ChartTree -> ChartTree) -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> [Chart] -> ChartTree
unnamed [Style -> [Rect Double] -> Chart
BlankChart Style
defaultStyle [Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 Double
0 Double
y Double
w]])
    dotCO :: ChartOptions
dotCO = ChartOptions
co ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> (ChartTree -> ChartTree) -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (ChartTree
dotCTs <>)