Plot.hs

-- | Simple-minded plotters for "Sound.SC3".
module Sound.SC3.Plot where

import Control.Monad {- base -}
import Data.Char {- base -}
import Data.List {- base -}
import Data.List.Split {- split -}
import Data.Ratio {- base -}
import qualified Data.Vector as V {- vector -}
import System.Directory {- directory -}
import System.FilePath {- filepath -}
import System.Process {- process -}

import Sound.OSC {- hosc -}
import Sound.SC3 {- hsc3 -}
import Sound.SC3.Lang.Collection.Vector {- hsc3-lang -}

import Sound.SC3.Plot.Histogram

-- * Math

-- | 'minimum' and 'maximum'.
minmax :: Ord t => [t] -> (t,t)
minmax l = (minimum l,maximum l)

linlin'' :: Fractional a => (a, a) -> (a, a) -> a -> a
linlin'' (l',r') (l,r) x = linlin' x l' r' l r

-- | 'linlin' of /z/.
normalise_seq :: (Fractional b, Ord b) => (b,b) -> (b,b) -> [b] -> [b]
normalise_seq d r = map (linlin'' d r)

-- | Variant that derives domain from 'minmax' of /z/.
normalise_seq' :: (Fractional b, Ord b) => (b,b) -> [b] -> [b]
normalise_seq' (l,r) z = normalise_seq (minmax z) (l,r) z

-- | /n/ '*' /n/.
square :: Num a => a -> a
square n = n * n

-- | Root mean square.
rms :: Floating a => [a] -> a
rms l =
    let n = fromIntegral (length l)
        s = sum (map square l)
    in sqrt (s / n)

-- | 'rms' of 'chunksOf'.
resample_rms :: Floating b => Int -> [b] -> [b]
resample_rms m l =
    let n = length l
        c = n `div` m
        s = chunksOf c l
    in map rms s

-- * Data

-- | Class of plottable numbers.  This is necessary to allow
-- 'Rational', the show instance of which cannot be read by @gnuplot@.
class Num n => PNum n where pshow :: n -> String

ratio_to_double :: Integral n => Ratio n -> Double
ratio_to_double = realToFrac

instance PNum Int where pshow = show
instance PNum Integer where pshow = show
instance PNum Float where pshow = show
instance PNum Double where pshow = show
instance Integral n => PNum (Ratio n) where pshow = show . ratio_to_double

-- * Attr

-- | Attibutes are generated given (i,j) where /i/ is the data set
-- (one indexed) and /j/ is the number of data sets.
type Attr = (Int,Int) -> String

attr_frac :: String -> Double -> Attr
attr_frac ty r (i,j) =
    let n = fromIntegral (j - i) / fromIntegral j
        n' = linlin'' (0,1) (0,r) n
    in "with " ++ ty ++ " lt palette frac " ++ show n'

attr_frac_lines :: Double -> Attr
attr_frac_lines = attr_frac "lines"

-- * 1-dimensional

-- | List of /y/ values, at (implicit) equal /x/ increments.
type Table t = [t]

{- | Plot 'Table' data.

> plotTable [[0,2..12],[0..6],[0,4..12]]
> plotTable [map (\x -> x * cos (x / 20)) [-400 .. 800]]

-}
plotTable :: PNum t => [Table t] -> IO ()
plotTable = mkPlot (["set palette gray","unset colorbox"],"plot",attr_frac_lines 0.5) .
            map (map return)

-- | Variant to plot singular 'Table'.
plotTable1 :: PNum t => Table t -> IO ()
plotTable1 = plotTable . return

{- | Variant of 'plotTable' where each value is drawn as an impulse.

> plotImpulses [[0,2..12],[0..6],[0,4..12]]
> plotImpulses [map (\x -> x * cos (x / 20)) [-400 .. 800]]

-}
plotImpulses :: PNum t => [[t]] -> IO ()
plotImpulses =
    mkPlot (["set palette gray"
            ,"unset colorbox"],"plot",attr_frac "impulses" 0.5) .
    map (map return)

-- | Variant that scales each plot lie within (0,1) and displaces them.
--
-- > plot_table_displace [[0,2..12],[0..6],[0,4..12]]
plot_table_displace :: (Enum t,Fractional t,Ord t,PNum t) => [[t]] -> IO ()
plot_table_displace t =
    let rng = zip [0..] [1..]
        t' = zipWith (normalise_seq (minmax (concat t))) rng t
    in plotTable t'

-- | Variant that normalises each table separately.
--
-- > plot_table_displace_nrm [[0,2..12],[0..6],[0,4..12]]
plot_table_displace_nrm :: (Enum t,Fractional t,Ord t,PNum t) => [[t]] -> IO ()
plot_table_displace_nrm t =
    let rng = zip [0..] [1..]
        t' = zipWith normalise_seq' rng t
    in plotTable t'

