{-# LANGUAGE UndecidableInstances, FlexibleInstances, TypeSynonymInstances #-}
{-# OPTIONS_HADDOCK prune, show-extensions #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ForSyDe.Core.Utility.Plot
-- Copyright   :  (c) George Ungureanu, KTH/ICT/ESY 2015-2017
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  ugeorge@kth.se
-- Stability   :  experimental
-- Portability :  portable
--
-- This module imports plotting and data dumping functions working
-- with "plottable" data types, i.e. instances of the 'Plot' and
-- 'Plottable' type classes.
-----------------------------------------------------------------------------

module ForSyDe.Atom.Utility.Plot (
  -- * User API

  -- | The following commands are frequently used as part of the
  -- normal modeling routine.
  
  -- ** Configuration settings
  Config(..), defaultCfg, silentCfg, noJunkCfg,

  -- ** Data preparation
  prepare, prepareL, prepareV,

  -- ** Dumping and plotting data
  showDat, dumpDat, plotGnu, heatmapGnu,
  showLatex, dumpLatex, plotLatex,
  
  -- * The data types

  -- | Below the data types involved are shown and the plottable
  -- structures are documented.

  Plottable(..), Plot(..), PInfo(..), Samples, PlotData
  
  ) where

import Control.Arrow
import Control.Exception
import Control.Monad (unless, when)
import Data.List (intercalate, intersperse, unwords)
import System.Directory (createDirectoryIfMissing)
import System.Exit (ExitCode(..))
import System.Process

import qualified ForSyDe.Atom.ExB.Absent as AE (
  AbstExt(..))
import qualified ForSyDe.Atom.MoC.SY.Core as SY (
  Signal, SY(..), signal )
import qualified ForSyDe.Atom.MoC.DE.Core as DE (
  SignalBase, DE(..), signal )
import qualified ForSyDe.Atom.MoC.DE.React.Core as RE (
  SignalBase, RE(..), signal )
import qualified ForSyDe.Atom.MoC.CT.Core as CT (
  Signal, CT(..), signal, evalTs, tag)
import qualified ForSyDe.Atom.MoC.SDF.Core as SDF (
  Signal, SDF(..), signal)
import qualified ForSyDe.Atom.MoC.TimeStamp as Ts (
  TimeStamp )
import qualified ForSyDe.Atom.MoC.Time as T (
  Time )
import ForSyDe.Atom.MoC.Stream (
  Stream(..), fromStream, takeS)
import qualified ForSyDe.Atom.Skel.Vector as V (
  Vector(..), fromVector, take, vector)
import qualified ForSyDe.Atom.Prob as P (
  Histogram(..)
  )

-------------------------- TYPES --------------------------

-- | Record structure containing configuration settings for the
-- plotting commands.
data Config =
  Cfg { Config -> Bool
verbose :: Bool     -- ^ verbose printouts on terminal
      , Config -> String
path    :: String   -- ^ directory where all dumped files will be found
      , Config -> String
title    :: String  -- ^ base name for dumped files
      , Config -> Float
rate    :: Float    -- ^ sample rate if relevant. Useful for explicit-tagged signals, ignored otherwise.
      , Config -> Float
xmax    :: Float    -- ^ Maximum X coordinate. Mandatory for infinite structures, optional otherwise.
      , Config -> [String]
labels  :: [String] -- ^ list of labels with the names of the structures plotted
      , Config -> Bool
fire    :: Bool     -- ^ if relevant, fires a plotting or compiling program.
      , Config -> Bool
other   :: Bool     -- ^ if relevant, dumps additional scripts and plots.
      } deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

-- | Default configuration: verbose, dump everything possible, fire
-- whatever program needed. Check source for settings.
--
-- Example usage:
--
-- >>> defaultCfg {xmax = 15, verbose = False, labels = ["john","doe"]}
-- Cfg {verbose = False, path = "./fig", title = "plot", rate = 1.0e-2, xmax = 15.0, labels = ["john","doe"], fire = True, other = True}
defaultCfg :: Config
defaultCfg = Cfg :: Bool
-> String
-> String
-> Float
-> Float
-> [String]
-> Bool
-> Bool
-> Config
Cfg { path :: String
path    = "./fig"
                 , title :: String
title    = "plot"
                 , rate :: Float
rate    = 0.01
                 , xmax :: Float
xmax    = 200
                 , labels :: [String]
labels  = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate 10 ""
                 , verbose :: Bool
verbose = Bool
True
                 , fire :: Bool
fire    = Bool
True
                 , other :: Bool
other   = Bool
True
                 }

-- | Silent configuration: does not fire any program or print our
-- unnecessary info. Check source for settings.
silentCfg :: Config
silentCfg = Cfg :: Bool
-> String
-> String
-> Float
-> Float
-> [String]
-> Bool
-> Bool
-> Config
Cfg  { path :: String
path    = "./fig"
                 , title :: String
title  = "plot"
                 , rate :: Float
rate    = 0.01
                 , xmax :: Float
xmax    = 200
                 , labels :: [String]
labels  = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate 10 ""
                 , verbose :: Bool
verbose = Bool
False
                 , fire :: Bool
fire    = Bool
False
                 , other :: Bool
other   = Bool
True
                 }

-- | Clean configuration: verbose, does not dump more than necessary,
-- fire whatever program needed. Check source for settings.
noJunkCfg :: Config
noJunkCfg = Cfg :: Bool
-> String
-> String
-> Float
-> Float
-> [String]
-> Bool
-> Bool
-> Config
Cfg  { path :: String
path    = "./fig"
                 , title :: String
title  = "plot"
                 , rate :: Float
rate    = 0.01
                 , xmax :: Float
xmax    = 200
                 , labels :: [String]
labels  = String -> [String]
forall a. a -> [a]
repeat ""
                 , verbose :: Bool
verbose = Bool
True
                 , fire :: Bool
fire    = Bool
True
                 , other :: Bool
other   = Bool
False
                 }


-- | Static information of each plottable data type.
data PInfo = Info { PInfo -> String
typeid  :: String  -- ^ id used usually in implicit tags
                  , PInfo -> String
command :: String  -- ^ LaTeX identifier
                  , PInfo -> String
measure :: String  -- ^ unit of measure
                  , PInfo -> String
style   :: String  -- ^ style tweaking in the GNUplot script
                  , PInfo -> Bool
stacking:: Bool    -- ^ if the plot is stacking
                  , PInfo -> Bool
sparse  :: Bool    -- ^ if the sampled data is sparse instead of dense
                  } deriving (Int -> PInfo -> ShowS
[PInfo] -> ShowS
PInfo -> String
(Int -> PInfo -> ShowS)
-> (PInfo -> String) -> ([PInfo] -> ShowS) -> Show PInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PInfo] -> ShowS
$cshowList :: [PInfo] -> ShowS
show :: PInfo -> String
$cshow :: PInfo -> String
showsPrec :: Int -> PInfo -> ShowS
$cshowsPrec :: Int -> PInfo -> ShowS
Show)

-- | Alias for sampled data 
type Samples  = [(String, String)]

-- | Alias for a data set 'prepare'd to be plotted.
type PlotData = (Config, PInfo, [(String,Samples)])

-------------------------- CLASSES --------------------------

-- | This class gathers all ForSyDe-Atom structures that can be
-- plotted.
class Plot a where
  {-# MINIMAL (sample | sample') , takeUntil, getInfo #-}
  -- | Samples the data according to a given step size.
  sample    :: Float -> a -> Samples
  sample _   = a -> Samples
forall a. Plot a => a -> Samples
sample'
  ------------------------
  -- | Samples the data according to the internal structure.
  sample'   :: a -> Samples
  sample'   = Float -> a -> Samples
forall a. Plot a => Float -> a -> Samples
sample 0.00001
  ------------------------
  -- | Takes the first samples until a given tag.
  takeUntil :: Float -> a -> a
  ------------------------
  -- | Returns static information about the data type.
  getInfo   :: a -> PInfo
  ------------------------

-- | This class gathers types which can be sampled and converted to a
-- numerical string which can be read and interpreted by a plotter
-- engine.
class Plottable a where
  -- | Transforms the input type into a coordinate string.
  toCoord :: a -> String

-------------------------- INSTANCES --------------------------

-- | Time stamps
instance {-# OVERLAPPING #-} Plottable Ts.TimeStamp where
  toCoord :: TimeStamp -> String
toCoord = ShowS
forall a. [a] -> [a]
init ShowS -> (TimeStamp -> String) -> TimeStamp -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeStamp -> String
forall a. Show a => a -> String
show

-- | Absent-extended plottable types
instance (Show a, Plottable a) => Plottable (AE.AbstExt a) where
  -- toCoord = show
  toCoord :: AbstExt a -> String
toCoord AE.Abst     = "_"
  toCoord (AE.Prst a :: a
a) = a -> String
forall a. Plottable a => a -> String
toCoord a
a

-- | Vectors of plottable types
instance (Plottable a) => Plottable (V.Vector a) where
  toCoord :: Vector a -> String
toCoord = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) "<" ShowS -> (Vector a -> String) -> Vector a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String)
-> (Vector a -> [String]) -> Vector a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Plottable a => a -> String
toCoord ([a] -> [String]) -> (Vector a -> [a]) -> Vector a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Vector a -> [a]
V.fromVector 
  -- toCoord = concat . map (\v -> (show $ realToFrac v) ++ " ") .
  --           V.fromVector

-- | Real numbers that can be converted to a floating point representation
instance {-# OVERLAPPABLE #-} (Show a, Real a) => Plottable a where
  toCoord :: a -> String
toCoord = Double -> String
forall a. Show a => a -> String
show (Double -> String) -> (a -> Double) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | For plotting 'ForSyDe.Atom.MoC.SDF.SDF' signals.
instance Plottable a => Plot (SDF.Signal a) where
  sample' :: Signal a -> Samples
sample' = [String] -> [String] -> Samples
forall a b. [a] -> [b] -> [(a, b)]
zip ((Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show [0..]) ([String] -> Samples)
-> (Signal a -> [String]) -> Signal a -> Samples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream String -> [String]
forall a. Stream a -> [a]
fromStream (Stream String -> [String])
-> (Signal a -> Stream String) -> Signal a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SDF a -> String) -> Signal a -> Stream String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SDF a -> String
forall a. Plottable a => SDF a -> String
vToSamp
    where vToSamp :: SDF a -> String
vToSamp (SDF.SDF a :: a
a) = a -> String
forall a. Plottable a => a -> String
toCoord a
a
  ------------------------
  takeUntil :: Float -> Signal a -> Signal a
takeUntil n :: Float
n = Integer -> Signal a -> Signal a
forall t e. (Num t, Ord t) => t -> Stream e -> Stream e
takeS (Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
n)
  ------------------------
  getInfo :: Signal a -> PInfo
getInfo _ = Info :: String -> String -> String -> String -> Bool -> Bool -> PInfo
Info { typeid :: String
typeid   = "sig-sdf"
                   , command :: String
command  = "SY"
                   , measure :: String
measure  = "token"
                   , style :: String
style    = "impulses lw 3"
                   , stacking :: Bool
stacking = Bool
True
                   , sparse :: Bool
sparse   = Bool
False
                   }

-- | 'ForSyDe.Atom.MoC.SY.SY' signals.
instance Plottable a => Plot (SY.Signal a) where
  sample' :: Signal a -> Samples
sample' = [String] -> [String] -> Samples
forall a b. [a] -> [b] -> [(a, b)]
zip ((Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show [0..]) ([String] -> Samples)
-> (Signal a -> [String]) -> Signal a -> Samples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream String -> [String]
forall a. Stream a -> [a]
fromStream (Stream String -> [String])
-> (Signal a -> Stream String) -> Signal a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SY a -> String) -> Signal a -> Stream String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SY a -> String
forall a. Plottable a => SY a -> String
vToSamp
    where vToSamp :: SY a -> String
vToSamp (SY.SY a :: a
a) = a -> String
forall a. Plottable a => a -> String
toCoord a
a
  ------------------------
  takeUntil :: Float -> Signal a -> Signal a
takeUntil n :: Float
n = Integer -> Signal a -> Signal a
forall t e. (Num t, Ord t) => t -> Stream e -> Stream e
takeS (Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
n)
  ------------------------
  getInfo :: Signal a -> PInfo
getInfo _ = Info :: String -> String -> String -> String -> Bool -> Bool -> PInfo
Info { typeid :: String
typeid   = "sig-sy"
                   , command :: String
command  = "SY"
                   , measure :: String
measure  = "sample"
                   , style :: String
style    = "impulses lw 3"
                   , stacking :: Bool
stacking = Bool
True
                   , sparse :: Bool
sparse   = Bool
False
                   }

-- | For plotting 'ForSyDe.Atom.MoC.DE.DE' signals.
instance (Plottable a, Show t, Real t, Fractional t, Num t, Ord t, Eq t) =>
  Plot (DE.SignalBase t a) where
  sample' :: SignalBase t a -> Samples
sample' = (DE t a -> (String, String)) -> [DE t a] -> Samples
forall a b. (a -> b) -> [a] -> [b]
map DE t a -> (String, String)
forall t a.
(Plottable t, Plottable a) =>
DE t a -> (String, String)
v2s ([DE t a] -> Samples)
-> (SignalBase t a -> [DE t a]) -> SignalBase t a -> Samples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalBase t a -> [DE t a]
forall a. Stream a -> [a]
fromStream
    where v2s :: DE t a -> (String, String)
v2s (DE.DE t :: t
t v :: a
v) = (t -> String
forall a. Plottable a => a -> String
toCoord t
t, a -> String
forall a. Plottable a => a -> String
toCoord a
v)
  -- sample' sig = concat $ zipWith v2s ((head lst):lst) lst 
  --   where lst = fromStream sig
  --         v2s (DE.DE pt pv) (DE.DE t v)
  --           = [(toCoord t, toCoord pv), (toCoord t, toCoord v)]
  ------------------------
  takeUntil :: Float -> SignalBase t a -> SignalBase t a
takeUntil n :: Float
n = t -> SignalBase t a -> SignalBase t a
forall t a. t -> Stream (DE t a) -> Stream (DE t a)
until (Float -> t
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
n)
    where until :: t -> Stream (DE t a) -> Stream (DE t a)
until _ NullS = Stream (DE t a)
forall e. Stream e
NullS
          until u :: t
u (DE.DE t :: t
t v :: a
v:-NullS)
            | t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
u     = t -> a -> DE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> DE t a
DE.DE t
t a
v DE t a -> Stream (DE t a) -> Stream (DE t a)
forall e. e -> Stream e -> Stream e
:- t -> a -> DE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> DE t a
DE.DE t
u a
v DE t a -> Stream (DE t a) -> Stream (DE t a)
forall e. e -> Stream e -> Stream e
:- Stream (DE t a)
forall e. Stream e
NullS
            | Bool
otherwise = t -> a -> DE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> DE t a
DE.DE t
u a
v DE t a -> Stream (DE t a) -> Stream (DE t a)
forall e. e -> Stream e -> Stream e
:- Stream (DE t a)
forall e. Stream e
NullS
          until u :: t
u (DE.DE t :: t
t v :: a
v:-xs :: Stream (DE t a)
xs)
            | t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
u     = t -> a -> DE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> DE t a
DE.DE t
t a
v DE t a -> Stream (DE t a) -> Stream (DE t a)
forall e. e -> Stream e -> Stream e
:- t -> Stream (DE t a) -> Stream (DE t a)
until t
u Stream (DE t a)
xs
            | Bool
otherwise = t -> a -> DE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> DE t a
DE.DE t
u a
v DE t a -> Stream (DE t a) -> Stream (DE t a)
forall e. e -> Stream e -> Stream e
:- Stream (DE t a)
forall e. Stream e
NullS
  ------------------------
  getInfo :: SignalBase t a -> PInfo
getInfo _ = Info :: String -> String -> String -> String -> Bool -> Bool -> PInfo
Info { typeid :: String
typeid   = "sig-de"
                   , command :: String
command  = "DE"
                   , measure :: String
measure  = "timestamp"
                   , style :: String
style    = "lines lw 2"
                   , stacking :: Bool
stacking = Bool
False
                   , sparse :: Bool
sparse   = Bool
True
                   }

-- | For plotting 'ForSyDe.Atom.MoC.RE.React.RE' signals.
instance (Plottable a, Show t, Real t, Fractional t, Num t, Ord t, Eq t) =>
  Plot (RE.SignalBase t a) where
  sample' :: SignalBase t a -> Samples
sample' = (RE t a -> (String, String)) -> [RE t a] -> Samples
forall a b. (a -> b) -> [a] -> [b]
map RE t a -> (String, String)
forall t a.
(Plottable t, Plottable a) =>
RE t a -> (String, String)
v2s ([RE t a] -> Samples)
-> (SignalBase t a -> [RE t a]) -> SignalBase t a -> Samples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalBase t a -> [RE t a]
forall a. Stream a -> [a]
fromStream
    where v2s :: RE t a -> (String, String)
v2s (RE.RE t :: t
t v :: a
v) = (t -> String
forall a. Plottable a => a -> String
toCoord t
t, a -> String
forall a. Plottable a => a -> String
toCoord a
v)
  -- sample' sig = concat $ zipWith v2s ((head lst):lst) lst 
  --   where lst = fromStream sig
  --         v2s (RE.RE pt pv) (RE.RE t v)
  --           = [(toCoord t, toCoord pv), (toCoord t, toCoord v)]
  ------------------------
  takeUntil :: Float -> SignalBase t a -> SignalBase t a
takeUntil n :: Float
n = t -> SignalBase t a -> SignalBase t a
forall t a. t -> Stream (RE t a) -> Stream (RE t a)
until (Float -> t
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
n)
    where until :: t -> Stream (RE t a) -> Stream (RE t a)
until _ NullS = Stream (RE t a)
forall e. Stream e
NullS
          until u :: t
u (RE.RE t :: t
t v :: a
v:-NullS)
            | t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
u     = t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE.RE t
t a
v RE t a -> Stream (RE t a) -> Stream (RE t a)
forall e. e -> Stream e -> Stream e
:- t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE.RE t
u a
v RE t a -> Stream (RE t a) -> Stream (RE t a)
forall e. e -> Stream e -> Stream e
:- Stream (RE t a)
forall e. Stream e
NullS
            | Bool
otherwise = t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE.RE t
u a
v RE t a -> Stream (RE t a) -> Stream (RE t a)
forall e. e -> Stream e -> Stream e
:- Stream (RE t a)
forall e. Stream e
NullS
          until u :: t
u (RE.RE t :: t
t v :: a
v:-xs :: Stream (RE t a)
xs)
            | t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
u     = t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE.RE t
t a
v RE t a -> Stream (RE t a) -> Stream (RE t a)
forall e. e -> Stream e -> Stream e
:- t -> Stream (RE t a) -> Stream (RE t a)
until t
u Stream (RE t a)
xs
            | Bool
otherwise = t -> a -> RE t a
forall t a. (Num t, Ord t, Eq t) => t -> a -> RE t a
RE.RE t
u a
v RE t a -> Stream (RE t a) -> Stream (RE t a)
forall e. e -> Stream e -> Stream e
:- Stream (RE t a)
forall e. Stream e
NullS
  ------------------------
  getInfo :: SignalBase t a -> PInfo
getInfo _ = Info :: String -> String -> String -> String -> Bool -> Bool -> PInfo
Info { typeid :: String
typeid   = "sig-de"
                   , command :: String
command  = "RE"
                   , measure :: String
measure  = "timestamp"
                   , style :: String
style    = "lines lw 2"
                   , stacking :: Bool
stacking = Bool
False
                   , sparse :: Bool
sparse   = Bool
True
                   }


-- | For plotting 'ForSyDe.Atom.MoC.CT.CT' signals.
instance (Plottable a) => Plot (CT.Signal a) where
  sample :: Float -> Signal a -> Samples
sample stepsize :: Float
stepsize = TimeStamp -> Signal a -> Samples
forall a time.
(Plottable a, Fractional time) =>
TimeStamp -> Stream (CT TimeStamp time a) -> Samples
evalSamples 0
    where evalSamples :: TimeStamp -> Stream (CT TimeStamp time a) -> Samples
evalSamples t :: TimeStamp
t s :: Stream (CT TimeStamp time a)
s@(x :: CT TimeStamp time a
x:-y :: CT TimeStamp time a
y:-xs :: Stream (CT TimeStamp time a)
xs)
            | CT TimeStamp time a -> TimeStamp
forall timestamp time a. CT timestamp time a -> timestamp
CT.tag CT TimeStamp time a
y TimeStamp -> TimeStamp -> Bool
forall a. Ord a => a -> a -> Bool
<= TimeStamp
t  = TimeStamp -> Stream (CT TimeStamp time a) -> Samples
evalSamples TimeStamp
t (CT TimeStamp time a
yCT TimeStamp time a
-> Stream (CT TimeStamp time a) -> Stream (CT TimeStamp time a)
forall e. e -> Stream e -> Stream e
:-Stream (CT TimeStamp time a)
xs)
            | Bool
otherwise      = (TimeStamp -> String
forall a. Plottable a => a -> String
toCoord TimeStamp
t,
                                a -> String
forall a. Plottable a => a -> String
toCoord (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ TimeStamp -> CT TimeStamp time a -> a
forall p1 time timestamp p2.
(Real p1, Fractional time) =>
p1 -> CT timestamp time p2 -> p2
CT.evalTs TimeStamp
t CT TimeStamp time a
x) (String, String) -> Samples -> Samples
forall a. a -> [a] -> [a]
:
                               TimeStamp -> Stream (CT TimeStamp time a) -> Samples
evalSamples (TimeStamp
t TimeStamp -> TimeStamp -> TimeStamp
forall a. Num a => a -> a -> a
+ TimeStamp
step) Stream (CT TimeStamp time a)
s
          evalSamples _ (_:-NullS) = []
          evalSamples _ NullS      = []
          step :: TimeStamp
step = Float -> TimeStamp
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
stepsize
  ------------------------
  takeUntil :: Float -> Signal a -> Signal a
takeUntil n :: Float
n = TimeStamp -> Signal a -> Signal a
forall timestamp time a.
timestamp
-> Stream (CT timestamp time a) -> Stream (CT timestamp time a)
until (Float -> TimeStamp
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
n)
    where until :: timestamp
-> Stream (CT timestamp time a) -> Stream (CT timestamp time a)
until _ NullS = Stream (CT timestamp time a)
forall e. Stream e
NullS
          until u :: timestamp
u (CT.CT t :: timestamp
t p :: time
p f :: time -> a
f:-NullS)
            | timestamp
t timestamp -> timestamp -> Bool
forall a. Ord a => a -> a -> Bool
< timestamp
u     = timestamp -> time -> (time -> a) -> CT timestamp time a
forall time timestamp a.
(Num time, Num timestamp, Ord timestamp, Eq timestamp) =>
timestamp -> time -> (time -> a) -> CT timestamp time a
CT.CT timestamp
t time
p time -> a
f CT timestamp time a
-> Stream (CT timestamp time a) -> Stream (CT timestamp time a)
forall e. e -> Stream e -> Stream e
:- timestamp -> time -> (time -> a) -> CT timestamp time a
forall time timestamp a.
(Num time, Num timestamp, Ord timestamp, Eq timestamp) =>
timestamp -> time -> (time -> a) -> CT timestamp time a
CT.CT timestamp
u time
p time -> a
f CT timestamp time a
-> Stream (CT timestamp time a) -> Stream (CT timestamp time a)
forall e. e -> Stream e -> Stream e
:- Stream (CT timestamp time a)
forall e. Stream e
NullS
            | Bool
otherwise = timestamp -> time -> (time -> a) -> CT timestamp time a
forall time timestamp a.
(Num time, Num timestamp, Ord timestamp, Eq timestamp) =>
timestamp -> time -> (time -> a) -> CT timestamp time a
CT.CT timestamp
u time
p time -> a
f CT timestamp time a
-> Stream (CT timestamp time a) -> Stream (CT timestamp time a)
forall e. e -> Stream e -> Stream e
:- Stream (CT timestamp time a)
forall e. Stream e
NullS
          until u :: timestamp
u (CT.CT t :: timestamp
t p :: time
p f :: time -> a
f:-xs :: Stream (CT timestamp time a)
xs)
            | timestamp
t timestamp -> timestamp -> Bool
forall a. Ord a => a -> a -> Bool
< timestamp
u     = timestamp -> time -> (time -> a) -> CT timestamp time a
forall time timestamp a.
(Num time, Num timestamp, Ord timestamp, Eq timestamp) =>
timestamp -> time -> (time -> a) -> CT timestamp time a
CT.CT timestamp
t time
p time -> a
f CT timestamp time a
-> Stream (CT timestamp time a) -> Stream (CT timestamp time a)
forall e. e -> Stream e -> Stream e
:- timestamp
-> Stream (CT timestamp time a) -> Stream (CT timestamp time a)
until timestamp
u Stream (CT timestamp time a)
xs
            | Bool
otherwise = timestamp -> time -> (time -> a) -> CT timestamp time a
forall time timestamp a.
(Num time, Num timestamp, Ord timestamp, Eq timestamp) =>
timestamp -> time -> (time -> a) -> CT timestamp time a
CT.CT timestamp
u time
p time -> a
f CT timestamp time a
-> Stream (CT timestamp time a) -> Stream (CT timestamp time a)
forall e. e -> Stream e -> Stream e
:- Stream (CT timestamp time a)
forall e. Stream e
NullS
  ------------------------
  getInfo :: Signal a -> PInfo
getInfo _ = Info :: String -> String -> String -> String -> Bool -> Bool -> PInfo
Info { typeid :: String
typeid   = "sig-ct"
                   , command :: String
command  = "CT"
                   , measure :: String
measure  = "time (s)"
                   , style :: String
style    = "lines"
                   , stacking :: Bool
stacking = Bool
False
                   , sparse :: Bool
sparse   = Bool
False
                   }

-- | For plotting vectors of coordinates
instance Plottable a => Plot (V.Vector a) where
  sample' :: Vector a -> Samples
sample' = [String] -> [String] -> Samples
forall a b. [a] -> [b] -> [(a, b)]
zip ((Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show [1..]) ([String] -> Samples)
-> (Vector a -> [String]) -> Vector a -> Samples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector String -> [String]
forall a. Vector a -> [a]
V.fromVector (Vector String -> [String])
-> (Vector a -> Vector String) -> Vector a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> Vector a -> Vector String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> String
forall a. Plottable a => a -> String
toCoord
  ------------------------
  takeUntil :: Float -> Vector a -> Vector a
takeUntil n :: Float
n = Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.take (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
n)
  ------------------------
  getInfo :: Vector a -> PInfo
getInfo _ = Info :: String -> String -> String -> String -> Bool -> Bool -> PInfo
Info { typeid :: String
typeid   = "vect"
                   , command :: String
command  = "NONE"
                   , measure :: String
measure  = "index"
                   , style :: String
style    = "impulses lw 3"
                   , stacking :: Bool
stacking = Bool
True
                   , sparse :: Bool
sparse   = Bool
False
                   }

-- | For plotting vectors of coordinates
instance Plot P.Histogram where
  sample' :: Histogram -> Samples
sample' = ((Rational, Int) -> (String, String))
-> [(Rational, Int)] -> Samples
forall a b. (a -> b) -> [a] -> [b]
map (Rational -> String
forall a. Plottable a => a -> String
toCoord (Rational -> String)
-> (Int -> String) -> (Rational, Int) -> (String, String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Int -> String
forall a. Plottable a => a -> String
toCoord) ([(Rational, Int)] -> Samples)
-> (Histogram -> [(Rational, Int)]) -> Histogram -> Samples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Histogram -> [(Rational, Int)]
P.getBins
  ------------------------
  takeUntil :: Float -> Histogram -> Histogram
takeUntil n :: Float
n = [(Rational, Int)] -> Histogram
P.Hist ([(Rational, Int)] -> Histogram)
-> (Histogram -> [(Rational, Int)]) -> Histogram -> Histogram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Rational, Int)] -> [(Rational, Int)]
forall a. Int -> [a] -> [a]
take (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
n) ([(Rational, Int)] -> [(Rational, Int)])
-> (Histogram -> [(Rational, Int)])
-> Histogram
-> [(Rational, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Histogram -> [(Rational, Int)]
P.getBins
  ------------------------
  getInfo :: Histogram -> PInfo
getInfo _ = Info :: String -> String -> String -> String -> Bool -> Bool -> PInfo
Info { typeid :: String
typeid   = "hist"
                   , command :: String
command  = "HIST"
                   , measure :: String
measure  = "bin"
                   , style :: String
style    = "boxes"
                   , stacking :: Bool
stacking = Bool
True
                   , sparse :: Bool
sparse   = Bool
False
                   }

-------------------------- PREPARE --------------------------

-- | Prepares a single plottable data structure to be dumped and/or
-- plotted.
prepare :: (Plot a)
        => Config   -- ^ configuration settings
        -> a        -- ^ plottable data type
        -> PlotData -- ^ structure ready for dumping
prepare :: Config -> a -> PlotData
prepare cfg :: Config
cfg = Config -> [a] -> PlotData
forall a. Plot a => Config -> [a] -> PlotData
prepareL Config
cfg ([a] -> PlotData) -> (a -> [a]) -> a -> PlotData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])

-- | Prepares a vector of plottable data structures to be dumped
-- and/or plotted. See 'prepare'.
prepareV :: (Plot a) => Config -> V.Vector a -> PlotData
prepareV :: Config -> Vector a -> PlotData
prepareV cfg :: Config
cfg = Config -> [a] -> PlotData
forall a. Plot a => Config -> [a] -> PlotData
prepareL Config
cfg ([a] -> PlotData) -> (Vector a -> [a]) -> Vector a -> PlotData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Vector a -> [a]
V.fromVector
                 
-- | Prepares a list of plottable data structures to be dumped and/or
-- plotted. See 'prepare'.
prepareL :: (Plot a) => Config -> [a] -> PlotData
prepareL :: Config -> [a] -> PlotData
prepareL cfg :: Config
cfg x :: [a]
x = (Config
cfg, a -> PInfo
forall a. Plot a => a -> PInfo
getInfo ([a] -> a
forall a. [a] -> a
head [a]
x), (Integer -> String -> a -> (String, Samples))
-> [Integer] -> [String] -> [a] -> [(String, Samples)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Integer -> String -> a -> (String, Samples)
forall a a.
(Plot a, Show a) =>
a -> String -> a -> (String, Samples)
prep [1..] [String]
lbls [a]
x)
  where prep :: a -> String -> a -> (String, Samples)
prep  i :: a
i l :: String
l  s :: a
s = (a -> String -> a -> String
forall a a. (Plot a, Show a) => a -> String -> a -> String
mkLbl a
i String
l a
s, Float -> a -> Samples
forall a. Plot a => Float -> a -> Samples
sample Float
sr (a -> Samples) -> a -> Samples
forall a b. (a -> b) -> a -> b
$ Float -> a -> a
forall a. Plot a => Float -> a -> a
takeUntil Float
supx a
s)
        mkLbl :: a -> String -> a -> String
mkLbl i :: a
i "" s :: a
s = PInfo -> String
typeid (a -> PInfo
forall a. Plot a => a -> PInfo
getInfo a
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i
        mkLbl _ l :: String
l  _ = String
l  
        -- extract settings
        lbls :: [String]
lbls = Config -> [String]
labels Config
cfg
        sr :: Float
sr   = Config -> Float
rate   Config
cfg
        supx :: Float
supx = Config -> Float
xmax   Config
cfg

-------------------------- SAMPLE DATA --------------------------

-- | Prints out the sampled contents of a 'prepare'd data set.
showDat :: PlotData -> IO ()
showDat :: PlotData -> IO ()
showDat (_,_,pdata :: [(String, Samples)]
pdata) = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, Samples) -> String) -> [(String, Samples)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Samples) -> String
showD [(String, Samples)]
pdata
  where
    showD :: (String, Samples) -> String
showD (label :: String
label,samp :: Samples
samp) = String
label String -> ShowS
forall a. [a] -> [a] -> [a]
++ " = \n"
                         String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" (((String, String) -> String) -> Samples -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
showS Samples
samp)
    showS :: (String, String) -> String
showS (tag :: String
tag,value :: String
value)  = "\t" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tag String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\t" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
value
        
-- | Dumps the sampled contents of a 'prepare'd data set into separate
-- @.dat@ files.
dumpDat :: PlotData -> IO [String]
dumpDat :: PlotData -> IO [String]
dumpDat (cfg :: Config
cfg, _, pdata :: [(String, Samples)]
pdata) = do
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dpath
  [String]
files <- ((String, Samples) -> IO String)
-> [(String, Samples)] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String, Samples) -> IO String
dump [(String, Samples)]
pdata
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verb (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn ("Dumped " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allLabels String -> ShowS
forall a. [a] -> [a] -> [a]
++ " in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dpath)
  [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
files
  where
    dump :: (String, Samples) -> IO String
dump (lbl :: String
lbl,samp :: Samples
samp)  = let name :: String
name = ShowS
mkFileNm String
lbl
                       in do String -> String -> IO ()
writeFile String
name (Samples -> String
dumpSamp Samples
samp)
                             String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
name
    mkFileNm :: ShowS
mkFileNm label :: String
label = String
dpath String -> ShowS
forall a. [a] -> [a] -> [a]
++ "/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> Char -> ShowS
replChar "$<>{}" '_' String
label String -> ShowS
forall a. [a] -> [a] -> [a]
++ ".dat"
    dumpSamp :: Samples -> String
dumpSamp = ((String, String) -> String) -> Samples -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(x :: String
x,y :: String
y) -> String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++"    "String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n")
    allLabels :: String
allLabels= Int -> ShowS
forall a. Int -> [a] -> [a]
drop 2 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String -> (String, Samples) -> String)
-> String -> [(String, Samples)] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\s :: String
s (l :: String
l,_)-> String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l) "" [(String, Samples)]
pdata
    -- extract settings
    dpath :: String
dpath    = Config -> String
path    Config
cfg
    verb :: Bool
verb     = Config -> Bool
verbose Config
cfg

-------------------------- GNUPLOT --------------------------

-- | Generates a GNUplot script and @.dat@ files for plotting the
-- sampled contents of a 'prepare'd data set. Depending on the
-- configuration settings, it also dumps LaTeX and PDF plots, and
-- fires the script.
--
-- __OBS:__ needless to say that <http://www.gnuplot.info/ GNUplot>
-- needs to be installed in order to use this command. Also, in order
-- to fire GNUplot from a ghci session you might need to install
-- @gnuplot-x11@.
plotGnu :: PlotData -> IO ()
plotGnu :: PlotData -> IO ()
plotGnu pdata :: PlotData
pdata@(cfg :: Config
cfg,info :: PInfo
info,samps :: [(String, Samples)]
samps) = do
  [String]
datFiles <- PlotData -> IO [String]
dumpDat (PlotData -> IO [String]) -> PlotData -> IO [String]
forall a b. (a -> b) -> a -> b
$ PlotData -> PlotData
alterForGnuPlot PlotData
pdata
  -- Write the gnuplot title to a file; Try several times to be able
  -- to open multiple plots in the same session
  String
script <- Int -> String -> (String -> IO ()) -> IO String
tryNTimes 10 String
basename ((String -> IO ()) -> IO String) -> (String -> IO ()) -> IO String
forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO ()
writePlotScript [String]
datFiles
  ExitCode
_ <- if Bool
fireGnuplot then String -> IO ExitCode
system ("gnuplot -persist " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
script)
       else ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isVerbose   (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn ("Signal(s) " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allLabels String -> ShowS
forall a. [a] -> [a] -> [a]
++ " plotted.")
  where
    writePlotScript :: [String] -> String -> IO ()
writePlotScript dat :: [String]
dat f :: String
f = String -> String -> IO ()
writeFile String
f (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> PInfo -> [String] -> String
mkPlotScript Config
cfg PInfo
info [String]
dat
    allLabels :: String
allLabels = Int -> ShowS
forall a. Int -> [a] -> [a]
drop 2 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String -> (String, Samples) -> String)
-> String -> [(String, Samples)] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\s :: String
s (l :: String
l,_)-> String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l) "" [(String, Samples)]
samps
    -- extract settings
    fireGnuplot :: Bool
fireGnuplot = Config -> Bool
fire Config
cfg
    isVerbose :: Bool
isVerbose   = Config -> Bool
verbose Config
cfg
    basename :: String
basename    = Config -> String
path Config
cfg String -> ShowS
forall a. [a] -> [a] -> [a]
++ "/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Config -> String
title Config
cfg

-- | Similar to 'plotGnu' but creates a heatmap plot using the GNUplot
-- engine. For this, the input needs to contain at least two columns
-- of data, otherwise the plot does not show anything, i.e. the
-- samples need to be lists or vectors of two or more elements.
--
-- __OBS:__ same dependencies are needed as for 'plotGnu'.
heatmapGnu :: PlotData -> IO ()
heatmapGnu :: PlotData -> IO ()
heatmapGnu pdata :: PlotData
pdata@(cfg :: Config
cfg,info :: PInfo
info,samps :: [(String, Samples)]
samps) = do
  [String]
datFiles <- PlotData -> IO [String]
dumpDat (PlotData -> IO [String]) -> PlotData -> IO [String]
forall a b. (a -> b) -> a -> b
$ PlotData -> PlotData
alterForGnuHeatmap PlotData
pdata
  String
script <- Int -> String -> (String -> IO ()) -> IO String
tryNTimes 10 String
basename ((String -> IO ()) -> IO String) -> (String -> IO ()) -> IO String
forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO ()
writeHeatmapScript [String]
datFiles
  ExitCode
_ <- if Bool
fireGnuplot then String -> IO ExitCode
system ("gnuplot -persist " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
script)
       else ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isVerbose   (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn ("Signal(s) " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allLabels String -> ShowS
forall a. [a] -> [a] -> [a]
++ " plotted"
                              String -> ShowS
forall a. [a] -> [a] -> [a]
++ " as heatmaps.")
  where
    writeHeatmapScript :: [String] -> String -> IO ()
writeHeatmapScript dat :: [String]
dat f :: String
f = String -> String -> IO ()
writeFile String
f (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> PInfo -> [String] -> String
mkHeatmapScript Config
cfg PInfo
info [String]
dat
    allLabels :: String
allLabels = Int -> ShowS
forall a. Int -> [a] -> [a]
drop 2 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String -> (String, Samples) -> String)
-> String -> [(String, Samples)] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\s :: String
s (l :: String
l,_)-> String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l) "" [(String, Samples)]
samps
    -- extract settings
    fireGnuplot :: Bool
fireGnuplot = Config -> Bool
fire Config
cfg
    isVerbose :: Bool
isVerbose   = Config -> Bool
verbose Config
cfg
    basename :: String
basename    = Config -> String
path Config
cfg String -> ShowS
forall a. [a] -> [a] -> [a]
++ "/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Config -> String
title Config
cfg String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-heat"

----------- not exported -----------

alterForGnuPlot :: PlotData -> PlotData
alterForGnuPlot :: PlotData -> PlotData
alterForGnuPlot (cfg :: Config
cfg,info :: PInfo
info,lsamp :: [(String, Samples)]
lsamp) = (Config
cfg, PInfo
info, ((String, Samples) -> (String, Samples))
-> [(String, Samples)] -> [(String, Samples)]
forall a b. (a -> b) -> [a] -> [b]
map (String, Samples) -> (String, Samples)
forall a a. (a, [(a, String)]) -> (a, [(a, String)])
alter [(String, Samples)]
lsamp)
  where
    alter :: (a, [(a, String)]) -> (a, [(a, String)])
alter (label :: a
label, samp :: [(a, String)]
samp)
      | PInfo -> Bool
sparse PInfo
info   = (a
label, ((a, String) -> (a, String)) -> [(a, String)] -> [(a, String)]
forall a b. (a -> b) -> [a] -> [b]
map (a, String) -> (a, String)
forall a. (a, String) -> (a, String)
handler ([(a, String)] -> [(a, String)]) -> [(a, String)] -> [(a, String)]
forall a b. (a -> b) -> a -> b
$ [(a, String)] -> [(a, String)]
forall a b. [(a, b)] -> [(a, b)]
mkDe [(a, String)]
samp)
      | Bool
otherwise     = (a
label, ((a, String) -> (a, String)) -> [(a, String)] -> [(a, String)]
forall a b. (a -> b) -> [a] -> [b]
map (a, String) -> (a, String)
forall a. (a, String) -> (a, String)
handler [(a, String)]
samp)
    mkDe :: [(a, b)] -> [(a, b)]
mkDe samp :: [(a, b)]
samp@(fs :: (a, b)
fs:_)  =  [[(a, b)]] -> [(a, b)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(a, b)]] -> [(a, b)]) -> [[(a, b)]] -> [(a, b)]
forall a b. (a -> b) -> a -> b
$ ((a, b) -> (a, b) -> [(a, b)])
-> [(a, b)] -> [(a, b)] -> [[(a, b)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (a, b) -> (a, b) -> [(a, b)]
forall a b a. (a, b) -> (a, b) -> [(a, b)]
dup ((a, b)
fs(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
samp) [(a, b)]
samp
    dup :: (a, b) -> (a, b) -> [(a, b)]
dup (pt :: a
pt,pv :: b
pv) (t :: a
t,v :: b
v) = [(a
t,b
pv), (a
t,b
v)]
    handler :: (a, String) -> (a, String)
handler (t :: a
t,"_")   = (a
t,"\n")
    handler (t :: a
t,v :: String
v)
      | String -> Char
forall a. [a] -> a
head String
v Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '<' = (a
t, ShowS
forall a. [a] -> [a]
tail String
v)
      | Bool
otherwise     = (a
t, String
v)

alterForGnuHeatmap :: PlotData -> PlotData
alterForGnuHeatmap :: PlotData -> PlotData
alterForGnuHeatmap (cfg :: Config
cfg,info :: PInfo
info,lsamp :: [(String, Samples)]
lsamp) = (Config
cfg, PInfo
info, ((String, Samples) -> (String, Samples))
-> [(String, Samples)] -> [(String, Samples)]
forall a b. (a -> b) -> [a] -> [b]
map (String, Samples) -> (String, Samples)
forall a. (a, Samples) -> (a, Samples)
alter [(String, Samples)]
lsamp)
  where
    alter :: (a, Samples) -> (a, Samples)
alter (label :: a
label, samp :: Samples
samp)
      | PInfo -> Bool
sparse PInfo
info   = (a
label, ((String, String) -> (String, String)) -> Samples -> Samples
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> (String, String)
forall a b. (a, b) -> (String, b)
noTag (Samples -> Samples) -> Samples -> Samples
forall a b. (a -> b) -> a -> b
$ Samples -> Samples
forall b. [(String, b)] -> [(String, b)]
mkDe (Samples -> Samples) -> Samples -> Samples
forall a b. (a -> b) -> a -> b
$ ((String, String) -> (String, String)) -> Samples -> Samples
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> (String, String)
forall a. (a, String) -> (a, String)
handler Samples
samp)
      | Bool
otherwise     = (a
label, ((String, String) -> (String, String)) -> Samples -> Samples
forall a b. (a -> b) -> [a] -> [b]
map ((String, String) -> (String, String)
forall a b. (a, b) -> (String, b)
noTag ((String, String) -> (String, String))
-> ((String, String) -> (String, String))
-> (String, String)
-> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> (String, String)
forall a. (a, String) -> (a, String)
handler) Samples
samp)
    mkDe :: [(String, b)] -> [(String, b)]
mkDe []           = []
    mkDe ((t :: String
t,v :: b
v):[])   = [(String
t,b
v)]
    mkDe ((t :: String
t,v :: b
v):(ft :: String
ft,fv :: b
fv):xs :: [(String, b)]
xs)
      | Float
itfl Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
ftfl  = (String
t,b
v) (String, b) -> [(String, b)] -> [(String, b)]
forall a. a -> [a] -> [a]
: [(String, b)] -> [(String, b)]
mkDe ((String
ft,b
fv)(String, b) -> [(String, b)] -> [(String, b)]
forall a. a -> [a] -> [a]
:[(String, b)]
xs)
      | Bool
otherwise     = (String
t,b
v) (String, b) -> [(String, b)] -> [(String, b)]
forall a. a -> [a] -> [a]
: [(String, b)] -> [(String, b)]
mkDe ((Float -> String
forall a. Show a => a -> String
show Float
itfl,b
v)(String, b) -> [(String, b)] -> [(String, b)]
forall a. a -> [a] -> [a]
:(String
ft,b
fv)(String, b) -> [(String, b)] -> [(String, b)]
forall a. a -> [a] -> [a]
:[(String, b)]
xs)
      where itfl :: Float
itfl      =(String -> Float
forall a. Read a => String -> a
read String
t::Float) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Config -> Float
rate Config
cfg)
            ftfl :: Float
ftfl      = String -> Float
forall a. Read a => String -> a
read String
ft::Float
    noTag :: (a, b) -> (String, b)
noTag (_,v :: b
v)       = ("",b
v)
    handler :: (a, String) -> (a, String)
handler (t :: a
t,"_")   = (a
t,"0")
    handler (t :: a
t,v :: String
v)
      | String -> Char
forall a. [a] -> a
head String
v Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '<' = (a
t, ShowS
forall a. [a] -> [a]
tail String
v)
      | Bool
otherwise     = (a
t, String
v)

mkPlotScript :: Config -> PInfo -> [FilePath] -> String 
mkPlotScript :: Config -> PInfo -> [String] -> String
mkPlotScript cfg :: Config
cfg info :: PInfo
info files :: [String]
files =
  (if String
plotTitle String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "plot" then "" else "set title \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotTitle String -> ShowS
forall a. [a] -> [a] -> [a]
++  "\"\n")
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "set xlabel \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
unitOfMeasure String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\" \n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if PInfo -> String
command PInfo
info String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "HIST" then
       "set style fill solid\nset boxwidth 0.5\n"
     else "")
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "set xzeroaxis\n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "plot " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotCmds String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
epsCmd String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
latexCmd String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pdfCmd
  where
    plotCmds :: String
plotCmds = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ",\\\n    " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Integer -> String -> ShowS)
-> [Integer] -> [String] -> [String] -> [String]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Integer -> String -> ShowS
forall a. Show a => a -> String -> ShowS
pCmd [0..] [String]
files [String]
plotLb
    pCmd :: a -> String -> ShowS
