{-# LANGUAGE MultiParamTypeClasses #-}
module Simulation.Aivika.Experiment.Chart.FinalXYChartView
(FinalXYChartView(..),
defaultFinalXYChartView) where
import Control.Monad
import Control.Monad.Trans
import Control.Concurrent.MVar
import Control.Lens
import qualified Data.Map as M
import Data.IORef
import Data.Maybe
import Data.Either
import Data.Monoid
import Data.Array
import Data.Array.IO.Safe
import Data.Default.Class
import System.IO
import System.FilePath
import Graphics.Rendering.Chart
import Simulation.Aivika
import Simulation.Aivika.Experiment
import Simulation.Aivika.Experiment.Base
import Simulation.Aivika.Experiment.Concurrent.MVar
import Simulation.Aivika.Experiment.Chart.Types
import Simulation.Aivika.Experiment.Chart.Utils (colourisePlotLines)
data FinalXYChartView =
FinalXYChartView { FinalXYChartView -> String
finalXYChartTitle :: String,
FinalXYChartView -> String
finalXYChartDescription :: String,
FinalXYChartView -> Int
finalXYChartWidth :: Int,
FinalXYChartView -> Int
finalXYChartHeight :: Int,
FinalXYChartView -> ExperimentFilePath
finalXYChartFileName :: ExperimentFilePath,
FinalXYChartView -> Event Bool
finalXYChartPredicate :: Event Bool,
FinalXYChartView -> ResultTransform
finalXYChartTransform :: ResultTransform,
FinalXYChartView -> ResultTransform
finalXYChartXSeries :: ResultTransform,
FinalXYChartView -> ResultTransform
finalXYChartLeftYSeries :: ResultTransform,
FinalXYChartView -> ResultTransform
finalXYChartRightYSeries :: ResultTransform,
FinalXYChartView -> String
finalXYChartPlotTitle :: String,
FinalXYChartView
-> [PlotLines Double Double -> PlotLines Double Double]
finalXYChartPlotLines :: [PlotLines Double Double ->
PlotLines Double Double],
FinalXYChartView -> LayoutAxis Double -> LayoutAxis Double
finalXYChartBottomAxis :: LayoutAxis Double ->
LayoutAxis Double,
FinalXYChartView
-> LayoutLR Double Double Double -> LayoutLR Double Double Double
finalXYChartLayout :: LayoutLR Double Double Double ->
LayoutLR Double Double Double
}
defaultFinalXYChartView :: FinalXYChartView
defaultFinalXYChartView :: FinalXYChartView
defaultFinalXYChartView =
FinalXYChartView { finalXYChartTitle :: String
finalXYChartTitle = String
"Final XY Chart",
finalXYChartDescription :: String
finalXYChartDescription = String
"It shows the XY chart for the results in the final time points.",
finalXYChartWidth :: Int
finalXYChartWidth = Int
640,
finalXYChartHeight :: Int
finalXYChartHeight = Int
480,
finalXYChartFileName :: ExperimentFilePath
finalXYChartFileName = String -> ExperimentFilePath
UniqueFilePath String
"FinalXYChart",
finalXYChartPredicate :: Event Bool
finalXYChartPredicate = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True,
finalXYChartTransform :: ResultTransform
finalXYChartTransform = forall a. a -> a
id,
finalXYChartXSeries :: ResultTransform
finalXYChartXSeries = forall a. Monoid a => a
mempty,
finalXYChartLeftYSeries :: ResultTransform
finalXYChartLeftYSeries = forall a. Monoid a => a
mempty,
finalXYChartRightYSeries :: ResultTransform
finalXYChartRightYSeries = forall a. Monoid a => a
mempty,
finalXYChartPlotTitle :: String
finalXYChartPlotTitle = String
"$TITLE",
finalXYChartPlotLines :: [PlotLines Double Double -> PlotLines Double Double]
finalXYChartPlotLines = forall x y. [PlotLines x y -> PlotLines x y]
colourisePlotLines,
finalXYChartBottomAxis :: LayoutAxis Double -> LayoutAxis Double
finalXYChartBottomAxis = forall a. a -> a
id,
finalXYChartLayout :: LayoutLR Double Double Double -> LayoutLR Double Double Double
finalXYChartLayout = forall a. a -> a
id }
instance ChartRendering r => ExperimentView FinalXYChartView (WebPageRenderer r) where
outputView :: FinalXYChartView -> ExperimentGenerator (WebPageRenderer r)
outputView FinalXYChartView
v =
let reporter :: Experiment
-> WebPageRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter Experiment
exp (WebPageRenderer r
renderer ExperimentFilePath
_) String
dir =
do FinalXYChartViewState r
st <- forall r.
FinalXYChartView
-> Experiment
-> r
-> String
-> ExperimentWriter (FinalXYChartViewState r)
newFinalXYChart FinalXYChartView
v Experiment
exp r
renderer String
dir
let context :: ExperimentContext (WebPageRenderer a)
context =
forall a. WebPageWriter -> ExperimentContext (WebPageRenderer a)
WebPageContext forall a b. (a -> b) -> a -> b
$
WebPageWriter { reporterWriteTOCHtml :: Int -> HtmlWriter ()
reporterWriteTOCHtml = forall r. FinalXYChartViewState r -> Int -> HtmlWriter ()
finalXYChartTOCHtml FinalXYChartViewState r
st,
reporterWriteHtml :: Int -> HtmlWriter ()
reporterWriteHtml = forall r. FinalXYChartViewState r -> Int -> HtmlWriter ()
finalXYChartHtml FinalXYChartViewState r
st }
forall (m :: * -> *) a. Monad m => a -> m a
return ExperimentReporter { reporterInitialise :: ExperimentMonad (WebPageRenderer a) ()
reporterInitialise = forall (m :: * -> *) a. Monad m => a -> m a
return (),
reporterFinalise :: ExperimentMonad (WebPageRenderer a) ()
reporterFinalise = forall r.
ChartRendering r =>
FinalXYChartViewState r -> ExperimentWriter ()
finaliseFinalXYChart FinalXYChartViewState r
st,
reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate = forall r. FinalXYChartViewState r -> ExperimentData -> Composite ()
simulateFinalXYChart FinalXYChartViewState r
st,
reporterContext :: ExperimentContext (WebPageRenderer a)
reporterContext = forall {a}. ExperimentContext (WebPageRenderer a)
context }
in ExperimentGenerator { generateReporter :: Experiment
-> WebPageRenderer r
-> ExperimentEnvironment (WebPageRenderer r)
-> ExperimentMonad
(WebPageRenderer r) (ExperimentReporter (WebPageRenderer r))
generateReporter = forall {r} {a}.
ChartRendering r =>
Experiment
-> WebPageRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (WebPageRenderer a))
reporter }
instance ChartRendering r => ExperimentView FinalXYChartView (FileRenderer r) where
outputView :: FinalXYChartView -> ExperimentGenerator (FileRenderer r)
outputView FinalXYChartView
v =
let reporter :: Experiment
-> FileRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter Experiment
exp (FileRenderer r
renderer ExperimentFilePath
_) String
dir =
do FinalXYChartViewState r
st <- forall r.
FinalXYChartView
-> Experiment
-> r
-> String
-> ExperimentWriter (FinalXYChartViewState r)
newFinalXYChart FinalXYChartView
v Experiment
exp r
renderer String
dir
forall (m :: * -> *) a. Monad m => a -> m a
return ExperimentReporter { reporterInitialise :: ExperimentMonad (FileRenderer a) ()
reporterInitialise = forall (m :: * -> *) a. Monad m => a -> m a
return (),
reporterFinalise :: ExperimentMonad (FileRenderer a) ()
reporterFinalise = forall r.
ChartRendering r =>
FinalXYChartViewState r -> ExperimentWriter ()
finaliseFinalXYChart FinalXYChartViewState r
st,
reporterSimulate :: ExperimentData -> Composite ()
reporterSimulate = forall r. FinalXYChartViewState r -> ExperimentData -> Composite ()
simulateFinalXYChart FinalXYChartViewState r
st,
reporterContext :: ExperimentContext (FileRenderer a)
reporterContext = forall a. ExperimentContext (FileRenderer a)
FileContext }
in ExperimentGenerator { generateReporter :: Experiment
-> FileRenderer r
-> ExperimentEnvironment (FileRenderer r)
-> ExperimentMonad
(FileRenderer r) (ExperimentReporter (FileRenderer r))
generateReporter = forall {r} {a}.
ChartRendering r =>
Experiment
-> FileRenderer r
-> String
-> ExperimentWriter (ExperimentReporter (FileRenderer a))
reporter }
data FinalXYChartViewState r =
FinalXYChartViewState { forall r. FinalXYChartViewState r -> FinalXYChartView
finalXYChartView :: FinalXYChartView,
forall r. FinalXYChartViewState r -> Experiment
finalXYChartExperiment :: Experiment,
forall r. FinalXYChartViewState r -> r
finalXYChartRenderer :: r,
forall r. FinalXYChartViewState r -> String
finalXYChartDir :: FilePath,
forall r. FinalXYChartViewState r -> IORef (Maybe String)
finalXYChartFile :: IORef (Maybe FilePath),
forall r. FinalXYChartViewState r -> MVar ()
finalXYChartLock :: MVar (),
forall r.
FinalXYChartViewState r -> MVar (Maybe FinalXYChartResults)
finalXYChartResults :: MVar (Maybe FinalXYChartResults) }
data FinalXYChartResults =
FinalXYChartResults { FinalXYChartResults -> String
finalXYChartXName :: String,
FinalXYChartResults -> [Either String String]
finalXYChartYNames :: [Either String String],
FinalXYChartResults -> [IOArray Int (Maybe (Double, Double))]
finalXYChartXY :: [IOArray Int (Maybe (Double, Double))] }
newFinalXYChart :: FinalXYChartView -> Experiment -> r -> FilePath -> ExperimentWriter (FinalXYChartViewState r)
newFinalXYChart :: forall r.
FinalXYChartView
-> Experiment
-> r
-> String
-> ExperimentWriter (FinalXYChartViewState r)
newFinalXYChart FinalXYChartView
view Experiment
exp r
renderer String
dir =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do IORef (Maybe String)
f <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
MVar ()
l <- forall a. a -> IO (MVar a)
newMVar ()
MVar (Maybe FinalXYChartResults)
r <- forall a. a -> IO (MVar a)
newMVar forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return FinalXYChartViewState { finalXYChartView :: FinalXYChartView
finalXYChartView = FinalXYChartView
view,
finalXYChartExperiment :: Experiment
finalXYChartExperiment = Experiment
exp,
finalXYChartRenderer :: r
finalXYChartRenderer = r
renderer,
finalXYChartDir :: String
finalXYChartDir = String
dir,
finalXYChartFile :: IORef (Maybe String)
finalXYChartFile = IORef (Maybe String)
f,
finalXYChartLock :: MVar ()
finalXYChartLock = MVar ()
l,
finalXYChartResults :: MVar (Maybe FinalXYChartResults)
finalXYChartResults = MVar (Maybe FinalXYChartResults)
r }
newFinalXYChartResults :: String -> [Either String String] -> Experiment -> IO FinalXYChartResults
newFinalXYChartResults :: String
-> [Either String String] -> Experiment -> IO FinalXYChartResults
newFinalXYChartResults String
xname [Either String String]
ynames Experiment
exp =
do let n :: Int
n = Experiment -> Int
experimentRunCount Experiment
exp
[IOArray Int (Maybe (Double, Double))]
xy <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Either String String]
ynames forall a b. (a -> b) -> a -> b
$ \Either String String
_ ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
1, Int
n) forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return FinalXYChartResults { finalXYChartXName :: String
finalXYChartXName = String
xname,
finalXYChartYNames :: [Either String String]
finalXYChartYNames = [Either String String]
ynames,
finalXYChartXY :: [IOArray Int (Maybe (Double, Double))]
finalXYChartXY = [IOArray Int (Maybe (Double, Double))]
xy }
requireFinalXYChartResults :: FinalXYChartViewState r -> String -> [Either String String] -> IO FinalXYChartResults
requireFinalXYChartResults :: forall r.
FinalXYChartViewState r
-> String -> [Either String String] -> IO FinalXYChartResults
requireFinalXYChartResults FinalXYChartViewState r
st String
xname [Either String String]
ynames =
forall a b. MVar (Maybe a) -> IO a -> (a -> IO b) -> IO b
maybePutMVar (forall r.
FinalXYChartViewState r -> MVar (Maybe FinalXYChartResults)
finalXYChartResults FinalXYChartViewState r
st)
(String
-> [Either String String] -> Experiment -> IO FinalXYChartResults
newFinalXYChartResults String
xname [Either String String]
ynames (forall r. FinalXYChartViewState r -> Experiment
finalXYChartExperiment FinalXYChartViewState r
st)) forall a b. (a -> b) -> a -> b
$ \FinalXYChartResults
results ->
if (String
xname forall a. Eq a => a -> a -> Bool
/= FinalXYChartResults -> String
finalXYChartXName FinalXYChartResults
results) Bool -> Bool -> Bool
|| ([Either String String]
ynames forall a. Eq a => a -> a -> Bool
/= FinalXYChartResults -> [Either String String]
finalXYChartYNames FinalXYChartResults
results)
then forall a. HasCallStack => String -> a
error String
"Series with different names are returned for different runs: requireFinalXYChartResults"
else forall (m :: * -> *) a. Monad m => a -> m a
return FinalXYChartResults
results
simulateFinalXYChart :: FinalXYChartViewState r -> ExperimentData -> Composite ()
simulateFinalXYChart :: forall r. FinalXYChartViewState r -> ExperimentData -> Composite ()
simulateFinalXYChart FinalXYChartViewState r
st ExperimentData
expdata =
do let view :: FinalXYChartView
view = forall r. FinalXYChartViewState r -> FinalXYChartView
finalXYChartView FinalXYChartViewState r
st
loc :: [ResultId] -> String
loc = ResultLocalisation -> [ResultId] -> String
localisePathResultTitle forall a b. (a -> b) -> a -> b
$
Experiment -> ResultLocalisation
experimentLocalisation forall a b. (a -> b) -> a -> b
$
forall r. FinalXYChartViewState r -> Experiment
finalXYChartExperiment FinalXYChartViewState r
st
rs0 :: Results
rs0 = FinalXYChartView -> ResultTransform
finalXYChartXSeries FinalXYChartView
view forall a b. (a -> b) -> a -> b
$
FinalXYChartView -> ResultTransform
finalXYChartTransform FinalXYChartView
view forall a b. (a -> b) -> a -> b
$
ExperimentData -> Results
experimentResults ExperimentData
expdata
rs1 :: Results
rs1 = FinalXYChartView -> ResultTransform
finalXYChartLeftYSeries FinalXYChartView
view forall a b. (a -> b) -> a -> b
$
FinalXYChartView -> ResultTransform
finalXYChartTransform FinalXYChartView
view forall a b. (a -> b) -> a -> b
$
ExperimentData -> Results
experimentResults ExperimentData
expdata
rs2 :: Results
rs2 = FinalXYChartView -> ResultTransform
finalXYChartRightYSeries FinalXYChartView
view forall a b. (a -> b) -> a -> b
$
FinalXYChartView -> ResultTransform
finalXYChartTransform FinalXYChartView
view forall a b. (a -> b) -> a -> b
$
ExperimentData -> Results
experimentResults ExperimentData
expdata
ext0 :: ResultValue Double
ext0 =
case Results -> [ResultValue Double]
resultsToDoubleValues Results
rs0 of
[ResultValue Double
x] -> ResultValue Double
x
[ResultValue Double]
_ -> forall a. HasCallStack => String -> a
error String
"Expected to see a single X series: simulateFinalXYChart"
exts1 :: [ResultValue Double]
exts1 = Results -> [ResultValue Double]
resultsToDoubleValues Results
rs1
exts2 :: [ResultValue Double]
exts2 = Results -> [ResultValue Double]
resultsToDoubleValues Results
rs2
exts :: [ResultValue Double]
exts = [ResultValue Double]
exts1 forall a. [a] -> [a] -> [a]
++ [ResultValue Double]
exts2
name0 :: String
name0 = [ResultId] -> String
loc forall a b. (a -> b) -> a -> b
$ forall e. ResultValue e -> [ResultId]
resultValueIdPath ResultValue Double
ext0
names1 :: [String]
names1 = forall a b. (a -> b) -> [a] -> [b]
map ([ResultId] -> String
loc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. ResultValue e -> [ResultId]
resultValueIdPath) [ResultValue Double]
exts1
names2 :: [String]
names2 = forall a b. (a -> b) -> [a] -> [b]
map ([ResultId] -> String
loc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. ResultValue e -> [ResultId]
resultValueIdPath) [ResultValue Double]
exts2
names :: [Either String String]
names = forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left [String]
names1 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right [String]
names2
signals :: ResultPredefinedSignals
signals = ExperimentData -> ResultPredefinedSignals
experimentPredefinedSignals ExperimentData
expdata
signal :: Signal Double
signal = forall a. (a -> Event Bool) -> Signal a -> Signal a
filterSignalM (forall a b. a -> b -> a
const Event Bool
predicate) forall a b. (a -> b) -> a -> b
$
ResultPredefinedSignals -> Signal Double
resultSignalInStopTime ResultPredefinedSignals
signals
n :: Int
n = Experiment -> Int
experimentRunCount forall a b. (a -> b) -> a -> b
$ forall r. FinalXYChartViewState r -> Experiment
finalXYChartExperiment FinalXYChartViewState r
st
predicate :: Event Bool
predicate = FinalXYChartView -> Event Bool
finalXYChartPredicate FinalXYChartView
view
lock :: MVar ()
lock = forall r. FinalXYChartViewState r -> MVar ()
finalXYChartLock FinalXYChartViewState r
st
FinalXYChartResults
results <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r.
FinalXYChartViewState r
-> String -> [Either String String] -> IO FinalXYChartResults
requireFinalXYChartResults FinalXYChartViewState r
st String
name0 [Either String String]
names
let xys :: [IOArray Int (Maybe (Double, Double))]
xys = FinalXYChartResults -> [IOArray Int (Maybe (Double, Double))]
finalXYChartXY FinalXYChartResults
results
forall a. Signal a -> (a -> Event ()) -> Composite ()
handleSignalComposite Signal Double
signal forall a b. (a -> b) -> a -> b
$ \Double
_ ->
do Double
x <- forall e. ResultValue e -> ResultData e
resultValueData ResultValue Double
ext0
[Double]
ys <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ResultValue Double]
exts forall e. ResultValue e -> ResultData e
resultValueData
Int
i <- forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter Int
simulationIndex
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
ys [IOArray Int (Maybe (Double, Double))]
xys) forall a b. (a -> b) -> a -> b
$ \(Double
y, IOArray Int (Maybe (Double, Double))
xy) ->
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
lock forall a b. (a -> b) -> a -> b
$ \() ->
Double
x seq :: forall a b. a -> b -> b
`seq` Double
y seq :: forall a b. a -> b -> b
`seq` forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int (Maybe (Double, Double))
xy Int
i forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Double
x, Double
y)
finaliseFinalXYChart :: ChartRendering r => FinalXYChartViewState r -> ExperimentWriter ()
finaliseFinalXYChart :: forall r.
ChartRendering r =>
FinalXYChartViewState r -> ExperimentWriter ()
finaliseFinalXYChart FinalXYChartViewState r
st =
do let view :: FinalXYChartView
view = forall r. FinalXYChartViewState r -> FinalXYChartView
finalXYChartView FinalXYChartViewState r
st
title :: String
title = FinalXYChartView -> String
finalXYChartTitle FinalXYChartView
view
plotTitle :: String
plotTitle = FinalXYChartView -> String
finalXYChartPlotTitle FinalXYChartView
view
plotTitle' :: String
plotTitle' =
String -> String -> String -> String
replace String
"$TITLE" String
title
String
plotTitle
width :: Int
width = FinalXYChartView -> Int
finalXYChartWidth FinalXYChartView
view
height :: Int
height = FinalXYChartView -> Int
finalXYChartHeight FinalXYChartView
view
plotLines :: [PlotLines Double Double -> PlotLines Double Double]
plotLines = FinalXYChartView
-> [PlotLines Double Double -> PlotLines Double Double]
finalXYChartPlotLines FinalXYChartView
view
plotBottomAxis :: LayoutAxis Double -> LayoutAxis Double
plotBottomAxis = FinalXYChartView -> LayoutAxis Double -> LayoutAxis Double
finalXYChartBottomAxis FinalXYChartView
view
plotLayout :: LayoutLR Double Double Double -> LayoutLR Double Double Double
plotLayout = FinalXYChartView
-> LayoutLR Double Double Double -> LayoutLR Double Double Double
finalXYChartLayout FinalXYChartView
view
renderer :: r
renderer = forall r. FinalXYChartViewState r -> r
finalXYChartRenderer FinalXYChartViewState r
st
String
file <- String -> ExperimentFilePath -> ExperimentWriter String
resolveFilePath (forall r. FinalXYChartViewState r -> String
finalXYChartDir FinalXYChartViewState r
st) forall a b. (a -> b) -> a -> b
$
(String -> String) -> ExperimentFilePath -> ExperimentFilePath
mapFilePath (forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> String
replaceExtension forall a b. (a -> b) -> a -> b
$ forall r. ChartRendering r => r -> String
renderableChartExtension r
renderer) forall a b. (a -> b) -> a -> b
$
ExperimentFilePath -> Map String String -> ExperimentFilePath
expandFilePath (FinalXYChartView -> ExperimentFilePath
finalXYChartFileName FinalXYChartView
view) forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String
"$TITLE", String
title)]
Maybe FinalXYChartResults
results <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar forall a b. (a -> b) -> a -> b
$ forall r.
FinalXYChartViewState r -> MVar (Maybe FinalXYChartResults)
finalXYChartResults FinalXYChartViewState r
st
case Maybe FinalXYChartResults
results of
Maybe FinalXYChartResults
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just FinalXYChartResults
results ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do let xname :: String
xname = FinalXYChartResults -> String
finalXYChartXName FinalXYChartResults
results
ynames :: [Either String String]
ynames = FinalXYChartResults -> [Either String String]
finalXYChartYNames FinalXYChartResults
results
xys :: [IOArray Int (Maybe (Double, Double))]
xys = FinalXYChartResults -> [IOArray Int (Maybe (Double, Double))]
finalXYChartXY FinalXYChartResults
results
[Either (Plot Double Double) (Plot Double Double)]
ps <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Either String String]
ynames [IOArray Int (Maybe (Double, Double))]
xys [PlotLines Double Double -> PlotLines Double Double]
plotLines) forall a b. (a -> b) -> a -> b
$ \(Either String String
name, IOArray Int (Maybe (Double, Double))
xy, PlotLines Double Double -> PlotLines Double Double
plotLines) ->
do [Maybe (Double, Double)]
zs <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [e]
getElems IOArray Int (Maybe (Double, Double))
xy
let p :: Plot Double Double
p = forall (a :: * -> * -> *) x y. ToPlot a => a x y -> Plot x y
toPlot forall a b. (a -> b) -> a -> b
$
PlotLines Double Double -> PlotLines Double Double
plotLines forall a b. (a -> b) -> a -> b
$
forall x y. Lens' (PlotLines x y) [[(x, y)]]
plot_lines_values forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Maybe (Double, Double)] -> [[(Double, Double)]]
filterPlotLinesValues [Maybe (Double, Double)]
zs forall a b. (a -> b) -> a -> b
$
forall x y. Lens' (PlotLines x y) String
plot_lines_title forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id Either String String
name forall a b. (a -> b) -> a -> b
$
forall a. Default a => a
def
r :: Either (Plot Double Double) (Plot Double Double)
r = case Either String String
name of
Left String
_ -> forall a b. a -> Either a b
Left Plot Double Double
p
Right String
_ -> forall a b. b -> Either a b
Right Plot Double Double
p
forall (m :: * -> *) a. Monad m => a -> m a
return Either (Plot Double Double) (Plot Double Double)
r
let axis :: LayoutAxis Double
axis = LayoutAxis Double -> LayoutAxis Double
plotBottomAxis forall a b. (a -> b) -> a -> b
$
forall x. Lens' (LayoutAxis x) String
laxis_title forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
xname forall a b. (a -> b) -> a -> b
$
forall a. Default a => a
def
updateLeftAxis :: LayoutLR x y1 y2 -> LayoutLR x y1 y2
updateLeftAxis =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [a]
lefts [Either (Plot Double Double) (Plot Double Double)]
ps
then forall x y1 y2. Lens' (LayoutLR x y1 y2) AxisVisibility
layoutlr_left_axis_visibility forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> Bool -> Bool -> AxisVisibility
AxisVisibility Bool
False Bool
False Bool
False
else forall a. a -> a
id
updateRightAxis :: LayoutLR x y1 y2 -> LayoutLR x y1 y2
updateRightAxis =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [b]
rights [Either (Plot Double Double) (Plot Double Double)]
ps
then forall x y1 y2. Lens' (LayoutLR x y1 y2) AxisVisibility
layoutlr_right_axis_visibility forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> Bool -> Bool -> AxisVisibility
AxisVisibility Bool
False Bool
False Bool
False
else forall a. a -> a
id
chart :: LayoutLR Double Double Double
chart = LayoutLR Double Double Double -> LayoutLR Double Double Double
plotLayout forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall r.
ChartRendering r =>
r -> LayoutLR Double Double Double -> LayoutLR Double Double Double
renderingLayoutLR r
renderer forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {x} {y1} {y2}. LayoutLR x y1 y2 -> LayoutLR x y1 y2
updateLeftAxis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {x} {y1} {y2}. LayoutLR x y1 y2 -> LayoutLR x y1 y2
updateRightAxis forall a b. (a -> b) -> a -> b
$
forall x y1 y2. Lens' (LayoutLR x y1 y2) (LayoutAxis x)
layoutlr_x_axis forall s t a b. ASetter s t a b -> b -> s -> t
.~ LayoutAxis Double
axis forall a b. (a -> b) -> a -> b
$
forall x y1 y2. Lens' (LayoutLR x y1 y2) String
layoutlr_title forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
plotTitle' forall a b. (a -> b) -> a -> b
$
forall x y1 y2.
Lens' (LayoutLR x y1 y2) [Either (Plot x y1) (Plot x y2)]
layoutlr_plots forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Either (Plot Double Double) (Plot Double Double)]
ps forall a b. (a -> b) -> a -> b
$
forall a. Default a => a
def
forall r c.
ChartRendering r =>
r -> (Int, Int) -> String -> Renderable c -> IO (PickFn c)
renderChart r
renderer (Int
width, Int
height) String
file (forall a. ToRenderable a => a -> Renderable ()
toRenderable LayoutLR Double Double Double
chart)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Experiment -> Bool
experimentVerbose forall a b. (a -> b) -> a -> b
$ forall r. FinalXYChartViewState r -> Experiment
finalXYChartExperiment FinalXYChartViewState r
st) forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStr String
"Generated file " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
file
forall a. IORef a -> a -> IO ()
writeIORef (forall r. FinalXYChartViewState r -> IORef (Maybe String)
finalXYChartFile FinalXYChartViewState r
st) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
file
filterPlotLinesValues :: [Maybe (Double, Double)] -> [[(Double, Double)]]
filterPlotLinesValues :: [Maybe (Double, Double)] -> [[(Double, Double)]]
filterPlotLinesValues =
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a. HasCallStack => Maybe a -> a
fromJust) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [[a]]
divideBy forall {a} {a}. (RealFloat a, RealFloat a) => Maybe (a, a) -> Bool
pred
where pred :: Maybe (a, a) -> Bool
pred Maybe (a, a)
Nothing = Bool
True
pred (Just (a
x, a
y)) = forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
||
forall a. RealFloat a => a -> Bool
isNaN a
y Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isInfinite a
y
finalXYChartHtml :: FinalXYChartViewState r -> Int -> HtmlWriter ()
finalXYChartHtml :: forall r. FinalXYChartViewState r -> Int -> HtmlWriter ()
finalXYChartHtml FinalXYChartViewState r
st Int
index =
do forall r. FinalXYChartViewState r -> Int -> HtmlWriter ()
header FinalXYChartViewState r
st Int
index
Maybe String
file <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (forall r. FinalXYChartViewState r -> IORef (Maybe String)
finalXYChartFile FinalXYChartViewState r
st)
case Maybe String
file of
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just String
f ->
HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlImage (String -> String -> String
makeRelative (forall r. FinalXYChartViewState r -> String
finalXYChartDir FinalXYChartViewState r
st) String
f)
header :: FinalXYChartViewState r -> Int -> HtmlWriter ()
FinalXYChartViewState r
st Int
index =
do String -> HtmlWriter () -> HtmlWriter ()
writeHtmlHeader3WithId (String
"id" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
index) forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText (FinalXYChartView -> String
finalXYChartTitle forall a b. (a -> b) -> a -> b
$ forall r. FinalXYChartViewState r -> FinalXYChartView
finalXYChartView FinalXYChartViewState r
st)
let description :: String
description = FinalXYChartView -> String
finalXYChartDescription forall a b. (a -> b) -> a -> b
$ forall r. FinalXYChartViewState r -> FinalXYChartView
finalXYChartView FinalXYChartViewState r
st
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
description) forall a b. (a -> b) -> a -> b
$
HtmlWriter () -> HtmlWriter ()
writeHtmlParagraph forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText String
description
finalXYChartTOCHtml :: FinalXYChartViewState r -> Int -> HtmlWriter ()
finalXYChartTOCHtml :: forall r. FinalXYChartViewState r -> Int -> HtmlWriter ()
finalXYChartTOCHtml FinalXYChartViewState r
st Int
index =
HtmlWriter () -> HtmlWriter ()
writeHtmlListItem forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter () -> HtmlWriter ()
writeHtmlLink (String
"#id" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
index) forall a b. (a -> b) -> a -> b
$
String -> HtmlWriter ()
writeHtmlText (FinalXYChartView -> String
finalXYChartTitle forall a b. (a -> b) -> a -> b
$ forall r. FinalXYChartViewState r -> FinalXYChartView
finalXYChartView FinalXYChartViewState r
st)