-- * 2-dimensional

-- | Cartesian (/x/,/y/) pair.
type P2 t = (t,t)

-- | List of 'P2'.
type Coord t = [P2 t]

{- | Plot set of 'Coord'.

> let {x = [-pi,-pi + 0.01 .. pi]
>     ;f r t = (r t * cos t,r t * sin t)}
> in plot_p2 (attr_frac_lines 0.5)
>            [zip (map cos x) (map sin x)
>            ,zip (map cos x) (map (sin . (* 3)) x)
>            ,map (f ((/ (2 * pi)) . (+ pi))) x]

-}
plot_p2 :: PNum t => Attr -> [Coord t] -> IO ()
plot_p2 attr = do
  let f (x,y) = [x,y]
  mkPlot (["set palette gray","unset colorbox"],"plot",attr) . map (map f)

-- | 'plot_p2' of @with lines@.
plot_p2_ln :: PNum t => [Coord t] -> IO ()
plot_p2_ln = plot_p2 (attr_frac_lines 0.5)

{- | 'plot_p2' of @with points@.

> let f a b c d (x,y) =
>     (x ** 2 - y ** 2 + a * x + b * y
>     ,2 * x * y + c * x + d * y)
> in plot_p2_pt [take 5000 (iterate (f 0.9 (-0.6013) 2.0 0.5) (0.1,0.0))]

-}
plot_p2_pt :: PNum t => [Coord t] -> IO ()
plot_p2_pt = plot_p2 (attr_frac "points pt 0" 0.5)

-- | 'plot_p2' of @with steps@.
--
-- > plot_p2_stp [[(0,0),(1,1),(2,0.5),(4,6),(5,1),(6,0.25)]]
plot_p2_stp :: PNum t => [Coord t] -> IO ()
plot_p2_stp = plot_p2 (attr_frac "steps" 0.5)

-- * 3-dimensional

-- | Cartesian (/x/,/y/,/z/) triple.
type P3 t = (t,t,t)

-- | List of 'P3'.
type Path t = [P3 t]

{- | Three-dimensional variant of 'plot_p2'.

> let {t' = [-pi,-pi + 0.01 .. pi]
>     ;f0 n d = sin . (+) d . (*) n
>     ;f1 t = (f0 1 (pi/2) t,f0 3 0 t,f0 5 0 t)
>     ;e' = [0,0.005 .. pi]
>     ;f2 a b r e t = ((a * t + r * sin e) * cos t
>                     ,(a * t + r * sin e) * sin t
>                     ,b * t + r * (1 - cos e))}
> in plot_p3 (const "with lines")
>            [map f1 t'
>            ,zipWith (f2 0.25 0.25 0.25) e' t']

-}
plot_p3 :: PNum t => Attr -> [Path t] -> IO ()
plot_p3 attr p = do
  let f (x,y,z) = [x,y,z]
  mkPlot ([],"splot",attr) (map (map f) p)

-- | 'plot_p3' of @with lines@.
plot_p3_ln :: PNum t => [Path t] -> IO ()
plot_p3_ln = plot_p3 (const "with lines")

-- | 'plot_p3' of @with points pt 0@.
plot_p3_pt :: PNum t => [Path t] -> IO ()
plot_p3_pt = plot_p3 (const "with points pt 0")

-- * Vector (Cartesian)

-- | List of ('P2','P2') vectors.
type Vc t = [(P2 t,P2 t)]

{- | Plot vectors given as (/p/,/q/).

> let {p = [((0,0),(2,1)),((2,2),(3,2)),((3,4),(4,1))]
>     ;d = [1,2,3,2,3,2,1]
>     ;x = 0 : scanl1 (+) d
>     ;y = [6,4,5,3,7,2,8]
>     ;f x y d = ((x,y),(x+d,y))}
> in plotVectors [p,zipWith3 f x y d]

-}
plotVectors :: (PNum t,Num t) => [Vc t] -> IO ()
plotVectors = do
  let f ((x0,y0),(x1,y1)) = [x0,y0,x1-x0,y1-y0]
  mkPlot ([],"plot",const "with vectors linewidth 1.25") . map (map f)

-- * Matrix