pCmd i :: a
i f :: String
f l :: String
l = "\t\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
stackCmd a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ " with "
                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotStyle String -> ShowS
forall a. [a] -> [a] -> [a]
++ " title \""String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\""
    stackCmd :: a -> String
stackCmd i :: a
i = if Bool
isStacking then
                   " using ($1+0." String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ "):2"
                 else ""
    epsCmd :: String
epsCmd     = if Bool
plotOther then
                   "set  terminal postscript eps color\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ "set output \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotName String -> ShowS
forall a. [a] -> [a] -> [a]
++".eps\"\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ "replot \n"
                 else ""
    latexCmd :: String
latexCmd   = if Bool
plotOther then
                   "set terminal epslatex color\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ "set output \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotName String -> ShowS
forall a. [a] -> [a] -> [a]
++"-latex.eps\"\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ "replot\n"
                 else ""
    pdfCmd :: String
pdfCmd     = if Bool
plotOther then
                   "set terminal pdf\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ "set output \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotName String -> ShowS
forall a. [a] -> [a] -> [a]
++".pdf\"\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ "replot\n"
                 else ""
    plotName :: String
plotName   = String
plotPath String -> ShowS
forall a. [a] -> [a] -> [a]
++ "/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotId String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotTitle
    -- extract styles
    unitOfMeasure :: String
