Merge pull request #539 from sumitsahrawat/plotting-example

WIP: Plotting example

ihaskell-display/ihaskell-widgets/Examples/Plotting UI.ipynb

+{
+ "cells": [
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
+    "## A complete plotting example\n",
+    "\n",
+    "This example is inspired from the [plot-gtk-ui](https://github.com/sumitsahrawat/plot-gtk-ui) package. Our goal will be to create an interface similar to the screenshot below.\n",
+    "\n",
+    "![Screenshot](https://raw.githubusercontent.com/sumitsahrawat/plot-gtk-ui/master/screenshots/sinax.png)"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 1,
+   "metadata": {
+    "collapsed": true
+   },
+   "outputs": [],
+   "source": [
+    "{-# LANGUAGE OverloadedStrings #-}\n",
+    "import IHaskell.Display.Widgets"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
+    "First, we create a common structure that will hold all the information required to create a plot. This has to be done first so that we can hook widget events to modify it. The plotting logic is implemented next for the same reason."
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 2,
+   "metadata": {
+    "collapsed": false
+   },
+   "outputs": [],
+   "source": [
+    "import Data.IORef\n",
+    "import Data.Monoid (mempty)\n",
+    "import Data.Text (Text)\n",
+    "import qualified Data.Map as M\n",
+    "\n",
+    "data PlotInfo = PlotInfo {\n",
+    "    plotTitle :: String,\n",
+    "    plotTitleSize :: Double,\n",
+    "    xLabel :: String,\n",
+    "    xLabelSize :: Double,\n",
+    "    yLabel :: String,\n",
+    "    yLabelSize :: Double,\n",
+    "    showXGrid :: Bool,\n",
+    "    showYGrid :: Bool,\n",
+    "    xRange :: (Double, Double),\n",
+    "    yRange :: (Double, Double),\n",
+    "    sampling :: Double,\n",
+    "    functions :: M.Map String (Double -> Double)\n",
+    "  }\n",
+    "\n",
+    "defaultPlotInfo = PlotInfo {\n",
+    "    plotTitle = mempty,\n",
+    "    plotTitleSize = 10,\n",
+    "    xLabel = mempty,\n",
+    "    xLabelSize = 10,\n",
+    "    yLabel = mempty,\n",
+    "    yLabelSize = 10,\n",
+    "    showXGrid = True,\n",
+    "    showYGrid = True,\n",
+    "    xRange = (-5, 5),\n",
+    "    yRange = (-5, 5),\n",
+    "    sampling = 50,\n",
+    "    functions = mempty\n",
+    "  }"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
+    "Now, we implement the plotting logic. We also create an `ImageWidget` here, which will be used to display the plot."
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 3,
+   "metadata": {
+    "collapsed": false
+   },
+   "outputs": [
+    {
+     "data": {
+      "text/plain": []
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "import Data.IORef\n",
+    "import Graphics.Rendering.Chart.Easy hiding (tan)\n",
+    "import Graphics.Rendering.Chart.Backend.Cairo\n",
+    "import qualified Data.ByteString as B\n",
+    "import IHaskell.Display (base64)\n",
+    "import Control.Applicative ((<$>))\n",
+    "\n",
+    "tempImgWidget <- mkImageWidget\n",
+    "\n",
+    "setField tempImgWidget Width 400\n",
+    "setField tempImgWidget Height 400\n",
+    "\n",
+    "plotState <- newIORef defaultPlotInfo\n",
+    "\n",
+    "-- Update and redraw.\n",
+    "update :: (PlotInfo -> IO PlotInfo) -> IO ()\n",
+    "update modifier = readIORef plotState >>= modifier >>= writeIORef plotState >> redraw\n",
+    "\n",
+    "redraw :: IO ()\n",
+    "redraw = readIORef plotState >>= mkPlot >>= setField tempImgWidget B64Value . base64\n",
+    "\n",
+    "mkDset :: PlotInfo -> [(String, [(Double, Double)])]\n",
+    "mkDset info = let funcs = M.toList $ functions info\n",
+    "                  (xLow, xHigh) = xRange info\n",
+    "                  period = 1 / sampling info\n",
+    "                  xs = [xLow, xLow + period .. xHigh]\n",
+    "              in map (\\(s, f) -> (s, zip xs $ map f xs)) funcs\n",
+    "\n",
+    "axisSetter :: Bool -> Bool -> AxisData t -> AxisData t\n",
+    "axisSetter axis grid ad =\n",
+    "  ad { _axis_grid = if grid then _axis_grid ad else []\n",
+    "     , _axis_visibility = if axis\n",
+    "                          then AxisVisibility True True True\n",
+    "                          else AxisVisibility False False False\n",
+    "     }\n",
+    "\n",
+    "mkPlot :: PlotInfo -> IO B.ByteString\n",
+    "mkPlot info = do\n",
+    "  let dset = mkDset info\n",
+    "      opts = def { _fo_size = (400, 400) }\n",
+    "  toFile opts \".chart\" $ do\n",
+    "    layout_title .= plotTitle info\n",
+    "    layout_title_style . font_size .= plotTitleSize info\n",
+    "    layout_x_axis . laxis_title .= xLabel info\n",
+    "    layout_x_axis . laxis_title_style . font_size .= xLabelSize info\n",
+    "    layout_x_axis . laxis_generate .= scaledAxis def (xRange info)\n",
+    "    layout_x_axis . laxis_override .= if showXGrid info then id else axisGridHide\n",
+    "    layout_y_axis . laxis_title .= yLabel info\n",
+    "    layout_y_axis . laxis_title_style . font_size .= yLabelSize info\n",
+    "    layout_y_axis . laxis_generate .= scaledAxis def (yRange info)\n",
+    "    layout_y_axis . laxis_override .= if showYGrid info then id else axisGridHide\n",
+    "\n",
+    "    mapM_ (\\(s, ps) -> plot (line s [ps])) dset\n",
+    "  B.readFile \".chart\""
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
+    "All that's left now is to create an interface and hook widget events accordingly.\n",
+    "\n",
+    "The first required element is a box, to create a vertical division between the plotting region and the input widgets."
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 4,
+   "metadata": {
+    "collapsed": false
+   },
+   "outputs": [
+    {
+     "data": {
+      "text/plain": []
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "divBox <- mkFlexBox\n",
+    "setField divBox Orientation HorizontalOrientation\n",
+    "\n",
+    "-- Two parts: A FlexBox for the left part (plot + sliders) and an Accordion for the input elements.\n",
+    "plBox <- mkFlexBox\n",
+    "tlBox <- mkAccordion\n",
+    "\n",
+    "-- Add the widgets to the main dividing box.\n",
+    "setField divBox Children [ChildWidget plBox, ChildWidget tlBox]\n",
+    "\n",
+    "-- Make the orientation Vertical\n",
+    "setField plBox Orientation VerticalOrientation"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
+    "Now we fill in the plotting area with:\n",
+    "\n",
+    "+ A `FlexBox` to hold the sliders.\n",
+    "+ An `ImageWidget` to hold the plot."
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 5,
+   "metadata": {
+    "collapsed": false,
+    "scrolled": true
+   },
+   "outputs": [
+    {
+     "data": {
+      "text/plain": []
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "slBox <- mkFlexBox\n",
+    "\n",
+    "-- Reusing the image widget created before\n",
+    "let plImg = tempImgWidget\n",
+    "\n",
+    "-- Sliders need to be laid out vertically.\n",
+    "setField slBox Orientation VerticalOrientation\n",
+    "\n",
+    "-- Add widgets to the plotting region.\n",
+    "setField plBox Children [ChildWidget slBox, ChildWidget plImg]"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
+    "Now, we fill the other half with the following:\n",
+    "\n",
+    "+ Four `FlexBox` widgets (title, sub-title, x-label, y-label), containing a `TextWidget` for title and a `BoundedFloatText` for the font size.\n",
+    "+ A `FlexBox` with two selection widgets for toggling visibility for different elements. We'll go with `ToggleButton` just for fun.\n",
+    "+ Two more `FlexBox`, with `FloatText` widgets for deciding the plot range."
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 6,
+   "metadata": {
+    "collapsed": false
+   },
+   "outputs": [
+    {
+     "data": {
+      "text/plain": []
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "-- The four FlexBox widgets.\n",
+    "import Control.Monad (replicateM, forM_)\n",
+    "import Data.List (zip4)\n",
+    "import Text.Printf (printf)\n",
+    "import Data.Text (unpack, pack)\n",
+    "\n",
+    "-- pl : plotTitle\n",
+    "-- x : xLabel\n",
+    "-- y : yLabel\n",
+    "boxes <- replicateM 3 mkFlexBox\n",
+    "texts@[plTxt,xTxt,yTxt] <- replicateM 3 mkTextWidget\n",
+    "inpts@[plInp,xInp,yInp] <- replicateM 3 mkBoundedFloatText\n",
+    "\n",
+    "-- Adding event handlers for text widgets. This is a clumsy way to emulate first-class record fields.\n",
+    "let setHandler widget field = setField widget ChangeHandler $ update $ \\info -> do\n",
+    "      newStr <- getField widget StringValue\n",
+    "      return $ field info newStr\n",
+    " in do\n",
+    "   setHandler plTxt $ \\struct val -> struct { plotTitle = unpack val }\n",
+    "   setHandler xTxt $ \\struct val -> struct { xLabel = unpack val }\n",
+    "   setHandler yTxt $ \\struct val -> struct { yLabel = unpack val }\n",
+    "\n",
+    "-- Adding events for the numeric input widgets.\n",
+    "let setHandler widget field = setField widget ChangeHandler $ update $ \\info -> do\n",
+    "      newNum <- getField widget FloatValue\n",
+    "      return $ field info newNum\n",
+    " in do\n",
+    "   setHandler plInp $ \\struct val -> struct { plotTitleSize = val }\n",
+    "   setHandler xInp $ \\struct val -> struct { xLabelSize = val }\n",
+    "   setHandler yInp $ \\struct val -> struct { yLabelSize = val }\n",
+    "\n",
+    "let boxInfo = zip4 boxes texts inpts [\"plot title\", \"X-Label\", \"Y-Label\"]\n",
+    "\n",
+    "forM_ boxInfo $ \\(box,text,input,placeholder) -> do\n",
+    "  setField box Orientation HorizontalOrientation\n",
+    "  setField box Children [ChildWidget text, ChildWidget input]\n",
+    "  setField text Placeholder $ pack $ printf \"Enter %s here ...\" placeholder\n",
+    "  setField input MinFloat 1\n",
+    "  setField input MaxFloat 72\n",
+    "  setField input FloatValue 10"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 7,
+   "metadata": {
+    "collapsed": false
+   },
+   "outputs": [
+    {
+     "data": {
+      "text/plain": []
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "-- A FlexBox with ToggleButtons\n",
+    "buttonBox <- mkFlexBox\n",
+    "setField buttonBox Orientation HorizontalOrientation\n",
+    "tButtons@[xGrid,yGrid] <- replicateM 2 mkToggleButton\n",
+    "\n",
+    "let tgButtonInfo = zip tButtons [\"X-Grid\", \"Y-Grid\"]\n",
+    "\n",
+    "let setHandler widget fieldSetter = setField widget ChangeHandler $ update $ \\info -> do\n",
+    "      newStr <- getField widget BoolValue\n",
+    "      return $ fieldSetter info newStr\n",
+    " in do\n",
+    "   setHandler xGrid $ \\struct val -> struct { showXGrid = val }\n",
+    "   setHandler yGrid $ \\struct val -> struct { showYGrid = val }\n",
+    "\n",
+    "forM_ tgButtonInfo $ \\(widget, description) -> do\n",
+    "  setField widget Description description\n",
+    "  setField widget BoolValue True\n",
+    "\n",
+    "setField buttonBox Children (map ChildWidget tButtons)"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 8,
+   "metadata": {
+    "collapsed": false
+   },
+   "outputs": [
+    {
+     "data": {
+      "text/plain": []
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "import Control.Arrow (first, second)\n",
+    "\n",
+    "-- Finally, the ranges\n",
+    "rangeBoxes <- replicateM 2 mkFlexBox\n",
+    "fTxts@[xLow,xHigh,yLow,yHigh] <- replicateM 4 mkFloatText\n",
+    "\n",
+    "let rangeInfo = zip rangeBoxes [(xLow,xHigh), (yLow, yHigh)]\n",
+    "\n",
+    "forM_ rangeInfo $ \\(box, (lowTxt, highTxt)) -> do\n",
+    "  setField box Orientation HorizontalOrientation\n",
+    "  setField box Children (map ChildWidget [lowTxt, highTxt])\n",
+    "\n",
+    "let setHandler widget modifier = setField widget ChangeHandler $ update $ \\info -> do\n",
+    "      val <- getField widget FloatValue\n",
+    "      return $ modifier val info\n",
+    " in do\n",
+    "   setHandler xLow $ \\v p -> p { xRange = first (const v) (xRange p) }\n",
+    "   setHandler xHigh $ \\v p -> p { xRange = second (const v) (xRange p) }\n",
+    "   setHandler yLow $ \\v p -> p { yRange = first (const v) (yRange p) }\n",
+    "   setHandler yHigh $ \\v p -> p { yRange = second (const v) (yRange p) }"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
+    "Now, to finally add these widgets to the right part of the window."
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 9,
+   "metadata": {
+    "collapsed": false
+   },
+   "outputs": [
+    {
+     "data": {
+      "text/plain": []
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "setField tlBox Children $ map ChildWidget $ boxes ++ [buttonBox] ++ rangeBoxes"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
+    "We also need to give a title to each page in the `Accordion` widget."
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 10,
+   "metadata": {
+    "collapsed": false
+   },
+   "outputs": [
+    {
+     "data": {
+      "text/plain": []
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "setField tlBox Titles [\"Plot title\", \"X-Label\", \"Y-Label\", \"Grid\", \"X-range\", \"Y-range\"]"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
+    "Then we sync the initial values from the `plotData` to the widgets."
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 11,
+   "metadata": {
+    "collapsed": false
+   },
+   "outputs": [
+    {
+     "data": {
+      "text/plain": []
+     },
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "let syncVal widget value fieldGetter = readIORef plotState >>= setField widget value . fieldGetter\n",
+    " in do\n",
+    "   syncVal plTxt StringValue (pack . plotTitle)\n",
+    "   syncVal plInp FloatValue plotTitleSize\n",
+    "\n",
+    "   syncVal xTxt StringValue (pack . xLabel)\n",
+    "   syncVal xInp FloatValue xLabelSize\n",
+    "   syncVal yTxt StringValue (pack . yLabel)\n",
+    "   syncVal yInp FloatValue yLabelSize\n",
+    "\n",
+    "   syncVal xGrid BoolValue showXGrid\n",
+    "   syncVal yGrid BoolValue showYGrid\n",
+    "\n",
+    "   syncVal xLow FloatValue (fst . xRange)\n",
+    "   syncVal xHigh FloatValue (snd . xRange)\n",
+    "   syncVal yLow FloatValue (fst . yRange)\n",
+    "   syncVal yHigh FloatValue (snd . yRange)"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
+    "Now that everything is set, we also need to provide a way for the user to add or remove plots from the interface."
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 12,
+   "metadata": {
+    "collapsed": false
+   },
+   "outputs": [],
+   "source": [
+    "addFunction :: String -> (Double -> Double) -> IO ()\n",
+    "addFunction name func = update $ \\p -> return p { functions = M.insert name func $ functions p }\n",
+    "\n",
+    "removeFunction :: String -> IO ()\n",
+    "removeFunction name = update $ \\p -> return p { functions = M.delete name $ functions p }"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
+    "And now we display the complete interface, ready to use."
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 13,
+   "metadata": {
+    "collapsed": false
+   },
+   "outputs": [
+    {
+     "data": {},
+     "metadata": {},
+     "output_type": "display_data"
+    },
+    {
+     "data": {},
+     "metadata": {},
+     "output_type": "display_data"
+    }
+   ],
+   "source": [
+    "-- Spurious update to display empty plot instead of empty image initially\n",
+    "update return\n",
+    "\n",
+    "divBox"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "metadata": {},
+   "source": [
+    "Now, we can use `addFunction` and `removeFunction` to add and remove functions respectively."
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 14,
+   "metadata": {
+    "collapsed": true
+   },
+   "outputs": [],
+   "source": [
+    "addFunction \"sin\" sin"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 15,
+   "metadata": {
+    "collapsed": false
+   },
+   "outputs": [],
+   "source": [
+    "addFunction \"cos\" cos"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": 16,
+   "metadata": {
+    "collapsed": true
+   },
+   "outputs": [],
+   "source": [
+    "addFunction \"x^2\" (\\x -> x * x)"
+   ]
+  }
+ ],
+ "metadata": {
+  "kernelspec": {
+   "display_name": "Haskell",
+   "language": "haskell",
+   "name": "haskell"
+  }
+ },
+ "nbformat": 4,
+ "nbformat_minor": 0
+}