{- | Plot regular matrix data.

> plotMatrix ["set palette grey","unset colorbox"] [[1,3,2],[6,4,5],[8,9,7]]

> let d = [[1.00000000,1.00000000,1.00000000,0.73961496]
>         ,[1.00000000,1.00000000,1.00000000,0.39490538]
>         ,[0.53443549,0.31331112,0.90917979,0.58216201]
>         ,[0.35888692,0.7361968,0.95389629,0.94283073]
>         ,[0.85763543,0.1405479,0.78166569,0.43739318]
>         ,[0.18519824,0.31907815,0.18394244,0.01633875]
>         ,[0.0442339,0.33393132,0.77247883,0.79683943]
>         ,[0.8472137,0.42471225,0.94257581,0.70417117]]
> in plotMatrix ["set palette color"] d

-}
plotMatrix :: (PNum t,Num t) => [String] -> [[t]] -> IO ()
plotMatrix opt =
    mkPlot (opt,"plot",const "matrix with image") .
    return

-- * Envelope

{- | Plot 'Envelope' data.

> import Sound.SC3

> plotEnvelope [envPerc 0.2 1
>              ,envSine 1 0.75
>              ,envADSR 0.4 0.4 0.8 0.9 1 (EnvNum (-4)) 0]

-}
plotEnvelope :: (PNum t,Ord t, Floating t, Enum t) => [Envelope t] -> IO ()
plotEnvelope = plotCoord . map (envelope_render 256)

-- * Buffer

-- | 'plotTable1' of 'b_fetch'.
--
-- > withSC3 (plot_buffer1 0)
plot_buffer1 :: (MonadIO m, DuplexOSC m) => Int -> m ()
plot_buffer1 k = do
  d <- b_fetch 512 k
  liftIO (plotTable1 d)

-- | 'plotTable1' of 'resample_rms' of 'b_fetch'.
--
-- > withSC3 (plot_buffer1_rms 512 0)
plot_buffer1_rms :: (MonadIO m, DuplexOSC m) => Int -> Int -> m ()
plot_buffer1_rms n k = do
  d <- b_fetch 512 k
  let d' = resample_rms n d
      d'' = zipWith (*) (cycle [1,-1]) d'
  liftIO (plotTable1 d'')

-- | 'plot_table1_resamp1' of 'b_fetch'.
--
-- > withSC3 (plot_buffer1_resamp1 512 0)
plot_buffer1_resamp1 :: (MonadIO m, DuplexOSC m) => Int -> Int -> m ()
plot_buffer1_resamp1 n k = do
  d <- b_fetch 512 k
  liftIO (plot_table1_resamp1 n (V.fromList d))

-- | 'plot_table_displace' of 'mapM' of 'b_fetch'.
plot_buffer :: (MonadIO m, DuplexOSC m) => [Int] -> m ()
plot_buffer k = do
  d <- mapM (b_fetch 512) k
  liftIO (plot_table_displace d)

-- | 'plot_table_displace_nrm' of 'mapM' of 'b_fetch'.
plot_buffer_nrm :: (MonadIO m, DuplexOSC m) => [Int] -> m ()
plot_buffer_nrm k = do
  d <- mapM (b_fetch 512) k
  liftIO (plot_table_displace_nrm d)

-- * Histogram

-- | Plot 'Histogram' data.
--
-- > plotHistogram [histogram 3 [0,0,1,2,2,2]
-- >               ,histogram 9 [1,2,2,3,3,3,4,4,4,4]]
plotHistogram :: PNum t => [Histogram t] -> IO ()
plotHistogram =
    let f (Histogram x y) = zip x y
    in plot_p2_stp . map f

-- * Vector (Data Type)

-- | 'plotTable1' of 'V.toList'.
plot_table1_vector :: PNum t => V.Vector t -> IO ()
plot_table1_vector = plotTable1 . V.toList

-- | 'plot_table1_vector' of 'resamp1'.
--
-- > d <- withSC3 (b_fetch 512 0)
-- > plot_table1_resamp1 1024 (V.fromList d)
plot_table1_resamp1 :: (Enum t,RealFrac t,PNum t) => Int -> V.Vector t -> IO ()
plot_table1_resamp1 n t =
    let t' = resamp1 n t
    in plot_table1_vector t'

-- * Synonyms

-- | 'plot_p2_ln'
plotCoord :: PNum t => [Coord t] -> IO ()
plotCoord = plot_p2_ln

-- | 'plot_p2_pt'
plotPoints :: PNum t => [Coord t] -> IO ()
plotPoints = plot_p2_pt

-- | 'plot_p2_stp'
plotCoord_steps :: PNum t => [Coord t] -> IO ()
plotCoord_steps = plot_p2_stp

-- | 'plot_p3_ln'
plotPath :: PNum t => [Path t] -> IO ()
plotPath = plot_p3_ln

-- * Low-level

-- | Plot size (width,height).
type PlotSize = (Double,Double)

-- | Plot options.
data PlotOpt = PlotOpt {plotSize :: Maybe PlotSize
                       ,plotXRange :: Maybe (Double,Double)
                       ,plotYRange :: Maybe (Double,Double)
                       ,plotDir :: FilePath
                       ,plotName :: String
                       ,plotTerminal :: String
                       ,plotGnuplotOpt :: [String]}