unitOfMeasure = PInfo -> String
measure  PInfo
info
    plotStyle :: String
plotStyle     = PInfo -> String
style    PInfo
info
    plotId :: String
plotId        = PInfo -> String
typeid   PInfo
info
    isStacking :: Bool
isStacking    = PInfo -> Bool
stacking PInfo
info
    -- extract settings
    plotPath :: String
plotPath   = Config -> String
path    Config
cfg
    plotTitle :: String
plotTitle  = Config -> String
title   Config
cfg
    plotOther :: Bool
plotOther  = Config -> Bool
other   Config
cfg
    plotLb :: [String]
plotLb     = Config -> [String]
labels  Config
cfg

mkHeatmapScript :: Config -> PInfo -> [FilePath] -> String 
mkHeatmapScript :: Config -> PInfo -> [String] -> String
mkHeatmapScript cfg :: Config
cfg info :: PInfo
info files :: [String]
files =
  (if String
plotTitle String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "plot" then "" else "set title \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotTitle String -> ShowS
forall a. [a] -> [a] -> [a]
++  "\"\n")
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "set xlabel \"index\" \n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "set ylabel \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
unitOfMeasure String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\" \n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "set yrange [-0.5" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
scale String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotXmax
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "+0.5" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
scale String -> ShowS
forall a. [a] -> [a] -> [a]
++ "]\n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "set palette rgbformula -7,2,-7\n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "set multiplot layout 1," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
files) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotCmds String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "unset multiplot\n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
epsCmd String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
latexCmd String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pdfCmd
  where
    plotCmds :: String
