diff --git a/README b/README --- a/README +++ b/README @@ -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/ diff --git a/Sound/SC3/Plot.hs b/Sound/SC3/Plot.hs --- a/Sound/SC3/Plot.hs +++ b/Sound/SC3/Plot.hs @@ -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 () diff --git a/Sound/SC3/Plot/Histogram.hs b/Sound/SC3/Plot/Histogram.hs --- a/Sound/SC3/Plot/Histogram.hs +++ b/Sound/SC3/Plot/Histogram.hs @@ -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 diff --git a/hsc3-plot.cabal b/hsc3-plot.cabal --- a/hsc3-plot.cabal +++ b/hsc3-plot.cabal @@ -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