plot-lab 0.0.1.8 → 0.0.1.9
raw patch · 6 files changed
+158/−122 lines, 6 filesdep +vector
Dependencies added: vector
Files
- README.md +26/−10
- plot-lab.cabal +5/−4
- src/Main.hs +2/−1
- src/PlotLab/Events.hs +61/−51
- src/PlotLab/FigureSettings.hs +6/−2
- src/PlotLab/Main.hs +58/−54
README.md view
@@ -4,22 +4,38 @@ An ambitious attempt to provide mathematica like dynamic plotting for free. -* Written in haskell+* Written in haskell. * Based on plot ([hackage](http://hackage.haskell.org/package/plot)) ([github](https://github.com/amcphail/plot)).-* GUI written using gtk2hs (using [gtk3](http://hackage.haskell.org/package/gtk3) package)-* GUI designed using glade+* GUI written using gtk2hs (using [gtk](http://hackage.haskell.org/package/gtk)).+* GUI designed using glade.+* Also available at [hackage](http://hackage.haskell.org/package/plot-lab). ## Installation - ```- $ cabal install plot-lab- ```+### Linux -Manual installations can be done using the package from [hackage](http://hackage.haskell.org/package/plot-lab)+The installation for gtk requires that [gtk2hs-buildtools](https://hackage.haskell.org/package/gtk2hs-buildtools) be installed, and the binary be in your $PATH.+The below commands take care of that, without permanently changing the $PATH. +```+$ cabal update+$ cabal install gtk2hs-buildtools+$ env PATH="~/.cabal/bin:$PATH" cabal install plot-lab+```++### Windows++* Install gtk2hs with instructions from [here](http://projects.haskell.org/gtk2hs/download/#Windows).++* Then use cabal to install plot-lab.++```batch+cmd> cabal install plot-lab+```+ ## Usage -The window displays the sum of two gaussian distributions with sliders for mean and std. deviation-The plan is to add custom function input facilities and make it more interactive+The window displays the sum of two gaussian distributions with sliders for mean and std. deviation.+The plan is to add custom function input facilities and make it more interactive. -The package is too raw to be used with custom functions right now. Those with haskell knowledge might be able to make changes and get what they want+The package is too raw to be used with custom functions right now. Those with haskell knowledge might be able to make changes and get what they want.
plot-lab.cabal view
@@ -1,11 +1,11 @@ Name: plot-lab-Version: 0.0.1.8+Version: 0.0.1.9 License: GPL-2 License-file: LICENSE Author: Sumit Sahrawat-Maintainer: sumit.sahrawat.apm13 <at> iitbhu <dot> ac <dot> in+Maintainer: sumit.sahrawat.apm13@iitbhu.ac.in Stability: experimental-Homepage: github.com/sumitsahrawat/plot-lab+Homepage: https://github.com/sumitsahrawat/plot-lab Synopsis: A plotting tool with Mathematica like Manipulation abilities Description: Mathematica has a nice plotting feature that allows for plotting of functions that depend on more than one variable, and then allows changing the value@@ -31,6 +31,7 @@ , gtk >=0.13 && <0.14 , hmatrix >=0.16 && <0.17 , text >=1.2 && <1.3+ , vector >=0.10.12.2 && <0.10.13.0 hs-source-dirs: src other-modules: Paths_plot_lab@@ -38,7 +39,7 @@ , PlotLab.FigureSettings , PlotLab.Main --- ghc-options: -O2+ ghc-options: -Wall default-language: Haskell2010 source-repository head
src/Main.hs view
@@ -1,8 +1,9 @@ module Main where +import Paths_plot_lab (getDataFileName) import qualified PlotLab.Main-import Paths_plot_lab (getDataFileName) +main :: IO () main = do mainGlade <- getDataFileName "main-window.glade" plotGlade <- getDataFileName "plot-window.glade"
src/PlotLab/Events.hs view
@@ -1,95 +1,106 @@ module PlotLab.Events (attachHandlers) where -import PlotLab.FigureSettings+import PlotLab.FigureSettings -import Data.Maybe (fromJust)-import Data.Colour.Names-import Graphics.Rendering.Plot-import Graphics.UI.Gtk hiding(Circle,Cross)-import Data.Text (pack, unpack)-import Numeric.LinearAlgebra (linspace)-import Data.IORef (IORef, newIORef, readIORef, modifyIORef)-import Data.Char (toLower)+import Data.Char (toLower)+import Data.Colour.Names+import Data.IORef (IORef, modifyIORef, readIORef)+import Data.Maybe (fromJust)+import Data.Text (unpack)+import Data.Vector.Storable (Vector)+import Graphics.Rendering.Plot+import Graphics.UI.Gtk hiding (Circle, Color, Cross)+import Numeric.LinearAlgebra (linspace) +attachHandlers :: (Ordinate a, ComboBoxClass self) =>+ Builder+ -> IORef FigureSettings+ -> [Adjustment]+ -> (DrawingArea ->+ IORef FigureSettings -> [Adjustment] -> IO ())+ -> ([Double] -> a)+ -> ((Vector Double, [FormattedSeries])+ -> FigureSettings -> Figure ())+ -> self+ -> IO (ConnectId Button) attachHandlers builder iofset adjs updateCanvas g buildFigure combo = do -- Canvas canvas <- builderGetObject builder castToDrawingArea "Plotting Canvas" let redraw = updateCanvas canvas iofset adjs- onExpose canvas $ \_ -> redraw >> return False+ _ <- onExpose canvas $ \_ -> redraw >> return False -- Adjustments for parameter sliders- mapM_ (\x -> onValueChanged x redraw) adjs+ mapM_ (`onValueChanged` redraw) adjs -- Plot-Title Entry titleEntry <- builderGetObject builder castToEntry "Plot Title Entry"- onEntryActivate titleEntry $ do+ _ <- onEntryActivate titleEntry $ do titleNew <- entryGetText titleEntry modifyIORef iofset $ \f -> f { plotTitle = Just titleNew } redraw -- Plot-Title Font Size titleSize <- builderGetObject builder castToAdjustment "Title Font Size"- onValueChanged titleSize $ do+ _ <- onValueChanged titleSize $ do size <- adjustmentGetValue titleSize modifyIORef iofset $ \f -> f { plotTitleSize = size } redraw -- Subtitle Entry subEntry <- builderGetObject builder castToEntry "Subtitle Entry"- onEntryActivate subEntry $ do+ _ <- onEntryActivate subEntry $ do titleNew <- entryGetText subEntry modifyIORef iofset $ \f -> f { subTitle = Just titleNew } redraw -- Subtitle Font Size subSize <- builderGetObject builder castToAdjustment "Subtitle Font Size"- onValueChanged subSize $ do+ _ <- onValueChanged subSize $ do size <- adjustmentGetValue subSize modifyIORef iofset $ \f -> f { subTitleSize = size } redraw -- Show X-Axis CheckButton showX <- builderGetObject builder castToCheckButton "X-Axis Check"- onToggled showX $ do+ _ <- onToggled showX $ do state <- toggleButtonGetActive showX- fset <- readIORef iofset modifyIORef iofset- (\f -> f { showXAxis = if state then True else False })+ (\f -> f { showXAxis = state }) redraw -- Show Y-Axis CheckButton showY <- builderGetObject builder castToCheckButton "Y-Axis Check"- onToggled showY $ do+ _ <- onToggled showY $ do state <- toggleButtonGetActive showY- fset <- readIORef iofset modifyIORef iofset- (\f -> f { showYAxis = if state then True else False })+ (\f -> f { showYAxis = state }) redraw + let adjustmentPairValues (a1, a2) = do v1 <- adjustmentGetValue a1+ v2 <- adjustmentGetValue a2+ return (v1, v2) -- X-Axis Range xLower <- builderGetObject builder castToAdjustment "X-Lower" xUpper <- builderGetObject builder castToAdjustment "X-Upper" let updateX x = onValueChanged x $ do- xl <- adjustmentGetValue xLower- xu <- adjustmentGetValue xUpper+ (xl, xu) <- adjustmentPairValues (xLower, xUpper) modifyIORef iofset $ \f -> f { xRange = Just (xl, xu) } redraw in mapM_ updateX [xLower, xUpper] -- X-Range Auto-determination CheckBox- rangeEntries <- builderGetObject builder castToHBox "X-Range Entries"+ xRangeEntries <- builderGetObject builder castToHBox "X-Range Entries" autoXCheck <- builderGetObject builder castToCheckButton "X-Range Check"- onToggled autoXCheck $ do+ _ <- onToggled autoXCheck $ do state <- toggleButtonGetActive autoXCheck if state then error "Invalid xRange" -- do modifyIORef iofset $ \f -> f { xRange = Nothing }- -- widgetHideAll rangeEntries+ -- widgetHideAll xRangeEntries else do lower <- builderGetObject builder castToAdjustment "X-Lower" upper <- builderGetObject builder castToAdjustment "X-Upper"- l <- adjustmentGetValue lower- u <- adjustmentGetValue upper- widgetShowAll rangeEntries+ (l, u) <- adjustmentPairValues (lower, upper)+ widgetShowAll xRangeEntries modifyIORef iofset $ \f -> f { xRange = Just (l, u) } redraw @@ -97,58 +108,56 @@ yLower <- builderGetObject builder castToAdjustment "Y-Lower" yUpper <- builderGetObject builder castToAdjustment "Y-Upper" let updateY y = onValueChanged y $ do- yl <- adjustmentGetValue yLower- yu <- adjustmentGetValue yUpper+ (yl, yu) <- adjustmentPairValues (yLower, yUpper) modifyIORef iofset $ \f -> f { yRange = Just (yl, yu) } redraw in mapM_ updateY [yLower, yUpper] -- Y-Range Auto-determination CheckBox- rangeEntries <- builderGetObject builder castToHBox "Y-Range Entries"+ yRangeEntries <- builderGetObject builder castToHBox "Y-Range Entries" autoYCheck <- builderGetObject builder castToCheckButton "Y-Range Check"- onToggled autoYCheck $ do+ _ <- onToggled autoYCheck $ do state <- toggleButtonGetActive autoYCheck if state then do modifyIORef iofset $ \f -> f { yRange = Nothing }- widgetHideAll rangeEntries+ widgetHideAll yRangeEntries else do lower <- builderGetObject builder castToAdjustment "Y-Lower" upper <- builderGetObject builder castToAdjustment "Y-Upper"- l <- adjustmentGetValue lower- u <- adjustmentGetValue upper- widgetShowAll rangeEntries+ (l, u) <- adjustmentPairValues (lower, upper)+ widgetShowAll yRangeEntries modifyIORef iofset $ \f -> f { yRange = Just (l, u) } redraw -- Sampling Rate sampleRate <- builderGetObject builder castToAdjustment "Sampling Adj"- onValueChanged sampleRate $ do+ _ <- onValueChanged sampleRate $ do rate <- adjustmentGetValue sampleRate modifyIORef iofset $ \f -> f { samplingRate = floor rate } redraw -- X-Label Entry xLabelEntry <- builderGetObject builder castToEntry "X-Label Entry"- onEntryActivate xLabelEntry $ do- labelNew <- entryGetText xLabelEntry- modifyIORef iofset $ \f -> f { xLabel = Just labelNew }+ _ <- onEntryActivate xLabelEntry $ do+ label' <- entryGetText xLabelEntry+ modifyIORef iofset $ \f -> f { xLabel = Just label' } redraw -- X-Label Size xlSize <- builderGetObject builder castToAdjustment "X-Label Size"- onValueChanged xlSize $ do+ _ <- onValueChanged xlSize $ do size <- adjustmentGetValue xlSize modifyIORef iofset $ \f -> f { xLabelSize = size } redraw -- Y-Label Entry yLabelEntry <- builderGetObject builder castToEntry "Y-Label Entry"- onEntryActivate yLabelEntry $ do- labelNew <- entryGetText yLabelEntry- modifyIORef iofset $ \f -> f { yLabel = Just labelNew }+ _ <- onEntryActivate yLabelEntry $ do+ label' <- entryGetText yLabelEntry+ modifyIORef iofset $ \f -> f { yLabel = Just label' } redraw ylSize <- builderGetObject builder castToAdjustment "Y-Label Size"- onValueChanged ylSize $ do+ _ <- onValueChanged ylSize $ do size <- adjustmentGetValue ylSize modifyIORef iofset $ \f -> f { yLabelSize = size } redraw@@ -171,7 +180,8 @@ samples = (\(x, y) -> rate * floor (y - x)) (fromJust $ xRange fset) domain = linspace samples (fromJust $ xRange fset) f = g vars- dset = (domain, [line f blue])+ colour = blue :: Color+ dset = (domain, [line f colour]) dimensions = exportSize fset parseType txt = case txt of@@ -179,10 +189,10 @@ "SVG" -> SVG "PS" -> PS "PDF" -> PDF+ _ -> error "Invalid FileType!" - filetype = let ftype = if comboText == Nothing- then error "Invalid FileType!"- else unpack $ fromJust comboText++ filetype = let ftype = maybe (error "Invalid FileType!") unpack comboText in parseType ftype parseExt fileType = case fileType of@@ -191,5 +201,5 @@ PS -> "PS" PDF -> "PDF" - filename = nameText ++ "." ++ (map toLower $ parseExt filetype)+ filename = nameText ++ "." ++ map toLower (parseExt filetype) writeFigure filetype filename dimensions $ buildFigure dset fset
src/PlotLab/FigureSettings.hs view
@@ -1,6 +1,9 @@-module PlotLab.FigureSettings (FigureSettings(..), defaultSettings) where+module PlotLab.FigureSettings+ ( FigureSettings (..)+ , defaultSettings+ ) where -import Graphics.Rendering.Plot+import Graphics.Rendering.Plot data FigureSettings = FigureSettings@@ -26,6 +29,7 @@ , fileName :: String } +defaultSettings :: FigureSettings defaultSettings = FigureSettings { fontFamily = "Sans" , plotTitle = Nothing
src/PlotLab/Main.hs view
@@ -1,16 +1,17 @@ module PlotLab.Main (main) where -import Control.Monad (when)-import Data.Maybe (fromJust)-import Data.Colour.Names-import Graphics.Rendering.Plot-import Graphics.UI.Gtk hiding(Circle,Cross)-import Data.IORef (IORef, newIORef, readIORef, modifyIORef)-import Numeric.LinearAlgebra (linspace)-import Data.Text (pack, unpack)+import PlotLab.Events (attachHandlers)+import PlotLab.FigureSettings -import PlotLab.Events (attachHandlers)-import PlotLab.FigureSettings+import Control.Monad (when)+import Data.Colour.Names+import Data.IORef (IORef, modifyIORef, newIORef,+ readIORef)+import Data.Maybe (fromJust)+import Data.Text (pack)+import Graphics.Rendering.Plot+import Graphics.UI.Gtk hiding (Circle, Color, Cross, Scale)+import Numeric.LinearAlgebra (linspace) -- import Control.Concurrent -- import Control.Concurrent.MVar@@ -37,10 +38,12 @@ -------------------------------------------------------------------------------- -updateAxis axis show location range scale label size = do+updateAxis :: AxisType -> Bool -> (AxisPosn, AxisSide) -> Maybe (Double, Double)+ -> Scale -> Maybe String -> FontSize -> Plot ()+updateAxis axis state location range scale label size = do let (position, side) = location - when show $ addAxis axis position+ when state $ addAxis axis position (when (label /= Nothing) $ withAxisLabel $ do setText $ fromJust label setFontSize size) if range == Nothing@@ -53,35 +56,35 @@ buildFigure dset fset = do withTextDefaults $ setFontFamily (fontFamily fset) - let title = plotTitle fset- size = plotTitleSize fset- in updateFigureText withTitle title size+ let str = plotTitle fset+ size = plotTitleSize fset+ in updateFigureText withTitle str size - let title = subTitle fset- size = subTitleSize fset- in updateFigureText withSubTitle title size+ let str = subTitle fset+ size = subTitleSize fset+ in updateFigureText withSubTitle str size setPlots 1 1 withPlot (1, 1) $ do setDataset dset -- X-Axis- let show = showXAxis fset- text = xLabel fset+ let state = showXAxis fset+ label = xLabel fset size = xLabelSize fset loc = xLocation fset range = xRange fset scale = plotScaleX fset- in updateAxis XAxis show loc range scale text size+ in updateAxis XAxis state loc range scale label size -- Y-Axis- let show = showYAxis fset- text = yLabel fset+ let state = showYAxis fset+ label = yLabel fset size = yLabelSize fset loc = yLocation fset range = yRange fset scale = plotScaleY fset- in updateAxis YAxis show loc range scale text size+ in updateAxis YAxis state loc range scale label size -------------------------------------------------------------------------------- @@ -92,8 +95,8 @@ addSlidersToBox :: [AdjustmentSettings] -> VBox -> IO [Adjustment] addSlidersToBox conf box = do let newAdj (a, b, c, d, e, f) = adjustmentNew a b c d e f- newAdjList conf = mapM newAdj conf- newHScaleList adjs = mapM hScaleNew adjs+ newAdjList = mapM newAdj+ newHScaleList = mapM hScaleNew adjs <- newAdjList conf sliders <- newHScaleList adjs@@ -112,14 +115,15 @@ vars <- mapM adjustmentGetValue adjs let rate = samplingRate fset- samples = (\(x, y) -> rate * floor (y - x)) (fromJust $ xRange fset)+ samples = (\(x, y) -> rate * ceiling (y - x)) (fromJust $ xRange fset) domain = linspace samples (fromJust $ xRange fset) f = g vars- dset = (domain, [line f blue])+ colour = blue :: Color+ dset = (domain, [line f colour]) r = render $ buildFigure dset fset - region <- regionRectangle $ Rectangle 0 0 w h- drawWindowBeginPaintRegion drw region+ box <- regionRectangle $ Rectangle 0 0 w h+ drawWindowBeginPaintRegion drw box renderWithDrawable drw (r s) drawWindowEndPaint drw @@ -130,7 +134,7 @@ -- Call PlotLab.Events.attachHandlers to attach Event Handlers figureWindow :: String -> IORef FigureSettings -> [AdjustmentSettings] -> ([Double] -> Double -> Double) -> IO ()-figureWindow plotGlade iofset conf g = do+figureWindow plotGlade iofset conf fun = do builder <- builderNew builderAddFromFile builder plotGlade @@ -138,10 +142,10 @@ adjs <- addSlidersToBox conf plotBox fset <- readIORef iofset - let updateEntryText entryGlade text =- when (text /= Nothing) $ do entry <- builderGetObject builder- castToEntry entryGlade- entrySetText entry $ fromJust text+ let updateEntryText entryGlade txt =+ when (txt /= Nothing) $ do entry <- builderGetObject builder+ castToEntry entryGlade+ entrySetText entry $ fromJust txt in do updateEntryText "Plot Title Entry" $ plotTitle fset updateEntryText "Subtitle Entry" $ subTitle fset updateEntryText "X-Label Entry" $ xLabel fset@@ -193,15 +197,15 @@ -- Export ComboBox combo <- comboBoxNewText- mapM (\(x, y) -> comboBoxInsertText combo x $ pack y)- [(1, "PNG"), (2, "SVG"), (3, "PS"), (4, "PDF")]+ _ <- mapM (\(x, y) -> comboBoxInsertText combo x $ pack y)+ [(1, "PNG"), (2, "SVG"), (3, "PS"), (4, "PDF")] comboBoxSetActive combo 0 comboArea <- builderGetObject builder castToHBox "File Name" boxPackEndDefaults comboArea combo -- Attach Event Handlers- attachHandlers builder iofset adjs updateCanvas g buildFigure combo+ _ <- attachHandlers builder iofset adjs updateCanvas fun buildFigure combo -- Show Widgets plotWindow <- builderGetObject builder castToWindow "Plot Window"@@ -214,8 +218,8 @@ -------------------------------------------------------------------------------- giveSettings :: FigureSettings -> IO (IORef FigureSettings)-giveSettings fst = do- ref <- newIORef fst+giveSettings fset = do+ ref <- newIORef fset modifyIORef ref $ \f -> f { plotTitle = Just "Example: Sum of two gaussian distributions"@@ -228,33 +232,33 @@ -------------------------------------------------------------------------------- -mu1 = (-5.00, -5.00, 5.00, 0.01, 0.01, 0.00)-sigma1 = ( 1.00, 0.01, 6.00, 0.01, 0.01, 0.00)-mu2 = ( 0.00, -5.00, 5.00, 0.01, 0.01, 0.00)-sigma2 = ( 1.00, 0.01, 6.00, 0.01, 0.01, 0.00)----------------------------------------------------------------------------------- -- Gaussian Distribution-h :: [Double] -> Double -> Double-h [s, m] x = exp (-((x - m) ** 2) / (2 * (s ** 2))) / (s * sqrt (2 * pi))+func :: [Double] -> Double -> Double+func [s, m] x = exp (-((x - m) ** 2) / (2 * (s ** 2))) / (s * sqrt (2 * pi))+func _ _ = error "Invalid arguments" g :: [Double] -> Double -> Double-g [a, b, c, d] x = h [a, b] x + h [c, d] x+g [a, b, c, d] x = func [a, b] x + func [c, d] x+g _ _ = error "Invalid arguments" -------------------------------------------------------------------------------- +main :: FilePath -> String -> IO () main mainGlade plotGlade = do- initGUI+ _ <- initGUI builder <- builderNew builderAddFromFile builder mainGlade mainWindow <- builderGetObject builder castToWindow "Main Window" plotButton <- builderGetObject builder castToButton "Plot Button"- onDestroy mainWindow mainQuit+ _ <- onDestroy mainWindow mainQuit widgetShowAll mainWindow settings <- giveSettings defaultSettings- onClicked plotButton $- figureWindow plotGlade settings [sigma2, mu2, sigma1, mu1] g+ _ <- onClicked plotButton $+ let mu1 = (-5.00, -5.00, 5.00, 0.01, 0.01, 0.00)+ sigma1 = ( 1.00, 0.01, 6.00, 0.01, 0.01, 0.00)+ mu2 = ( 0.00, -5.00, 5.00, 0.01, 0.01, 0.00)+ sigma2 = ( 1.00, 0.01, 6.00, 0.01, 0.01, 0.00)+ in figureWindow plotGlade settings [sigma2, mu2, sigma1, mu1] g mainGUI --------------------------------------------------------------------------------