plotCmds = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ",\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Integer -> String -> ShowS)
-> [Integer] -> [String] -> [String] -> [String]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Integer -> String -> ShowS
forall p. p -> String -> ShowS
pCmd [0..] [String]
files [String]
plotLb
    pCmd :: p -> String -> ShowS
pCmd i :: p
i f :: String
f l :: String
l = "set title \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\"\n"
                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ "plot \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\" matrix "
                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ "using 1:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
scaley String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":3 "
                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ "with image title \"\""
    epsCmd :: String
epsCmd     = if Bool
plotOther then
                   "set  terminal postscript eps color\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ "set output \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotName String -> ShowS
forall a. [a] -> [a] -> [a]
++".eps\"\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ "replot \n"
                 else ""
    latexCmd :: String
latexCmd   = if Bool
plotOther then
                   "set terminal epslatex color\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ "set output \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotName String -> ShowS
forall a. [a] -> [a] -> [a]
++"-latex.eps\"\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ "replot\n"
                 else ""
    pdfCmd :: String
pdfCmd     = if Bool
plotOther then
                   "set terminal pdf\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ "set output \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotName String -> ShowS
forall a. [a] -> [a] -> [a]
++".pdf\"\n"
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ "replot\n"
                 else ""
    plotName :: String
plotName   = String
plotPath String -> ShowS
forall a. [a] -> [a] -> [a]
++ "/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotId String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotTitle
    -- extract styles
    unitOfMeasure :: String
