{ "metadata": { "language": "haskell", "name": "" }, "nbformat": 3, "nbformat_minor": 0, "worksheets": [ { "cells": [ { "cell_type": "markdown", "metadata": {}, "source": [ "# Multiple plots with Rlang-QQ\n", "An example of `Rlang-QQ-0.1.1`, which supports multiple figures.\n", "\n", "First a pile of imports needed:" ] }, { "cell_type": "code", "collapsed": false, "input": [ ":set -XQuasiQuotes -XTupleSections\n", "import RlangQQ\n", "import System.Directory\n", "import System.FilePath\n", "import Data.Maybe\n", "import Data.List\n", "import Text.Read\n", "import qualified Data.ByteString as B\n", "import qualified Data.ByteString.Char8 as Char\n", "import qualified Data.ByteString.Base64 as Base64\n", "import IHaskell.Display\n", "import IHaskell.Display.Blaze () -- to confirm it's installed\n", "import qualified Text.Blaze.Html5 as H\n", "import qualified Text.Blaze.Html5.Attributes as H\n", "import Data.Monoid\n", "import Data.Char\n", "import Control.Monad\n", "import Data.Ord\n", "import Data.List.Split\n", "import Text.XFormat.Show hiding ((<>))" ], "language": "python", "metadata": {}, "outputs": [], "prompt_number": 1 }, { "cell_type": "markdown", "metadata": {}, "source": [ "Rlang-QQ saves intermediate files into `Rtmp/`.\n", "Figures from the first `[r| quasi quote |]` go into\n", "`Rtmp/fig1`. Figures from the next one go into `Rtmp/fig2`.\n", "\n", "So, taking a look at the filesystem from the notebook allows\n", "finding out which plots should be loaded." ] }, { "cell_type": "code", "collapsed": false, "input": [ "chunksWithPlots :: IO [Int]\n", "chunksWithPlots = do\n", " fs <- mapMaybe (readMaybe <=< stripPrefix \"fig\" . takeBaseName)\n", " <$> getDirectoryContents \"Rtmp\"\n", " fs' <- forM fs $ \\f-> fmap (,f) (getModificationTime (\"Rtmp/fig\"++show f))\n", " return $ map snd $ sortBy (flip (comparing fst)) fs'\n", "\n", "\n", "getPlotNames :: IO [String]\n", "getPlotNames = do\n", " ns <- chunksWithPlots\n", " case ns of\n", " [] -> return []\n", " n : _ -> \n", " map (\\t -> \"Rtmp/fig\"++show n t) . filter (`notElem` [\"..\",\".\"])\n", " <$> getDirectoryContents (showf (\"Rtmp/fig\"%Int) n)\n", " \n", "getCaptions :: IO [String]\n", "getCaptions = do\n", " n : _ <- chunksWithPlots\n", "\n", " f <- readFile (showf (\"Rtmp/raw\"%Int%\".md\") n)\n", " let end s = case splitOn \"](\" s of\n", " a:_ -> Just a\n", " _ -> Nothing\n", " isBoring s = maybe False (all isDigit)\n", " (stripPrefix \"plot of chunk unnamed-chunk-\" s)\n", " return $ \n", " map (\\x -> if isBoring x then \"\" else x) $\n", " mapMaybe (end <=< stripPrefix \"![\") (lines f)\n", "\n", "rPlots :: IO [DisplayData]\n", "rPlots = do\n", " ns <- getPlotNames\n", " cs <- getCaptions\n", " imgs <- forM (ns `zip` cs) $ \\(n,c) -> do\n", " e <- Base64.encode <$> B.readFile n\n", " return $ H.img H.! H.src (H.unsafeByteStringValue\n", " (Char.pack \"data:image/png;base64,\" <> e))\n", " <> if null c then mempty\n", " else H.p (H.toMarkup c)\n", " display (mconcat imgs)" ], "language": "python", "metadata": {}, "outputs": [], "prompt_number": 2 }, { "cell_type": "code", "collapsed": false, "input": [ "[r| plot(1:10)\n", " plot(sin(1:10), type='l') |]\n", "getPlotNames\n", "rPlots" ], "language": "python", "metadata": {}, "outputs": [ { "metadata": {}, "output_type": "display_data", "text": [ "[\"Rtmp/fig1/unnamed-chunk-11.png\",\"Rtmp/fig1/unnamed-chunk-12.png\"]" ] }, { "html": [ "\n", "\n" ], "metadata": {}, "output_type": "display_data", "text": [ "\n", "" ] } ], "prompt_number": 3 }, { "cell_type": "markdown", "metadata": {}, "source": [ "The obligatory Fibonacci" ] }, { "cell_type": "code", "collapsed": false, "input": [ "fibs = 0:1: zipWith (+) fibs (drop 1 fibs)\n", "\n", "[r| plot(1:20, $(take 20 $ map fromIntegral fibs :: [Double]),\n", " main='rabbit population',\n", " ylab='', xlab='') |]\n", "rPlots" ], "language": "python", "metadata": {}, "outputs": [ { "html": [ "\n" ], "metadata": {}, "output_type": "display_data", "text": [ "" ] } ], "prompt_number": 4 }, { "cell_type": "code", "collapsed": false, "input": [ ":! $PWD" ], "language": "python", "metadata": {}, "outputs": [ { "html": [ "/bin/sh: 1: /home/aavogt: Permission denied\n", "Process exited with error code 126" ], "metadata": {}, "output_type": "display_data", "text": [ "/bin/sh: 1: /home/aavogt: Permission denied\n", "\n", "Process exited with error code 126" ] } ], "prompt_number": 6 }, { "cell_type": "code", "collapsed": false, "input": [], "language": "python", "metadata": {}, "outputs": [] } ], "metadata": {} } ] }