hsc3-plot 0.14 → 0.15

raw patch · 4 files changed

+446/−60 lines, 4 filesdep +hoscdep +hsc3-langdep +splitdep −gnuplotdep ~hsc3PVP ok

version bump matches the API change (PVP)

Dependencies added: hosc, hsc3-lang, split

Dependencies removed: gnuplot

Dependency ranges changed: hsc3

API changes (from Hackage documentation)

Files

• README +6/−3
• Sound/SC3/Plot.hs +431/−50
• Sound/SC3/Plot/Histogram.hs +1/−1
• hsc3-plot.cabal +8/−6

@@ -3,16 +3,19 @@  [Haskell][hs] [SuperCollider][sc3] plotting ([Gnuplot][gnuplot]). +For interactive use under [debian](http://debian.org/) install+`gnuplot-x11`, not `gnuplot`.+ There is an-[entry](?t=hsc3-texts&l=lhs/hsc3-tutorial.lhs#plotting)+[entry](?t=hsc3-texts&e=lhs/hsc3-tutorial.lhs#plotting) at the [hsc3-texts](?t=hsc3-texts)-[tutorial](?t=hsc3-texts&l=lhs/hsc3-tutorial.lhs).+[tutorial](?t=hsc3-texts&e=lhs/hsc3-tutorial.lhs).  [hs]: http://haskell.org/ [sc3]: http://audiosynth.com/ [gnuplot]: http://www.gnuplot.info/ -© [rohan drape][rd], 2013, [gpl][gpl].+© [rohan drape][rd], 2013-2014, [gpl][gpl].  [rd]: http://rd.slavepianos.org/ [gpl]: http://gnu.org/copyleft/

@@ -1,78 +1,459 @@+-- | Simple-minded plotters for "Sound.SC3". module Sound.SC3.Plot where -import qualified Graphics.Gnuplot.Simple as G {- gnuplot -}-import qualified Graphics.Gnuplot.Value.Tuple as G-import Sound.SC3.Plot.Histogram-import Sound.SC3.UGen.Envelope {- hsc3 -}+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 -} -eps :: G.Attribute-eps = G.EPS "/tmp/plot.eps"+import Sound.OSC {- hosc -}+import Sound.SC3 {- hsc3 -}+import Sound.SC3.Lang.Collection.Vector {- hsc3-lang -} --- | Plot 'Envelope' data.+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. ----- > import Sound.SC3--- > plotEnvelope [envPerc 0.2 1,envSine 1 0.75]-plotEnvelope :: (G.C t,Ord t, Floating t, Enum t) => [Envelope t] -> IO ()-plotEnvelope = G.plotLists [] . map (envelope_render 256)+-- > 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' --- | Plot 'Histogram' data.+-- | Variant that normalises each table separately. ----- > plotHistogram [histogram 3 [0,0,1,2,2,2]]-plotHistogram :: G.C t => [Histogram t] -> IO ()-plotHistogram =-    let f (Histogram x y) = zip x y-    in G.plotLists [] . map f+-- > 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' -type Table x = [x]+-- * 2-dimensional --- | Plot 'Table' data, ie. /y/ values at equal /x/ increments.------ > plotTable [[0,2..12],[0..6],[0,4..12]]-plotTable :: G.C t => [Table t] -> IO ()-plotTable = G.plotLists []+-- | Cartesian (/x/,/y/) pair.+type P2 t = (t,t) -type Coord x = [(x,x)]+-- | List of 'P2'.+type Coord t = [P2 t] -{--| Plot two-dimensional coordinates.+{- | Plot set of 'Coord'. -> let {t = [-pi,-pi + 0.01 .. pi]+> let {x = [-pi,-pi + 0.01 .. pi] >     ;f r t = (r t * cos t,r t * sin t)}-> in plotCoord [zip (map cos t) (map sin t)->              ,zip (map cos t) (map (sin . (* 3)) t)->              ,map (f ((/ (2 * pi)) . (+ pi))) 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]  -}-plotCoord :: G.C t => [Coord t] -> IO ()-plotCoord =-    let s = G.defaultStyle {G.plotType = G.LinesPoints}-    in G.plotPathsStyle [] . zip (repeat s)+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) -type Path x = [(x,x,x)]+-- | 'plot_p2' of @with lines@.+plot_p2_ln :: PNum t => [Coord t] -> IO ()+plot_p2_ln = plot_p2 (attr_frac_lines 0.5) -{--| Three dimensional variant of 'plotCoord'.+{- | 'plot_p2' of @with points@. -> let {t = [-pi,-pi + 0.01 .. pi]->     ;f n d = map (sin . (+) d . (*) n) t->     ;(x,y,z) = (f 1 (pi/2),f 3 0,f 5 0)}-> in plotPath (zip3 x y z)+> 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]->     ;f 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 plotPath (zipWith (f 1 1 1) e' t')+>     ;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']  -}-plotPath :: (Num t,Show t) => Path t -> IO ()-plotPath p = do+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-  let nm = tmp </> "plotPath.data"-      cm = "splot '" ++ nm ++ "' with l"-      f (x,y,z) = unwords (map show [x,y,z])-  _ <- writeFile nm (unlines (map f p))-  _ <- rawSystem "gnuplot" ["-p","-e",cm]+  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 ()

@@ -3,7 +3,7 @@ import qualified Data.Vector as V {- vector -} import qualified Statistics.Sample.Histogram as H {- statistics -} -data Histogram x = Histogram [x] [x]+data Histogram x = Histogram [x] [x] deriving (Eq,Show)  -- | Calculate 'Histogram' for number of bins /n/ and sample data /x/. histogram :: Int -> [Double] -> Histogram Double

@@ -1,15 +1,15 @@ Name:              hsc3-plot-Version:           0.14+Version:           0.15 Synopsis:          Haskell SuperCollider Plotting Description:       Plotting functions for hsc3 License:           GPL Category:          Sound-Copyright:         (c) Rohan Drape and others, 2013+Copyright:         (c) Rohan Drape and others, 2013-2014 Author:            Rohan Drape Maintainer:        rd@slavepianos.org Stability:         Experimental-Homepage:          http://rd.slavepianos.org/?t=hsc3-plot-Tested-With:       GHC == 7.2.2+Homepage:          http://rd.slavepianos.org/t/hsc3-plot+Tested-With:       GHC == 7.8.2 Build-Type:        Simple Cabal-Version:     >= 1.8 @@ -18,10 +18,12 @@ Library   Build-Depends:   base == 4.*,                    directory,-                   hsc3 == 0.14.*,+                   hosc == 0.15.*,+                   hsc3 == 0.15.*,+                   hsc3-lang == 0.15.*,                    filepath,-                   gnuplot,                    process,+                   split,                    statistics,                    vector   GHC-Options:     -Wall -fwarn-tabs