unitOfMeasure = PInfo -> String
measure  PInfo
info
    plotStyle :: String
plotStyle     = PInfo -> String
style    PInfo
info
    plotId :: String
plotId        = PInfo -> String
typeid   PInfo
info
    isStacking :: Bool
isStacking    = PInfo -> Bool
stacking PInfo
info
    isSparse :: Bool
isSparse      = PInfo -> Bool
sparse   PInfo
info
    scale :: String
scale         = if Bool
isSparse then "*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotRate else ""
    scaley :: String
scaley        = if Bool
isSparse then "($2*"String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plotRate String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")" else "2"
    -- extract settings
    plotPath :: String
plotPath   = Config -> String
path    Config
cfg
    plotTitle :: String
plotTitle  = Config -> String
title   Config
cfg
    plotOther :: Bool
plotOther  = Config -> Bool
other   Config
cfg
    plotLb :: [String]
plotLb     = Config -> [String]
labels  Config
cfg
    plotXmax :: String
plotXmax   = Float -> String
forall a. Show a => a -> String
show (Float -> String) -> Float -> String
forall a b. (a -> b) -> a -> b
$ Config -> Float
xmax Config
cfg
    plotRate :: String
plotRate   = Float -> String
forall a. Show a => a -> String
show (Float -> String) -> Float -> String
forall a b. (a -> b) -> a -> b
$ Config -> Float
rate Config
cfg