-- | Default options for /X11/.
plotOptX11 :: PlotOpt
plotOptX11 = PlotOpt Nothing Nothing Nothing "/tmp" "mkPlot" "x11" ["-p"]

-- | Default options for /WXT/.
plotOptWXT :: PlotOpt
plotOptWXT = plotOptX11 {plotTerminal = "wxt"}

-- | Default options for /SVG/.
plotOptSVG :: PlotSize -> PlotOpt
plotOptSVG sz = PlotOpt (Just sz) Nothing Nothing "/tmp" "mkPlot" "svg" []

-- | Names for SVG terminal have character restrictions.
plotNameEnc :: PlotOpt -> String
plotNameEnc =
    let f c = if isAlphaNum c then c else '_'
    in map f . plotName

-- | Plot parameters, (/pre/,/cmd/,/attr/)
type PlotParam = ([String],String,Attr)

plotDataFile :: PlotOpt -> Int -> FilePath
plotDataFile opt k = plotDir opt </> plotName opt <.> show k <.> "data"

plotRCFile :: PlotOpt -> FilePath
plotRCFile opt = plotDir opt </> plotName opt <.> plotTerminal opt <.> "rc"

plotOutputFile :: PlotOpt -> FilePath
plotOutputFile opt = plotDir opt </> plotName opt <.> plotTerminal opt

writePlotRC :: PlotOpt -> PlotParam -> Int -> IO ()
writePlotRC opt (pre,cmnd,attr) n = do
  let at = map (\i -> "'" ++ plotDataFile opt i ++ "' " ++ attr (i,n)) [1 .. n]
      x_range = case plotXRange opt of
                  Just (x0,x1) -> concat ["set xrange [",show x0,":",show x1,"]"]
                  Nothing -> ""
      y_range = case plotYRange opt of
                  Just (y0,y1) -> concat ["set yrange [",show y0,":",show y1,"]"]
                  Nothing -> ""
      term = case plotSize opt of
               Just (w,h) -> concat ["set terminal \""
                                    ,plotTerminal opt
                                    ,"\" name \""
                                    ,plotNameEnc opt
                                    ,"\" size ",show w,",", show h]
               Nothing -> concat ["set terminal \"",plotTerminal opt,"\""]
      output = case plotTerminal opt of
                 "svg" -> concat ["set output '",plotOutputFile opt,"'"]
                 _ -> ""
      pre' = [term
             ,output
             ,"set tics font \"cmr10, 10\""
             ,x_range
             ,y_range
             ,"unset key"] ++ pre
  _ <- writeFile (plotRCFile opt) (unlines pre' ++ cmnd ++ " " ++ intercalate "," at)
  return ()

writePlotData :: (PNum t,Num t) => PlotOpt -> [[[t]]] -> IO ()
writePlotData opt d = do
  let f = unwords . map pshow
  zipWithM_ writeFile (map (plotDataFile opt) [1 .. length d]) (map (unlines . map f) d)

-- | Plotter given 'PlotOpt' and 'PlotParam'.
mkPlotOpt :: (PNum t,Num t) => PlotOpt -> PlotParam -> [[[t]]] -> IO ()
mkPlotOpt opt param dat = do
  writePlotRC opt param (length dat)
  writePlotData opt dat
  _ <- rawSystem "gnuplot" (plotGnuplotOpt opt ++ [plotRCFile opt])
  return ()

-- | 'mkPlotOpt' with 'plotOptX11'.
mkPlotX11 :: (PNum t,Num t) => PlotParam -> [[[t]]] -> IO ()
mkPlotX11 param dat = do
  tmp <- getTemporaryDirectory
  mkPlotOpt (plotOptX11 {plotDir = tmp}) param dat

-- | 'mkPlotOpt' with 'plotOptSVG'.
mkPlotSVG :: (Num t, PNum t) => PlotSize -> PlotParam -> [[[t]]] -> IO ()
mkPlotSVG sz = mkPlotOpt (plotOptSVG sz)

-- | WXT and SVG.
mkPlot :: (PNum t,Num t) => PlotParam -> [[[t]]] -> IO ()
mkPlot param dat = do
  let n = length dat
      svg_opt = plotOptSVG (1200,400)
  writePlotRC plotOptWXT param n
  writePlotRC svg_opt param n
  writePlotData plotOptWXT dat
  _ <- rawSystem "gnuplot" (plotGnuplotOpt plotOptWXT ++ [plotRCFile plotOptWXT])
  _ <- rawSystem "gnuplot" (plotGnuplotOpt svg_opt ++ [plotRCFile svg_opt])
  return ()