filter-code.hs



-- Goal --

import Pendulum

import Goal.Core
import Goal.Geometry
import Goal.Probability

-- Qualified --

import qualified System.Directory as D
import qualified Control.Monad.State.Lazy as S


--- Program ---



-- Globals --

stp = 100

-- Functions --


rateLayout clr mx rs = execEC $ do

    S.modify $ pixMapLayout nnrns nnrns

    layout_margin .= 1

    let clrs = [ clr `withOpacity` (r / mx) | r <- rs ]
        rcs = transpose $ reverse <$> breakEvery nnrns clrs

    layout_plots .= [pixMapPlot (0,0) rcs]

    plot . liftEC $ do

        let nnrns' = fromIntegral nnrns
        let vlns = [ [(k-0.5,-1.5),(k-0.5,nnrns' + 1)] | k <- [0..nnrns'] ]
            hlns = [ [(-1.5,k-0.5),(nnrns' + 1,k-0.5)] | k <- [0..nnrns'] ]

        plot_lines_style .= solidLine 1 (opaque grey)
        plot_lines_values .= (vlns ++ hlns)

-- Main --

main :: IO ()
main = do

    bl <- D.doesFileExist flnm
    c0s <- if bl
              then read <$> readFile flnm
              else error "Script requires a 'ppc-dynamics' file"

    let nnp = fromList nn c0s
        qdq0 = fromList (Bundle pndl) [2,0]

    xnzs <- runWithSystemRandom $ generatePath nstpssml nnp qdq0

    let xnz = xnzs !! stp
        xnz' = xnzs !! (stp+1)

    let (_,_,z) = splitTriple xnz
        (_,n',z') = splitTriple xnz'
        zs = listCoordinates z
        ns' = listCoordinates n'
        zs' = listCoordinates z'
        zs0' = zipWith (-) zs' ns'

        mx = maximum $ zs ++ zs'

        lytz = rateLayout red mx zs
        lytn' = rateLayout black mx ns'
        lytz0' = rateLayout blue mx zs0'
        lytz' = rateLayout red mx zs'
        rnbl = toRenderable . weights (1,1) $ tval lytz .|. tval lytz0' .|. tval lytn' .|. tval lytz'

    --void $ renderableToAspectWindow False 1200 300 rnbl
    putStrLn "Upper Bound:"
    print mx
    void $ renderableToFile (FileOptions (600,150) PDF) "filter-code.pdf" rnbl