-------------------------- LATEX --------------------------

-- | Prints out a LaTeX environment from a 'prepare'd data set. This
-- environment should be paste inside a @tikzpicture@ in a document
-- title which imports the ForSyDe-LaTeX package.
showLatex :: PlotData -> IO ()
showLatex :: PlotData -> IO ()
showLatex pdata :: PlotData
pdata = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ PlotData -> String
mkLatex PlotData
pdata

-- | Dumps a set of formatted data files with the extension @.flx@
-- that can be imported by a LaTeX document which uses the
-- ForSyDe-LaTeX package.
dumpLatex :: PlotData -> IO [String]
dumpLatex :: PlotData -> IO [String]
dumpLatex (cfg :: Config
cfg, _, pdata :: [(String, Samples)]
pdata) = do
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dpath
  [String]
files <- ((String, Samples) -> IO String)
-> [(String, Samples)] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String, Samples) -> IO String
dump [(String, Samples)]
pdata
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verb (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn ("Dumped " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allLabels String -> ShowS
forall a. [a] -> [a] -> [a]
++ " in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dpath)
  [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
files
  where
    dump :: (String, Samples) -> IO String
dump (lbl :: String
lbl,samp :: Samples
samp)  = let name :: String
name = ShowS
mkFileNm String
lbl
                       in do String -> String -> IO ()
writeFile String
name (Samples -> String
dumpSamp Samples
samp)
                             String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
name
    mkFileNm :: ShowS
mkFileNm label :: String
label = String
dpath String -> ShowS
forall a. [a] -> [a] -> [a]
++ "/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> Char -> ShowS
replChar "$<>{}" '_' String
label String -> ShowS
forall a. [a] -> [a] -> [a]
++ ".flx"
    dumpSamp :: Samples -> String
dumpSamp = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ",\n" ([String] -> String) -> (Samples -> [String]) -> Samples -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> String) -> Samples -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: String
x,y :: String
y) -> String
y String -> ShowS
forall a. [a] -> [a] -> [a]
++" : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x)
    allLabels :: String
allLabels= Int -> ShowS
forall a. Int -> [a] -> [a]
drop 2 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String -> (String, Samples) -> String)
-> String -> [(String, Samples)] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\s :: String
s (l :: String
l,_)-> String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l) "" [(String, Samples)]
pdata
    -- extract settings
    dpath :: String
