diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,10 @@ +ghci: ghci-tmp + +ghci-tmp: + ghci -Wall -i:src:execute/tmp src/Graphics/Gnuplot/Simple.hs + +ghci-pipe: + ghci -Wall -i:src:execute/pipe src/Graphics/Gnuplot/Simple.hs + +ghci-shell: + ghci -Wall -i:src:execute/shell src/Graphics/Gnuplot/Simple.hs diff --git a/execute/pipe/Graphics/Gnuplot/Execute.hs b/execute/pipe/Graphics/Gnuplot/Execute.hs new file mode 100644 --- /dev/null +++ b/execute/pipe/Graphics/Gnuplot/Execute.hs @@ -0,0 +1,17 @@ +module Graphics.Gnuplot.Execute where + +import System.Exit (ExitCode, ) +import System.IO (hPutStr, ) +import qualified System.Process as Proc + + +simple :: + [String] {-^ The lines of the gnuplot script to be piped into gnuplot -} + -> [String] {-^ Options for gnuplot -} + -> IO ExitCode +simple program options = + do -- putStrLn cmd + (inp,_out,_err,pid) <- + Proc.runInteractiveProcess "gnuplot" options Nothing Nothing + hPutStr inp (unlines program) + Proc.waitForProcess pid diff --git a/execute/shell/Graphics/Gnuplot/Execute.hs b/execute/shell/Graphics/Gnuplot/Execute.hs new file mode 100644 --- /dev/null +++ b/execute/shell/Graphics/Gnuplot/Execute.hs @@ -0,0 +1,23 @@ +module Graphics.Gnuplot.Execute where + +import System.Exit (ExitCode, ) +import System.Cmd (system, ) +import Graphics.Gnuplot.Utility + (quote, semiColonConcat, ) + + +simple :: + [String] {-^ The lines of the gnuplot script to be piped into gnuplot -} + -> [String] {-^ Options for gnuplot -} + -> IO ExitCode +simple program options = + let cmd = + "sh -c 'echo " ++ quote (escape (semiColonConcat program)) ++ + " | gnuplot " ++ unwords options ++ "'" + in do --putStrLn cmd + system cmd + +escape :: String -> String +escape ('\"':xs) = '\\' : '\"' : escape xs +escape (x:xs) = x : escape xs +escape [] = [] diff --git a/execute/tmp/Graphics/Gnuplot/Execute.hs b/execute/tmp/Graphics/Gnuplot/Execute.hs new file mode 100644 --- /dev/null +++ b/execute/tmp/Graphics/Gnuplot/Execute.hs @@ -0,0 +1,17 @@ +module Graphics.Gnuplot.Execute where + +import System.Exit (ExitCode, ) +import System.Cmd (rawSystem, ) + + +tmpScript :: FilePath +tmpScript = "curve.gp" + +simple :: + [String] {-^ The lines of the gnuplot script to be piped into gnuplot -} + -> [String] {-^ Options for gnuplot -} + -> IO ExitCode +simple program options = + do writeFile tmpScript (unlines program) + -- putStrLn cmd + rawSystem "gnuplot" $ options ++ [tmpScript] diff --git a/gnuplot.cabal b/gnuplot.cabal --- a/gnuplot.cabal +++ b/gnuplot.cabal @@ -1,21 +1,33 @@ Name: gnuplot -Version: 0.1 +Version: 0.2 License: GPL License-File: LICENSE Author: Henning Thielemann Maintainer: Henning Thielemann -Homepage: http://www.haskell.org/haskellwiki/GNUPlot -Homepage: http://code.haskell.org/gnuplot/ +Homepage: http://www.haskell.org/haskellwiki/Gnuplot +Package-URL: http://code.haskell.org/gnuplot/ Category: Graphics, Math -Synopsis: 2D and 3D plots using GNUPlot +Synopsis: 2D and 3D plots using gnuplot Description: - This is a wrapper to GNUPlot + This is a wrapper to gnuplot which lets you create 2D and 3D plots. . + With the Cabal flags executePipe and executeShell + you can switch to more convenient + but probably less portable ways + of running gnuplot. + . + Start a simple session with @make ghci@. + . In the past this was part of the htam package. Tested-With: GHC==6.8.2 Cabal-Version: >=1.2 Build-Type: Simple +Extra-Source-Files: + Makefile + execute/tmp/Graphics/Gnuplot/Execute.hs + execute/pipe/Graphics/Gnuplot/Execute.hs + execute/shell/Graphics/Gnuplot/Execute.hs Flag splitBase description: Choose the new smaller, split-up base package. @@ -24,20 +36,34 @@ description: Build test executables default: False +Flag executePipe + description: Avoid a temporary gnuplot script by running gnuplot with runInteractiveProcess + default: False + +Flag executeShell + description: Avoid a temporary gnuplot script by calling gnuplot via a UNIX shell and its piping syntax + default: False + Library If flag(splitBase) Build-Depends: base >= 2, process >= 1.0 && < 1.1, time >= 1.1 && < 1.2, old-locale >= 1.0 && < 1.1 - -- random is needed for the Test Else Build-Depends: base >= 1.0 && < 2 - -- From the Monad Template Library we only need the State monad. - -- If your compiler does not support functional dependencies, - -- it would be easy to replace that by mapAccumL. - GHC-Options: -Wall - Hs-Source-Dirs: src + GHC-Options: -Wall + + Hs-Source-Dirs: src + If flag(executePipe) + Hs-Source-Dirs: execute/pipe + Else + If flag(executeShell) + Hs-Source-Dirs: execute/shell + Else + Hs-Source-Dirs: execute/tmp + Exposed-Modules: - Graphics.GNUPlot.Simple - Graphics.GNUPlot.Time + Graphics.Gnuplot.Simple + Graphics.Gnuplot.Time Other-Modules: - Graphics.GNUPlot.Utility + Graphics.Gnuplot.Utility + Graphics.Gnuplot.Execute diff --git a/src/Graphics/GNUPlot/Simple.hs b/src/Graphics/GNUPlot/Simple.hs deleted file mode 100644 --- a/src/Graphics/GNUPlot/Simple.hs +++ /dev/null @@ -1,432 +0,0 @@ -module Graphics.GNUPlot.Simple where - -import System.Exit (ExitCode, ) -import System.Cmd (rawSystem, system, ) -import Data.List (intersperse, ) -import Control.Monad (zipWithM, ) -import Data.Maybe (listToMaybe, mapMaybe, isNothing, ) -import Graphics.GNUPlot.Utility (dropWhileRev, functionToGraph, ) - -{-* User front-end -} - -data Attribute = - EPS FilePath - | Grid (Maybe [String]) - | Key (Maybe [String]) - | Border (Maybe [String]) - | XTicks (Maybe [String]) - | YTicks (Maybe [String]) - | Size (Size) - | Aspect (Aspect) - | BoxAspect (Aspect) - | LineStyle Int [LineAttr] - | Title String - | XLabel String - | YLabel String - | XRange (Double, Double) - | YRange (Double, Double) - | ZRange (Double, Double) - | Palette [(Double, (Double, Double, Double))] - | ColorBox (Maybe [String]) - | XTime - | XFormat String - -data Size = - Scale Double - | SepScale Double Double - -data Aspect = - Ratio Double - | NoRatio - -{- The Int types would be better enumerations - but their interpretations depend on the gnuplot output type. :-( -} -data LineAttr = - LineType Int - | LineWidth Double - | PointType Int - | PointSize Double - -data LineSpec = - DefaultStyle Int - | CustomStyle [LineAttr] - -data PlotType = - Lines - | Points - | LinesPoints - | Impulses - | Dots - | Steps - | FSteps - | HiSteps - | ErrorBars - | XErrorBars - | YErrorBars - | XYErrorBars - | ErrorLines - | XErrorLines - | YErrorLines - | XYErrorLines - | Boxes - | FilledCurves - | BoxErrorBars - | BoxXYErrorBars - | FinanceBars - | CandleSticks - | Vectors - | PM3d - -type PlotStyle = (PlotType, LineSpec) - - --- candidate for Useful, similar routines are in module Integration -linearScale :: Fractional a => Integer -> (a,a) -> [a] -linearScale n (x0,x1) = - map (\m -> x0 + (x1-x0) * fromIntegral m / fromIntegral n) [0..n] - -defaultStyle :: PlotStyle -defaultStyle = (Lines, CustomStyle []) - - - -{- | -> plotList [] (take 30 (let fibs = 0 : 1 : zipWith (+) fibs (tail fibs) in fibs)) --} -plotList :: Show a => [Attribute] -> [a] -> IO () -plotList attrs = plotListStyle attrs defaultStyle - -plotListStyle :: Show a => [Attribute] -> PlotStyle -> [a] -> IO () -plotListStyle attrs style dat = - do writeFile tmpFile (unlines (map show dat)) - callGNUPlot attrs "plot" - [quote tmpFile ++ " using 1 with " ++ - plotStyleToString style] - return () - -plotLists :: Show a => [Attribute] -> [[a]] -> IO () -plotLists attrs = plotListsStyle attrs . map ((,) defaultStyle) - -plotListsStyle :: Show a => [Attribute] -> [(PlotStyle, [a])] -> IO () -plotListsStyle attrs dats = - do fileNames <- zipWithM - (\n dat -> - let fileName = tmpFileStem ++ show n ++ ".dat" - in writeFile fileName - (unlines (map show dat)) - >> return fileName) - [(1::Int)..] (map snd dats) - callGNUPlot attrs "plot" - (zipWith - (\fileName style -> - quote fileName ++ " using 1 with " ++ - plotStyleToString style) - fileNames (map fst dats)) - return () - -{- | -> plotFunc [] (linearScale 1000 (-10,10)) sin --} -plotFunc :: Show a => [Attribute] -> [a] -> (a -> a) -> IO () -plotFunc attrs args f = plotPath attrs (functionToGraph args f) - -{- | -> plotFuncs [] (linearScale 1000 (-10,10)) [sin, cos] --} -plotFuncs :: Show a => [Attribute] -> [a] -> [a -> a] -> IO () -plotFuncs attrs args fs = - plot2dMultiSharedAbscissa attrs (zipWith const (repeat defaultStyle) fs) - (map (\x -> (x, map ($ x) fs)) args) - -plotPath :: Show a => [Attribute] -> [(a,a)] -> IO () -plotPath attrs = plot2dGen attrs defaultStyle - -plotPaths :: Show a => [Attribute] -> [[(a,a)]] -> IO () -plotPaths attrs = plot2dMultiGen attrs . zip (repeat defaultStyle) - -plotPathStyle :: Show a => [Attribute] -> PlotStyle -> [(a,a)] -> IO () -plotPathStyle = plot2dGen - -plotPathsStyle :: Show a => [Attribute] -> [(PlotStyle, [(a,a)])] -> IO () -plotPathsStyle = plot2dMultiGen - -{- | -> plotParamFunc [] (linearScale 1000 (0,2*pi)) (\t -> (sin (2*t), cos t)) --} -plotParamFunc :: Show a => [Attribute] -> [a] -> (a -> (a,a)) -> IO () -plotParamFunc attrs args f = plotPath attrs (map f args) - -plotParamFuncs :: Show a => [Attribute] -> [a] -> [a -> (a,a)] -> IO () -plotParamFuncs attrs args fs = plotPaths attrs (map (flip map args) fs) - - -plotDots :: Show a => [Attribute] -> [(a,a)] -> IO () -plotDots attrs = plot2dGen attrs (Points, CustomStyle []) - - - -data Plot3dType = - Surface - | ColorMap - -data CornersToColor = - Mean - | GeometricMean - | Median - | Corner1 - | Corner2 - | Corner3 - | Corner4 - -data Attribute3d = - Plot3dType Plot3dType - | CornersToColor CornersToColor - - -{- | -> let xs = [-2,-1.8..2::Double] in plotMesh3d [] [] (do x <- xs; return (do y <- xs; return (x,y,cos(x*x+y*y)))) --} -plotMesh3d :: (Show a, Show b, Show c) => - [Attribute] -> [Attribute3d] -> [[(a,b,c)]] -> IO () -plotMesh3d attrs pt dat = - do writeFile tmpFile (unlines (map (unlines . map showTriplet) dat)) - startGNUPlot (semiColonConcat (map attrToProg attrs ++ - ["set pm3d " ++ unwords (map attribute3dToString pt)] ++ - ["splot " ++ quote tmpFile ++ " using 1:2:3 with pm3"])) - "-persist" - return () - -{- | -> let xs = [-2,-1.8..2::Double] in plotFunc3d [] [] xs xs (\x y -> exp(-(x*x+y*y))) --} -plotFunc3d :: (Show a, Show b, Show c) => - [Attribute] -> [Attribute3d] -> [b] -> [c] -> (b -> c -> a) -> IO () -plotFunc3d attrs pt xArgs yArgs f = - plotMesh3d attrs pt (map (map (\(x,y) -> (x, y, f x y)) . flip map yArgs . (,)) xArgs) - - - -{-* For inclusion of GNUPlot graphics in LaTeX documents using lhs2TeX -} - -{-| Redirects the output of a plotting function to an EPS file - and additionally converts it to PDF. -} -epspdfPlot :: - FilePath - -> ([Attribute] -> IO ()) {-^ Drawing function that expects some GNUPlot attributes. -} - -> IO () -epspdfPlot filename plot = - do plot (EPS (filename++".eps") : Key Nothing : []) - rawSystem "epstopdf" [filename++".eps"] - return () - -{-| Creates an EPS and a PDF graphics - and returns a string that can be inserted into a LaTeX document - to include this graphic. - - Different from GHCi, Hugs doesn't output a return value from an IO monad. - So you must wrap it with a 'putStr'. - Nevertheless this implementation which returns the LaTeX command as string - is the most flexible one. -} -inclPlot :: - FilePath - -> ([Attribute] -> IO ()) {-^ Drawing function that expects some GNUPlot attributes. -} - -> IO String -inclPlot filename plot = - do epspdfPlot filename plot - return ("\\includegraphics{"++filename++"}") - - - -{-* Internal functions -} - -tmpFileStem, tmpFile :: FilePath - -tmpFileStem = "curve" -tmpFile = tmpFileStem ++ ".dat" - - -showTriplet :: (Show a, Show b, Show c) => (a,b,c) -> String -showTriplet (x,y,z) = unwords [show x, show y, show z] - - -commaConcat, semiColonConcat :: [String] -> String -commaConcat = concat . intersperse ", " -semiColonConcat = concat . intersperse "; " - - -attrToProg :: Attribute -> String -attrToProg (EPS filename) = - "set terminal postscript eps;" ++ -- latex - "set output " ++ quote filename -attrToProg (Grid (Just x)) = "set grid " ++ unwords x -attrToProg (Grid Nothing) = "set nogrid" -attrToProg (Key (Just x)) = "set key " ++ unwords x -attrToProg (Key Nothing) = "set nokey" -attrToProg (Border (Just x)) = "set border " ++ unwords x -attrToProg (Border Nothing) = "set noborder" -attrToProg (XTicks (Just x)) = "set xtics " ++ unwords x -attrToProg (XTicks Nothing) = "set noxtics" -attrToProg (YTicks (Just x)) = "set ytics " ++ unwords x -attrToProg (YTicks Nothing) = "set noytics" -attrToProg (Size (Scale c)) = "set size " ++ show c -attrToProg (Size (SepScale x y)) = "set size " ++ show x ++ ", " ++ show y -attrToProg (Aspect (Ratio r)) = "set size ratio " ++ show (-r) -attrToProg (Aspect (NoRatio)) = "set size noratio" -attrToProg (BoxAspect (Ratio r)) = "set size ratio " ++ show r -attrToProg (BoxAspect (NoRatio)) = "set size noratio" -attrToProg (LineStyle num style) - = "set linestyle " ++ show num ++ " " ++ unwords (map lineAttrToString style) -attrToProg (Title title) = "set title " ++ quote title -attrToProg (XLabel label) = "set xlabel " ++ quote label -attrToProg (YLabel label) = "set ylabel " ++ quote label -attrToProg (XRange _) = "" -- xrange is handled in plot command -attrToProg (YRange _) = "" -- yrange is handled in plot command -attrToProg (ZRange _) = "" -- zrange is handled in plot command -attrToProg (Palette colors) - = "set palette defined (" ++ - commaConcat (map (\(idx,c) -> show idx ++ " " ++ showTriplet c) colors) ++ ")" -attrToProg (ColorBox (Just x)) = "set colorbox " ++ unwords x -attrToProg (ColorBox Nothing) = "unset colorbox" -attrToProg XTime = "set xdata time; set timefmt \"%s\"" -attrToProg (XFormat fmt) = "set format x " ++ quote fmt - -xRangeFromAttr, yRangeFromAttr, zRangeFromAttr :: - Attribute -> Maybe (Double, Double) -xRangeFromAttr (XRange rng) = Just rng -xRangeFromAttr _ = Nothing - -yRangeFromAttr (YRange rng) = Just rng -yRangeFromAttr _ = Nothing - -zRangeFromAttr (ZRange rng) = Just rng -zRangeFromAttr _ = Nothing - -extractRanges :: [Attribute] -> String -extractRanges attrs = - let ranges = map (listToMaybe . flip mapMaybe attrs) - [xRangeFromAttr, yRangeFromAttr, zRangeFromAttr] - showRng (l,r) = "[" ++ show l ++ ":" ++ show r ++ "]" - in unwords (map (maybe "[:]" showRng) (dropWhileRev isNothing ranges)) - - - -lineAttrToString :: LineAttr -> String -lineAttrToString (LineType t) = "linetype " ++ show t -lineAttrToString (LineWidth x) = "linewidth " ++ show x -lineAttrToString (PointType t) = "pointtype " ++ show t -lineAttrToString (PointSize x) = "pointsize " ++ show x - -lineSpecToString :: LineSpec -> String -lineSpecToString (DefaultStyle n) = "linestyle " ++ show n -lineSpecToString (CustomStyle s) = unwords (map lineAttrToString s) - -plotTypeToString :: PlotType -> String -plotTypeToString Lines = "lines" -plotTypeToString Points = "points" -plotTypeToString LinesPoints = "linespoints" -plotTypeToString Impulses = "impulses" -plotTypeToString Dots = "dots" -plotTypeToString Steps = "steps" -plotTypeToString FSteps = "fsteps" -plotTypeToString HiSteps = "histeps" -plotTypeToString ErrorBars = "errorbars" -plotTypeToString XErrorBars = "xerrorbars" -plotTypeToString YErrorBars = "yerrorbars" -plotTypeToString XYErrorBars = "xyerrorbars" -plotTypeToString ErrorLines = "errorlines" -plotTypeToString XErrorLines = "xerrorlines" -plotTypeToString YErrorLines = "yerrorlines" -plotTypeToString XYErrorLines = "xyerrorlines" -plotTypeToString Boxes = "boxes" -plotTypeToString FilledCurves = "filledcurves" -plotTypeToString BoxErrorBars = "boxerrorbars" -plotTypeToString BoxXYErrorBars = "boxxyerrorbars" -plotTypeToString FinanceBars = "financebars" -plotTypeToString CandleSticks = "candlesticks" -plotTypeToString Vectors = "vectors" -plotTypeToString PM3d = "pm3d" - - -plotStyleToString :: PlotStyle -> String -plotStyleToString (p, l) = - plotTypeToString p ++ " " ++ lineSpecToString l - - -plot3dTypeToString :: Plot3dType -> String -plot3dTypeToString Surface = "" -plot3dTypeToString ColorMap = "map" - -cornersToColorToString :: CornersToColor -> String -cornersToColorToString Mean = "mean" -cornersToColorToString GeometricMean = "geomean" -cornersToColorToString Median = "median" -cornersToColorToString Corner1 = "c1" -cornersToColorToString Corner2 = "c2" -cornersToColorToString Corner3 = "c3" -cornersToColorToString Corner4 = "c4" - -attribute3dToString :: Attribute3d -> String -attribute3dToString (Plot3dType pt) = plot3dTypeToString pt -attribute3dToString (CornersToColor c2c) = - "corners2color " ++cornersToColorToString c2c - - -{-| Writes point data to a file and returns a string containing - GNUPlot.plot parameters to invoke the file. -} -storeData :: Show a => FilePath -> PlotStyle -> [(a,a)] -> IO String -storeData file style dat = - do writeFile file (unlines (map (\(x,y) -> show x ++ " " ++ show y) dat)) - return (quote file ++ " using 1:2 with " ++ plotStyleToString style) - -plot2dGen :: Show a => [Attribute] -> PlotStyle -> [(a,a)] -> IO () -plot2dGen attrs style dat = - do plotParam <- storeData tmpFile style dat - callGNUPlot attrs "plot" [plotParam] - return () - -plot2dMultiGen :: Show a => - [Attribute] -> [(PlotStyle, [(a,a)])] -> IO () -plot2dMultiGen attrs styleDat = - do plotParams <- sequence $ - zipWith (\n -> uncurry (storeData (tmpFileStem++show n++".dat"))) - [(0::Int)..] styleDat - callGNUPlot attrs "plot" plotParams - return () - -plot2dMultiSharedAbscissa :: Show a => - [Attribute] -> [PlotStyle] -> [(a,[a])] -> IO () -plot2dMultiSharedAbscissa attrs styles dat = - let plotParams = - zipWith (\n style -> quote tmpFile ++ " using 1:" - ++ show (n+1) ++ " with " ++ plotStyleToString style) - [(1::Int)..] styles - in do {- writeFile tmpFile (concatMap (\(x,ys) -> - foldr (\y -> shows y . (' ':)) (shows x "\n") ys) dat) -} - writeFile tmpFile - (unlines (map (unwords . map show . uncurry (:)) dat)) - callGNUPlot attrs "plot" plotParams - return () - -quote :: String -> String -quote str = "\"" ++ str ++ "\"" - -callGNUPlot :: [Attribute] -> String -> [String] -> IO ExitCode -callGNUPlot attrs cmd params = - startGNUPlot (semiColonConcat (map attrToProg attrs ++ - [cmd ++ " " ++ - extractRanges attrs ++ " " ++ - commaConcat params])) - "-persist" - -- instead of the option, one can also use 'set terminal x11 persist' - -startGNUPlot :: - String {-^ The program that shall pipe into GNUPlot -} - -> String {-^ Options for GNUPlot -} - -> IO ExitCode -startGNUPlot program options = - let escape ('\"':xs) = '\\' : '\"' : escape xs - escape (x:xs) = x : escape xs - escape [] = [] - cmd = "sh -c 'echo " ++ quote (escape program) ++ " | gnuplot " ++ options ++ "'" - in do --putStrLn cmd - system cmd diff --git a/src/Graphics/GNUPlot/Time.hs b/src/Graphics/GNUPlot/Time.hs deleted file mode 100644 --- a/src/Graphics/GNUPlot/Time.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Graphics.GNUPlot.Time where - -import System.Locale(defaultTimeLocale) -import Data.Time.Format(FormatTime, formatTime) -import Graphics.GNUPlot.Utility (mapFst) - -{- | -Use it this way: - -> import Data.Time -> import Graphics.GNUPlot.Simple -> -> main = -> plotPath [XTime, XFormat "%m-%d"] $ prepXTime $ -> (UTCTime (fromGregorian 2008 01 01) 0, 1.0) : -> (UTCTime (fromGregorian 2008 01 05) 43200, 5.0) : -> (UTCTime (fromGregorian 2008 01 15) 0, 2.5) : -> [] --} - -prepXTime :: (FormatTime a, Read b) => [(a, b)] -> [(b, b)] -prepXTime = map (mapFst (read . formatTime defaultTimeLocale "%s")) diff --git a/src/Graphics/GNUPlot/Utility.hs b/src/Graphics/GNUPlot/Utility.hs deleted file mode 100644 --- a/src/Graphics/GNUPlot/Utility.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Graphics.GNUPlot.Utility where - -dropWhileRev :: (a -> Bool) -> [a] -> [a] -dropWhileRev p = - foldr (\x xs -> if p x && null xs then [] else x:xs) [] - -functionToGraph :: [a] -> (a -> a) -> [(a,a)] -functionToGraph args f = map (\x -> (x, f x)) args - --- functionToGraph args f = map swap $ attachKey f args - - -mapFst :: (a -> c) -> (a,b) -> (c,b) -mapFst f ~(a,b) = (f a, b) - -mapSnd :: (b -> c) -> (a,b) -> (a,c) -mapSnd f ~(a,b) = (a, f b) diff --git a/src/Graphics/Gnuplot/Simple.hs b/src/Graphics/Gnuplot/Simple.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Gnuplot/Simple.hs @@ -0,0 +1,448 @@ +module Graphics.Gnuplot.Simple ( + Attribute(..), + Size(..), + Aspect(..), + + LineAttr(..), + LineSpec(..), + PlotType(..), + + PlotStyle, + + linearScale, + defaultStyle, + + plotList, + plotListStyle, + plotLists, + plotListsStyle, + plotFunc, + plotFuncs, + plotPath, + plotPaths, + plotPathStyle, + plotPathsStyle, + plotParamFunc, + plotParamFuncs, + plotDots, + + Plot3dType(..), + CornersToColor(..), + Attribute3d(..), + plotMesh3d, + plotFunc3d, + + epspdfPlot, + inclPlot, + ) where + +import System.Exit (ExitCode, ) +import System.Cmd (rawSystem, ) +import Control.Monad (zipWithM, ) +import Data.Maybe (listToMaybe, mapMaybe, isNothing, ) +import qualified Graphics.Gnuplot.Execute as Exec +import Graphics.Gnuplot.Utility + (dropWhileRev, functionToGraph, + quote, commaConcat, showTriplet, ) + +{-* User front-end -} + +data Attribute = + EPS FilePath + | Grid (Maybe [String]) + | Key (Maybe [String]) + | Border (Maybe [String]) + | XTicks (Maybe [String]) + | YTicks (Maybe [String]) + | Size (Size) + | Aspect (Aspect) + | BoxAspect (Aspect) + | LineStyle Int [LineAttr] + | Title String + | XLabel String + | YLabel String + | XRange (Double, Double) + | YRange (Double, Double) + | ZRange (Double, Double) + | Palette [(Double, (Double, Double, Double))] + | ColorBox (Maybe [String]) + | XTime + | XFormat String + +data Size = + Scale Double + | SepScale Double Double + +data Aspect = + Ratio Double + | NoRatio + +{- The Int types would be better enumerations + but their interpretations depend on the gnuplot output type. :-( -} +data LineAttr = + LineType Int + | LineWidth Double + | PointType Int + | PointSize Double + +data LineSpec = + DefaultStyle Int + | CustomStyle [LineAttr] + +data PlotType = + Lines + | Points + | LinesPoints + | Impulses + | Dots + | Steps + | FSteps + | HiSteps + | ErrorBars + | XErrorBars + | YErrorBars + | XYErrorBars + | ErrorLines + | XErrorLines + | YErrorLines + | XYErrorLines + | Boxes + | FilledCurves + | BoxErrorBars + | BoxXYErrorBars + | FinanceBars + | CandleSticks + | Vectors + | PM3d + +type PlotStyle = (PlotType, LineSpec) + + +-- candidate for Useful, similar routines are in module Integration +linearScale :: Fractional a => Integer -> (a,a) -> [a] +linearScale n (x0,x1) = + map (\m -> x0 + (x1-x0) * fromIntegral m / fromIntegral n) [0..n] + +defaultStyle :: PlotStyle +defaultStyle = (Lines, CustomStyle []) + + + +{- | +> plotList [] (take 30 (let fibs = 0 : 1 : zipWith (+) fibs (tail fibs) in fibs)) +-} +plotList :: Show a => [Attribute] -> [a] -> IO () +plotList attrs = plotListStyle attrs defaultStyle + +plotListStyle :: Show a => [Attribute] -> PlotStyle -> [a] -> IO () +plotListStyle attrs style dat = + do writeFile tmpFile (unlines (map show dat)) + callGnuplot attrs "plot" + [quote tmpFile ++ " using 1 with " ++ + plotStyleToString style] + return () + +plotLists :: Show a => [Attribute] -> [[a]] -> IO () +plotLists attrs = plotListsStyle attrs . map ((,) defaultStyle) + +plotListsStyle :: Show a => [Attribute] -> [(PlotStyle, [a])] -> IO () +plotListsStyle attrs dats = + do fileNames <- zipWithM + (\n dat -> + let fileName = tmpFileStem ++ show n ++ ".dat" + in writeFile fileName + (unlines (map show dat)) + >> return fileName) + [(1::Int)..] (map snd dats) + callGnuplot attrs "plot" + (zipWith + (\fileName style -> + quote fileName ++ " using 1 with " ++ + plotStyleToString style) + fileNames (map fst dats)) + return () + +{- | +> plotFunc [] (linearScale 1000 (-10,10)) sin +-} +plotFunc :: Show a => [Attribute] -> [a] -> (a -> a) -> IO () +plotFunc attrs args f = plotPath attrs (functionToGraph args f) + +{- | +> plotFuncs [] (linearScale 1000 (-10,10)) [sin, cos] +-} +plotFuncs :: Show a => [Attribute] -> [a] -> [a -> a] -> IO () +plotFuncs attrs args fs = + plot2dMultiSharedAbscissa attrs (zipWith const (repeat defaultStyle) fs) + (map (\x -> (x, map ($ x) fs)) args) + +plotPath :: Show a => [Attribute] -> [(a,a)] -> IO () +plotPath attrs = plot2dGen attrs defaultStyle + +plotPaths :: Show a => [Attribute] -> [[(a,a)]] -> IO () +plotPaths attrs = plot2dMultiGen attrs . zip (repeat defaultStyle) + +plotPathStyle :: Show a => [Attribute] -> PlotStyle -> [(a,a)] -> IO () +plotPathStyle = plot2dGen + +plotPathsStyle :: Show a => [Attribute] -> [(PlotStyle, [(a,a)])] -> IO () +plotPathsStyle = plot2dMultiGen + +{- | +> plotParamFunc [] (linearScale 1000 (0,2*pi)) (\t -> (sin (2*t), cos t)) +-} +plotParamFunc :: Show a => [Attribute] -> [a] -> (a -> (a,a)) -> IO () +plotParamFunc attrs args f = plotPath attrs (map f args) + +plotParamFuncs :: Show a => [Attribute] -> [a] -> [a -> (a,a)] -> IO () +plotParamFuncs attrs args fs = plotPaths attrs (map (flip map args) fs) + + +plotDots :: Show a => [Attribute] -> [(a,a)] -> IO () +plotDots attrs = plot2dGen attrs (Points, CustomStyle []) + + + +data Plot3dType = + Surface + | ColorMap + +data CornersToColor = + Mean + | GeometricMean + | Median + | Corner1 + | Corner2 + | Corner3 + | Corner4 + +data Attribute3d = + Plot3dType Plot3dType + | CornersToColor CornersToColor + + +{- | +> let xs = [-2,-1.8..2::Double] in plotMesh3d [] [] (do x <- xs; return (do y <- xs; return (x,y,cos(x*x+y*y)))) +-} +plotMesh3d :: (Show a, Show b, Show c) => + [Attribute] -> [Attribute3d] -> [[(a,b,c)]] -> IO () +plotMesh3d attrs pt dat = + do writeFile tmpFile (unlines (map (unlines . map showTriplet) dat)) + Exec.simple + (map attrToProg attrs ++ + ["set pm3d " ++ unwords (map attribute3dToString pt)] ++ + ["splot " ++ quote tmpFile ++ " using 1:2:3 with pm3"]) + ["-persist"] + return () + +{- | +> let xs = [-2,-1.8..2::Double] in plotFunc3d [] [] xs xs (\x y -> exp(-(x*x+y*y))) +-} +plotFunc3d :: (Show a, Show b, Show c) => + [Attribute] -> [Attribute3d] -> [b] -> [c] -> (b -> c -> a) -> IO () +plotFunc3d attrs pt xArgs yArgs f = + plotMesh3d attrs pt (map (map (\(x,y) -> (x, y, f x y)) . flip map yArgs . (,)) xArgs) + + + +{-* For inclusion of gnuplot graphics in LaTeX documents using lhs2TeX -} + +{-| Redirects the output of a plotting function to an EPS file + and additionally converts it to PDF. -} +epspdfPlot :: + FilePath + -> ([Attribute] -> IO ()) {-^ Drawing function that expects some gnuplot attributes. -} + -> IO () +epspdfPlot filename plot = + do plot (EPS (filename++".eps") : Key Nothing : []) + rawSystem "epstopdf" [filename++".eps"] + return () + +{-| Creates an EPS and a PDF graphics + and returns a string that can be inserted into a LaTeX document + to include this graphic. + + Different from GHCi, Hugs doesn't output a return value from an IO monad. + So you must wrap it with a 'putStr'. + Nevertheless this implementation which returns the LaTeX command as string + is the most flexible one. -} +inclPlot :: + FilePath + -> ([Attribute] -> IO ()) {-^ Drawing function that expects some gnuplot attributes. -} + -> IO String +inclPlot filename plot = + do epspdfPlot filename plot + return ("\\includegraphics{"++filename++"}") + + + +{-* Internal functions -} + +tmpFileStem, tmpFile :: FilePath + +tmpFileStem = "curve" +tmpFile = tmpFileStem ++ ".dat" + + +attrToProg :: Attribute -> String +attrToProg (EPS filename) = + "set terminal postscript eps;" ++ -- latex + "set output " ++ quote filename +attrToProg (Grid (Just x)) = "set grid " ++ unwords x +attrToProg (Grid Nothing) = "set nogrid" +attrToProg (Key (Just x)) = "set key " ++ unwords x +attrToProg (Key Nothing) = "set nokey" +attrToProg (Border (Just x)) = "set border " ++ unwords x +attrToProg (Border Nothing) = "set noborder" +attrToProg (XTicks (Just x)) = "set xtics " ++ unwords x +attrToProg (XTicks Nothing) = "set noxtics" +attrToProg (YTicks (Just x)) = "set ytics " ++ unwords x +attrToProg (YTicks Nothing) = "set noytics" +attrToProg (Size (Scale c)) = "set size " ++ show c +attrToProg (Size (SepScale x y)) = "set size " ++ show x ++ ", " ++ show y +attrToProg (Aspect (Ratio r)) = "set size ratio " ++ show (-r) +attrToProg (Aspect (NoRatio)) = "set size noratio" +attrToProg (BoxAspect (Ratio r)) = "set size ratio " ++ show r +attrToProg (BoxAspect (NoRatio)) = "set size noratio" +attrToProg (LineStyle num style) + = "set linestyle " ++ show num ++ " " ++ unwords (map lineAttrToString style) +attrToProg (Title title) = "set title " ++ quote title +attrToProg (XLabel label) = "set xlabel " ++ quote label +attrToProg (YLabel label) = "set ylabel " ++ quote label +attrToProg (XRange _) = "" -- xrange is handled in plot command +attrToProg (YRange _) = "" -- yrange is handled in plot command +attrToProg (ZRange _) = "" -- zrange is handled in plot command +attrToProg (Palette colors) + = "set palette defined (" ++ + commaConcat (map (\(idx,c) -> show idx ++ " " ++ showTriplet c) colors) ++ ")" +attrToProg (ColorBox (Just x)) = "set colorbox " ++ unwords x +attrToProg (ColorBox Nothing) = "unset colorbox" +attrToProg XTime = "set xdata time; set timefmt \"%s\"" +attrToProg (XFormat fmt) = "set format x " ++ quote fmt + +xRangeFromAttr, yRangeFromAttr, zRangeFromAttr :: + Attribute -> Maybe (Double, Double) +xRangeFromAttr (XRange rng) = Just rng +xRangeFromAttr _ = Nothing + +yRangeFromAttr (YRange rng) = Just rng +yRangeFromAttr _ = Nothing + +zRangeFromAttr (ZRange rng) = Just rng +zRangeFromAttr _ = Nothing + +extractRanges :: [Attribute] -> String +extractRanges attrs = + let ranges = map (listToMaybe . flip mapMaybe attrs) + [xRangeFromAttr, yRangeFromAttr, zRangeFromAttr] + showRng (l,r) = "[" ++ show l ++ ":" ++ show r ++ "]" + in unwords (map (maybe "[:]" showRng) (dropWhileRev isNothing ranges)) + + + +lineAttrToString :: LineAttr -> String +lineAttrToString (LineType t) = "linetype " ++ show t +lineAttrToString (LineWidth x) = "linewidth " ++ show x +lineAttrToString (PointType t) = "pointtype " ++ show t +lineAttrToString (PointSize x) = "pointsize " ++ show x + +lineSpecToString :: LineSpec -> String +lineSpecToString (DefaultStyle n) = "linestyle " ++ show n +lineSpecToString (CustomStyle s) = unwords (map lineAttrToString s) + +plotTypeToString :: PlotType -> String +plotTypeToString Lines = "lines" +plotTypeToString Points = "points" +plotTypeToString LinesPoints = "linespoints" +plotTypeToString Impulses = "impulses" +plotTypeToString Dots = "dots" +plotTypeToString Steps = "steps" +plotTypeToString FSteps = "fsteps" +plotTypeToString HiSteps = "histeps" +plotTypeToString ErrorBars = "errorbars" +plotTypeToString XErrorBars = "xerrorbars" +plotTypeToString YErrorBars = "yerrorbars" +plotTypeToString XYErrorBars = "xyerrorbars" +plotTypeToString ErrorLines = "errorlines" +plotTypeToString XErrorLines = "xerrorlines" +plotTypeToString YErrorLines = "yerrorlines" +plotTypeToString XYErrorLines = "xyerrorlines" +plotTypeToString Boxes = "boxes" +plotTypeToString FilledCurves = "filledcurves" +plotTypeToString BoxErrorBars = "boxerrorbars" +plotTypeToString BoxXYErrorBars = "boxxyerrorbars" +plotTypeToString FinanceBars = "financebars" +plotTypeToString CandleSticks = "candlesticks" +plotTypeToString Vectors = "vectors" +plotTypeToString PM3d = "pm3d" + + +plotStyleToString :: PlotStyle -> String +plotStyleToString (p, l) = + plotTypeToString p ++ " " ++ lineSpecToString l + + +plot3dTypeToString :: Plot3dType -> String +plot3dTypeToString Surface = "" +plot3dTypeToString ColorMap = "map" + +cornersToColorToString :: CornersToColor -> String +cornersToColorToString Mean = "mean" +cornersToColorToString GeometricMean = "geomean" +cornersToColorToString Median = "median" +cornersToColorToString Corner1 = "c1" +cornersToColorToString Corner2 = "c2" +cornersToColorToString Corner3 = "c3" +cornersToColorToString Corner4 = "c4" + +attribute3dToString :: Attribute3d -> String +attribute3dToString (Plot3dType pt) = plot3dTypeToString pt +attribute3dToString (CornersToColor c2c) = + "corners2color " ++cornersToColorToString c2c + + +{-| Writes point data to a file and returns a string containing + Gnuplot.plot parameters to invoke the file. -} +storeData :: Show a => FilePath -> PlotStyle -> [(a,a)] -> IO String +storeData file style dat = + do writeFile file (unlines (map (\(x,y) -> show x ++ " " ++ show y) dat)) + return (quote file ++ " using 1:2 with " ++ plotStyleToString style) + +plot2dGen :: Show a => [Attribute] -> PlotStyle -> [(a,a)] -> IO () +plot2dGen attrs style dat = + do plotParam <- storeData tmpFile style dat + callGnuplot attrs "plot" [plotParam] + return () + +plot2dMultiGen :: Show a => + [Attribute] -> [(PlotStyle, [(a,a)])] -> IO () +plot2dMultiGen attrs styleDat = + do plotParams <- sequence $ + zipWith (\n -> uncurry (storeData (tmpFileStem++show n++".dat"))) + [(0::Int)..] styleDat + callGnuplot attrs "plot" plotParams + return () + +plot2dMultiSharedAbscissa :: Show a => + [Attribute] -> [PlotStyle] -> [(a,[a])] -> IO () +plot2dMultiSharedAbscissa attrs styles dat = + let plotParams = + zipWith (\n style -> quote tmpFile ++ " using 1:" + ++ show (n+1) ++ " with " ++ plotStyleToString style) + [(1::Int)..] styles + in do {- writeFile tmpFile (concatMap (\(x,ys) -> + foldr (\y -> shows y . (' ':)) (shows x "\n") ys) dat) -} + writeFile tmpFile + (unlines (map (unwords . map show . uncurry (:)) dat)) + callGnuplot attrs "plot" plotParams + return () + +callGnuplot :: [Attribute] -> String -> [String] -> IO ExitCode +callGnuplot attrs cmd params = + Exec.simple + (map attrToProg attrs ++ + [cmd ++ " " ++ + extractRanges attrs ++ " " ++ + commaConcat params]) + ["-persist"] + -- instead of the option, one can also use 'set terminal x11 persist' diff --git a/src/Graphics/Gnuplot/Time.hs b/src/Graphics/Gnuplot/Time.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Gnuplot/Time.hs @@ -0,0 +1,22 @@ +module Graphics.Gnuplot.Time where + +import System.Locale(defaultTimeLocale) +import Data.Time.Format(FormatTime, formatTime) +import Graphics.Gnuplot.Utility (mapFst) + +{- | +Use it this way: + +> import Data.Time +> import Graphics.Gnuplot.Simple +> +> main = +> plotPath [XTime, XFormat "%m-%d"] $ prepXTime $ +> (UTCTime (fromGregorian 2008 01 01) 0, 1.0) : +> (UTCTime (fromGregorian 2008 01 05) 43200, 5.0) : +> (UTCTime (fromGregorian 2008 01 15) 0, 2.5) : +> [] +-} + +prepXTime :: (FormatTime a, Read b) => [(a, b)] -> [(b, b)] +prepXTime = map (mapFst (read . formatTime defaultTimeLocale "%s")) diff --git a/src/Graphics/Gnuplot/Utility.hs b/src/Graphics/Gnuplot/Utility.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Gnuplot/Utility.hs @@ -0,0 +1,34 @@ +module Graphics.Gnuplot.Utility where + +import Data.List (intersperse, ) + + +dropWhileRev :: (a -> Bool) -> [a] -> [a] +dropWhileRev p = + foldr (\x xs -> if p x && null xs then [] else x:xs) [] + +functionToGraph :: [a] -> (a -> a) -> [(a,a)] +functionToGraph args f = map (\x -> (x, f x)) args +-- functionToGraph args f = map swap $ attachKey f args + + +showTriplet :: (Show a, Show b, Show c) => (a,b,c) -> String +showTriplet (x,y,z) = unwords [show x, show y, show z] + + +commaConcat, semiColonConcat :: [String] -> String +commaConcat = concat . intersperse ", " +semiColonConcat = concat . intersperse "; " + + +quote :: String -> String +quote str = "\"" ++ str ++ "\"" + + + + +mapFst :: (a -> c) -> (a,b) -> (c,b) +mapFst f ~(a,b) = (f a, b) + +mapSnd :: (b -> c) -> (a,b) -> (a,c) +mapSnd f ~(a,b) = (a, f b)