module Diagrams.TwoD.ProbabilityGrid where
import Data.Data
import Data.List (genericLength)
import Data.List.Split (chunksOf)
import Data.Typeable
import Debug.Trace
import Diagrams.Backend.Postscript hiding (EPS)
import Diagrams.Backend.SVG hiding (SVG)
import Diagrams.Prelude
import Diagrams.TwoD
import Diagrams.TwoD.Text
import Numeric.Log
import qualified Diagrams.Backend.Postscript as DBP
import qualified Diagrams.Backend.SVG as DBS
import System.FilePath (replaceExtension)
data FillWeight = FWlog | FWlinear | FWfill
deriving (Eq,Show,Data,Typeable)
data FillStyle = FSopacityLog | FSopacityLinear | FSfull
deriving (Eq,Show,Data,Typeable)
gridSquare
:: (Monoid m, Semigroup m, TrailLike (QDiagram b V2 Double m))
=> FillWeight -> FillStyle -> Log Double -> QDiagram b V2 Double m
gridSquare fw fs v
| s >= 0.001 = g `beneath` (z # scale s)
| otherwise = g
where s = case fw of
FWlog -> 1 / (1 ln v)
FWlinear -> exp $ ln v
FWfill -> 1
o = case fs of
FSopacityLog -> 1 / (1 ln v)
FSopacityLinear -> exp $ ln v
FSfull -> 1.0 :: Double
z = square 1 # lw 0 # ((if fs==FSfull then fc else fcA . flip withOpacity o) blue) # centerXY
g = square 1 # lc black
grid
:: ( Renderable (Diagrams.TwoD.Text.Text Double) b
, Renderable (Path V2 Double) b)
=> FillWeight
-> FillStyle
-> t
-> Int
-> [String]
-> [String]
-> [Log Double]
-> QDiagram b V2 Double Any
grid fw fs n m (ns :: [String]) (ms :: [String]) (vs :: [Log Double])
| null ns && null ms = grd
| otherwise = (grd ||| ns') === ms'
where ns' = if null ns then mempty else vcat $ map (\t -> (square 1) `beneath` (text t # scale (0.9 / genericLength t))) ns
ms' = if null ms then mempty else hcat $ map (\t -> (square 1) `beneath` (text t # scale (0.9 / genericLength t))) ms
grd = vcat $ map hcat $ map (map (gridSquare fw fs)) $ chunksOf m $ vs
svgGridFile :: FilePath -> FillWeight -> FillStyle -> Int -> Int -> [String] -> [String] -> [Log Double] -> IO ()
svgGridFile fname fw fs n m ns ms vs = renderPretty fname size $ g
where size = ((*100) . fromIntegral) <$> mkSizeSpec2D (Just m) (Just n)
g = grid fw fs n m ns ms vs
epsGridFile :: String -> FillWeight -> FillStyle -> Int -> Int -> [String] -> [String] -> [Log Double] -> IO ()
epsGridFile fname fw fs n m ns ms vs = renderDia Postscript (PostscriptOptions fname size DBP.EPS) g
where size = ((*100) . fromIntegral) <$> mkSizeSpec2D (Just m) (Just n)
g = grid fw fs n m ns ms vs
data RenderChoice
= SVG
| EPS
deriving (Eq,Show,Data,Typeable)
gridFile :: [RenderChoice] -> String -> FillWeight -> FillStyle -> Int -> Int -> [String] -> [String] -> [Log Double] -> IO ()
gridFile cs fname fw fs n m ns ms vs = go cs
where go [] = return ()
go (c:cs) = case c of
SVG -> svgGridFile (fname ++ ".svg") fw fs n m ns ms vs >> go cs
EPS -> epsGridFile (fname ++ ".eps") fw fs n m ns ms vs >> go cs