dpath    = Config -> String
path    Config
cfg
    verb :: Bool
verb     = Config -> Bool
verbose Config
cfg

-- | Creates a standalone LaTeX document which uses the ForSyDe-LaTeX
-- package, plotting a 'prepare'd data set. Depending on the
-- configuration settings, the command @pdflatex@ may also be invoked
-- to compile a pdf image.
--
-- __OBS:__ A LaTeX compiler is required to run the @pdflatex@
-- command. The <https://github.com/forsyde/forsyde-latex ForSyDe-LaTeX>
-- package also needs to be installed according to the instructions on
-- the project web page.
plotLatex :: PlotData -> IO ()
plotLatex :: PlotData -> IO ()
plotLatex pdata :: PlotData
pdata@(cfg :: Config
cfg,_,_) = do
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
filepath
  String -> String -> IO ()
writeFile String
filename (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
mkLatexFile ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ PlotData -> String
mkLatex PlotData
pdata
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isVerbose (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn ("Dumped LaTeX title " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filename)
  ExitCode
_ <- if Bool
fireLatex then
         String -> IO ExitCode
system ("pdflatex -output-directory=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filepath
                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filename)
       else ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isVerbose Bool -> Bool -> Bool
&& Bool
fireLatex) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn ("Compiled PDF in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filepath)
  where
    -- extract settings
    isVerbose :: Bool
isVerbose = Config -> Bool
verbose Config
cfg
    filename :: String
filename  = Config -> String
path Config
cfg String -> ShowS
forall a. [a] -> [a] -> [a]
++ "/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Config -> String
title Config
cfg String -> ShowS
forall a. [a] -> [a] -> [a]
++ ".tex"
    filepath :: String
filepath  = Config -> String
path Config
cfg
    fireLatex :: Bool
fireLatex = Config -> Bool
fire Config
cfg
  
----------- not exported -----------

alterForLatex :: PlotData -> PlotData
alterForLatex :: PlotData -> PlotData
alterForLatex (cfg :: Config
cfg,info :: PInfo
info,lsamp :: [(String, Samples)]
lsamp) = (Config
cfg, PInfo
info, ((String, Samples) -> (String, Samples))
-> [(String, Samples)] -> [(String, Samples)]
forall a b. (a -> b) -> [a] -> [b]
map (String, Samples) -> (String, Samples)
forall a a. (a, [(a, String)]) -> (a, [(a, String)])
alter [(String, Samples)]
lsamp)
  where
    alter :: (a, [(a, String)]) -> (a, [(a, String)])
alter (label :: a
label, samp :: [(a, String)]
samp) = (a
label, ((a, String) -> (a, String)) -> [(a, String)] -> [(a, String)]
forall a b. (a -> b) -> [a] -> [b]
map (a, String) -> (a, String)
forall a. (a, String) -> (a, String)
handler [(a, String)]
samp)
    handler :: (a, String) -> (a, String)
handler (t :: a
t,"_")     = (a
t,"$\\bot$")
    handler (t :: a
t,v :: String
v)
      | String -> Char
forall a. [a] -> a
head String
v Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '<' = (a
t, "$\\langle$ "
                            String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. [a] -> [a]
tail String
v
                            String -> ShowS
forall a. [a] -> [a] -> [a]
++ " $\\rangle$")
      | Bool
otherwise     = (a
t, String
v)
                            
mkLatex :: PlotData -> String
mkLatex :: PlotData -> String
mkLatex = PlotData -> String
forall (t :: * -> *).
Foldable t =>
(Config, PInfo, t (String, Samples)) -> String
latexCmd (PlotData -> String)
-> (PlotData -> PlotData) -> PlotData -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlotData -> PlotData
alterForLatex 
  where
    latexCmd :: (Config, PInfo, t (String, Samples)) -> String
latexCmd (cfg :: Config
cfg, info :: PInfo
info, lsamp :: t (String, Samples)
lsamp)
      -- SIGNAL plots
      | PInfo -> String
command PInfo
info String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["SY","DE","RE","CT"] =
        "  \\begin{signals" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mocStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ "}[]{"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
lastX String -> ShowS
forall a. [a] -> [a] -> [a]
++ "}\n"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((String, Samples) -> String) -> t (String, Samples) -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, Samples) -> String
toSignal t (String, Samples)
lsamp
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ "  \\end{signals" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mocStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ "}\n"
      -- HISTOGRAM plots
      | PInfo -> String
command PInfo
info String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["HIST"] =
        "  \\begin{axis}[ybar,ytick=\\empty,axis x line*=bottom,axis y line*=left]\n"
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((String, Samples) -> String) -> t (String, Samples) -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, Samples) -> String
forall (t :: * -> *) a.
Foldable t =>
(a, t (String, String)) -> String
toPlot t (String, Samples)
lsamp
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n  \\end{axis}\n"
      | Bool
otherwise = ShowS
forall a. HasCallStack => String -> a
error "mkLatex: plot for this type not implemented."
      where
        ------ SIGNAL helpers ------  
        toSignal :: (String, Samples) -> String
toSignal (label :: String
label,samp :: Samples
samp) =
          "    \\signal" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mocStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ "[name= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
label String -> ShowS
forall a. [a] -> [a] -> [a]
++ "]{"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "," (((String, String) -> String) -> Samples -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
showEvent Samples
samp) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "}\n"
        showEvent :: (String, String) -> String
showEvent (t :: String
t,v :: String
v) = String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t
        mocStr :: String
mocStr = PInfo -> String
command PInfo
info
        lastX :: String
lastX  = Float -> String
forall a. Show a => a -> String
show (Float -> String) -> Float -> String
forall a b. (a -> b) -> a -> b
$ Config -> Float
xmax Config
cfg
        ------ HISTOGRAM helpers ------  
        toPlot :: (a, t (String, String)) -> String
toPlot (_,sp :: t (String, String)
sp) = "  \\addplot coordinates {" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((String, String) -> String) -> t (String, String) -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> String
showBin t (String, String)
sp String -> ShowS
forall a. [a] -> [a] -> [a]
++ "};"
        showBin :: (String, String) -> String
showBin (t :: String
t,v :: String
v) = "(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ "," String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
       
mkLatexFile :: String -> String
mkLatexFile :: ShowS
mkLatexFile cmd :: String
cmd =
  "\\documentclass{standalone}\n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\\usepackage[plot]{forsyde}\n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\\begin{document}\n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\\begin{tikzpicture}[]\n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cmd
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\\end{tikzpicture}\n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\\end{document}\n"

-------------------------- UTILITIES --------------------------

replChar :: String -- all characters in this set are replaced by '_'
         -> Char   -- Char to replace with
         -> String -- the string where characters are replaced
         -> String -- the result string with all characters replaced
replChar :: String -> Char -> ShowS
replChar [] _ s :: String
s  = String
s
replChar _  _ [] = []
replChar rSet :: String
rSet rCh :: Char
rCh (c :: Char
c:s :: String
s) | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
rSet = Char
rCh Char -> ShowS
forall a. a -> [a] -> [a]
: String -> Char -> ShowS
replChar String
rSet Char
rCh String
s
                        | Bool
otherwise     = Char
c   Char -> ShowS
forall a. a -> [a] -> [a]
: String -> Char -> ShowS
replChar String
rSet Char
rCh String
s


tryNTimes :: Int -> String -> (String -> IO ()) -> IO String
tryNTimes :: Int -> String -> (String -> IO ()) -> IO String
tryNTimes n :: Int
n base :: String
base a :: String -> IO ()
a
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = String -> IO String
forall a. HasCallStack => String -> a
error "tryNTimes: not succedded"
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0  = IO String -> (IOError -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (String -> (String -> IO ()) -> IO String
action String
fname String -> IO ()
a) ((String -> IO ()) -> IOError -> IO String
handler String -> IO ()
a)
  where handler :: (String -> IO()) -> IOError -> IO String
        handler :: (String -> IO ()) -> IOError -> IO String
handler a :: String -> IO ()
a _ = Int -> String -> (String -> IO ()) -> IO String
tryNTimes (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) String
base String -> IO ()
a
        fname :: String
fname = String
base String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ ".gnuplot"
        action :: String -> (String -> IO ()) -> IO String
        action :: String -> (String -> IO ()) -> IO String
action fname :: String
fname a :: String -> IO ()
a = do String -> IO ()
a String
fname
                            String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
fname
tryNTimes _ _ _ = String -> IO String
forall a. HasCallStack => String -> a
error "tryNTimes: Unexpected pattern."