plotlyhs (empty) → 0.1.0
raw patch · 10 files changed
+507/−0 lines, 10 filesdep +aesondep +basedep +blaze-htmlsetup-changed
Dependencies added: aeson, base, blaze-html, blaze-markup, bytestring, lucid, microlens, microlens-th, plotlyhs, text
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- TestPlotly.hs +20/−0
- changelog.md +3/−0
- plotlyhs.cabal +55/−0
- src/Graphics/Plotly.hs +254/−0
- src/Graphics/Plotly/Blaze.hs +48/−0
- src/Graphics/Plotly/Histogram.hs +30/−0
- src/Graphics/Plotly/Lucid.hs +47/−0
- src/Graphics/Plotly/Utils.hs +27/−0
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2016 Tom Nielsen++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ TestPlotly.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE OverloadedStrings #-}++import Lucid+import Lucid.Html5+import Graphics.Plotly+import Graphics.Plotly.Lucid+import Lens.Micro++import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.IO as T++main = + T.writeFile "test.html" $ renderText $ doctypehtml_ $ do+ head_ $ do meta_ [charset_ "utf-8"]+ plotlyCDN+ body_ $ toHtml $ plotly "myDiv" [myTrace] ++myTrace = scatter & x ?~ [1,2,3,4]+ & y ?~ [500,3000,700,200]+
+ changelog.md view
@@ -0,0 +1,3 @@+0.1++* Initial release
+ plotlyhs.cabal view
@@ -0,0 +1,55 @@+Name: plotlyhs+Version: 0.1.0+Synopsis: Haskell bindings to Plotly.js+Description:+ Generate web-based plots with the Plotly.js library.+ For examples, see <https://glutamate.github.io/plotlyhs/>+++License: MIT+License-file: LICENSE+Author: Tom Nielsen+Maintainer: tanielsen@gmail.com+build-type: Simple+Cabal-Version: >= 1.8+homepage: https://github.com/glutamate/plotlyhs+bug-reports: https://github.com/glutamate/plotlyhs/issues+category: Graphics, Charts+Tested-With: GHC == 7.8.4, GHC == 7.10.2, GHC == 7.10.3, GHC == 8.0.1+++extra-source-files:+ changelog.md+++Library+ ghc-options: -Wall -fno-warn-type-defaults+ ghc-prof-options: -auto-all+ hs-source-dirs: src++ Exposed-modules:+ Graphics.Plotly+ , Graphics.Plotly.Utils+ , Graphics.Plotly.Lucid+ , Graphics.Plotly.Blaze+ , Graphics.Plotly.Histogram++ Build-depends:+ base >= 4.7+ , aeson+ , lucid+ , blaze-html+ , blaze-markup+ , text+ , bytestring+ , microlens-th+ , microlens++executable test-plotly+ main-is: TestPlotly.hs+ build-depends: base >=4.6 && <5+ , plotlyhs+ , lucid+ , aeson+ , text+ , microlens
+ src/Graphics/Plotly.hs view
@@ -0,0 +1,254 @@+{-# LANGUAGE DeriveGeneric, OverloadedStrings,FlexibleInstances, TemplateHaskell #-}++{-|++This module defines datatypes that can be used to generate [Plotly.js](https://plot.ly/javascript/)+plots via their JSON values. The interface encourages the use of+lenses. Every trace on a plot is defined by a `Trace` type value, the+construction of which is the central goal of this module.++Example scatter plot of the Iris dataset:++@+import Graphics.Plotly+import Numeric.Dataset.Iris++tr :: Trace+tr = scatter & x ?~ map sepalLength iris+ & y ?~ map sepalWidth iris+ & marker ?~ (defMarker & markercolor ?~ catColors (map irisClass irisd))+ & mode ?~ [Markers]+@++Horizontal bars:++@+hbarData :: [(Text, Double)]+hbarData = [(\"Simon\", 14.5), (\"Joe\", 18.9), (\"Dorothy\", 16.2)]++hbarsTrace :: Trace+hbarsTrace = bars & ytext ?~ map fst hbarData+ & x ?~ map snd hbarData+ & orientation ?~ Horizontal+@++see Graphics.Plotly.Lucid for helper functions that turn traces into HTML.++-}++module Graphics.Plotly where++import Data.Aeson+import Data.Aeson.Types+import Data.Char (toLower)+import Data.List (intercalate, nub, findIndex)+import Data.Monoid ((<>))+import Data.Maybe (fromJust)+import Data.Text (Text)++import GHC.Generics+import Lens.Micro.TH++import Graphics.Plotly.Utils++-- * Traces++-- |How should traces be drawn? (lines or markers)+data Mode = Markers | Lines deriving Show++instance {-# OVERLAPS #-} ToJSON [Mode] where+ toJSON = toJSON . intercalate "+" . map (map toLower . show)++-- | What kind of plot type are we building - scatter (inluding line plots) or bars?+data TraceType = Scatter | Bar deriving Show++instance ToJSON TraceType where+ toJSON = toJSON . map toLower . show+++-- | A color specification, either as a concrete RGB/RGBA value or a color per point.+data Color = RGBA Int Int Int Int -- ^ use this RGBA color for every point in the trace+ | RGB Int Int Int -- ^ use this RGB color for every point in the trace+ | ColIxs [Int] -- ^ use a different color index for each point+ | Cols [Color] -- ^ use a different color for each point++instance ToJSON Color where+ toJSON (RGB r g b) = toJSON $ "rgb("<>show r<>","<>show g<>","<>show b<>")"+ toJSON (RGBA r g b a) = toJSON $ "rgba("<>show r<>","<>show g<>","<>show b<>","<> show a<>")"+ toJSON (ColIxs cs) = toJSON cs+ toJSON (Cols cs) = toJSON cs++-- | Assign colors based on any categorical value+catColors :: Eq a => [a] -> Color+catColors xs =+ let vals = nub xs+ f x = fromJust $ findIndex (==x) vals+ in ColIxs $ map f xs++-- | Different types of markers+data Symbol = Circle | Square | Diamond | Cross deriving Show++instance ToJSON Symbol where+ toJSON = toJSON . map toLower . show++-- | Marker specification+data Marker = Marker+ { _size :: Maybe Int+ , _markercolor :: Maybe Color+ , _symbol :: Maybe Symbol+ , _opacity :: Maybe Double+ } deriving Generic++makeLenses ''Marker++instance ToJSON Marker where+ toJSON = genericToJSON jsonOptions {fieldLabelModifier = rename "markercolor" "color" . unLens}++-- | default marker specification+defMarker :: Marker+defMarker = Marker Nothing Nothing Nothing Nothing+++-- | Dash type specification+data Dash = Solid | Dashdot | Dot deriving Show++instance ToJSON Dash where+ toJSON = toJSON . map toLower . show++-- | Horizontal or Vertical orientation of bars+data Orientation = Horizontal | Vertical++instance ToJSON Orientation where+ toJSON Horizontal = "h"+ toJSON Vertical = "v"++-- | Are we filling area plots from the zero line or to the next Y value?+data Fill = ToZeroY | ToNextY deriving Show++instance ToJSON Fill where+ toJSON = toJSON . map toLower . show++-- | line specification+data Line = Line+ { _linewidth :: Maybe Double+ , _linecolor :: Maybe Color+ , _dash :: Maybe Dash+ } deriving Generic++makeLenses ''Line++instance ToJSON Line where+ toJSON = genericToJSON jsonOptions { fieldLabelModifier = dropInitial "line" . unLens}++defLine :: Line+defLine = Line Nothing Nothing Nothing++-- | A `Trace` is the component of a plot. Multiple traces can be superimposed.+data Trace = Trace+ { _x :: Maybe [Double] -- ^ x values, as numbers+ , _y :: Maybe [Double] -- ^ y values, as numbers+ , _xtext :: Maybe [Text] -- ^ x values, as Text+ , _ytext :: Maybe [Text] -- ^ y values, as Text+ , _mode :: Maybe [Mode] -- ^ select one or two modes.+ , _name :: Maybe Text -- ^ name of this trace, for legend+ , _text :: Maybe [Text]+ , _tracetype :: TraceType+ , _marker :: Maybe Marker+ , _line :: Maybe Line+ , _fill :: Maybe Fill+ , _orientation :: Maybe Orientation+ } deriving Generic++makeLenses ''Trace++-- |an empty scatter plot+scatter :: Trace+scatter = Trace Nothing Nothing Nothing Nothing Nothing Nothing Nothing Scatter Nothing Nothing Nothing Nothing++-- |an empty bar plot+bars :: Trace+bars = Trace Nothing Nothing Nothing Nothing Nothing Nothing Nothing Bar Nothing Nothing Nothing Nothing+++instance ToJSON Trace where+ toJSON = genericToJSON jsonOptions {fieldLabelModifier = rename "tracetype" "type" . rename "xtext" "x" . rename "ytext" "y" . unLens}++-- |Options for axes+data Axis = Axis+ { _range :: Maybe (Double,Double)+ , _axistitle :: Maybe Text+ , _showgrid :: Maybe Bool+ , _zeroline :: Maybe Bool+ } deriving Generic++makeLenses ''Axis++instance ToJSON Axis where+ toJSON = genericToJSON jsonOptions {fieldLabelModifier = rename "axistitle" "axis" . unLens}++defAxis :: Axis+defAxis = Axis Nothing Nothing Nothing Nothing++-- * Layouts++-- | How different bar traces be superimposed? By grouping or by stacking?+data Barmode = Stack | Group deriving Show++instance ToJSON Barmode where+ toJSON = toJSON . map toLower . show++-- |Options for Margins.+data Margin = Margin+ { _marginl :: Int+ , _marginr :: Int+ , _marginb :: Int+ , _margint :: Int+ , _marginpad :: Int+ } deriving Generic++makeLenses ''Margin++instance ToJSON Margin where+ toJSON = genericToJSON jsonOptions { fieldLabelModifier = dropInitial "margin" . unLens}++-- | some good values for margins+thinMargins, titleMargins :: Margin+thinMargins = Margin 50 25 30 10 4+titleMargins = Margin 50 25 30 40 4+++-- |options for the layout of the whole plot+data Layout = Layout+ { _xaxis :: Maybe Axis+ , _yaxis :: Maybe Axis+ , _title :: Maybe Text+ , _showlegend :: Maybe Bool+ , _height :: Maybe Int+ , _width :: Maybe Int+ , _barmode :: Maybe Barmode+ , _margin :: Maybe Margin+ } deriving Generic++makeLenses ''Layout++-- |a defaultlayout+defLayout :: Layout+defLayout = Layout Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing++instance ToJSON Layout where+ toJSON = genericToJSON jsonOptions++-- * Plotly++-- | A helper record which represents the whole plot+data Plotly = Plotly+ { _elemid :: Text+ , _traces :: [Trace]+ , _layout :: Layout+ }++makeLenses ''Plotly++-- | helper function for building the plot.+plotly :: Text -> [Trace] -> Plotly+plotly idnm trs = Plotly idnm trs defLayout
+ src/Graphics/Plotly/Blaze.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}++{-|++Plot traces to html using blaze-html++Example code:++@+plotHtml :: Html ()+plotHtml = toHtml $ plotly "myDiv" [trace] & layout . title ?~ "my plot"+ & layout . width ?~ 300++@++where `trace` is a value of type `Trace`++-}+module Graphics.Plotly.Blaze where++import Text.Blaze+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A+import Graphics.Plotly+import Data.Monoid ((<>))+import Data.Text.Encoding (decodeUtf8)+import Data.ByteString.Lazy (toStrict)+import Data.Aeson++-- |`script` tag to go in the header to import the plotly.js javascript from the official CDN+plotlyCDN :: H.Html+plotlyCDN = H.script ! A.src "https://cdn.plot.ly/plotly-latest.min.js" $ ""++-- |Activate a plot defined by a `Plotly` value+plotlyJS :: Plotly -> H.Html+plotlyJS (Plotly divNm trs lay) =+ let trJSON = decodeUtf8 $ toStrict $ encode trs+ layoutJSON = decodeUtf8 $ toStrict $ encode lay+ in H.script $ H.toHtml ("Plotly.newPlot('"<>divNm<>"', "<>trJSON<>","<>layoutJSON<>", {displayModeBar: false});")++-- |Create a div for a Plotly value+plotlyDiv :: Plotly -> H.Html+plotlyDiv (Plotly divNm _ _) =+ H.div ! A.id (toValue divNm) $ ""+++instance ToMarkup Plotly where+ toMarkup pl = plotlyDiv pl >> plotlyJS pl
+ src/Graphics/Plotly/Histogram.hs view
@@ -0,0 +1,30 @@+{-|++Simple histograms++-}++module Graphics.Plotly.Histogram where++import Graphics.Plotly+import Data.List (sort, group)+import Lens.Micro++-- | build a histogram with a given binsize+histogram :: Int -- ^ number of bins+ -> [Double] -- ^ the individual observations+ -> Trace+histogram nbins pts =+ let (lo, hi) = (minimum pts, maximum pts)+ binSize = (hi - lo) / realToFrac nbins+ binf :: Double -> Int+ binf x = floor $ (x - lo) / binSize+ binToX binN = realToFrac binN * binSize + lo+ bins = group $ sort $ map binf pts+ goFill (car@(bin1,count1):cdr@((bin2,count2):_))+ | bin2 == bin1 + 1 = car : goFill cdr+ | otherwise = car : goFill ((bin1+1,0):cdr)+ goFill l = l+ binMap = goFill $ map (\is -> (head is, length is)) bins++ in bars & x ?~ map (binToX . fst) binMap & y ?~ map (realToFrac . snd) binMap
+ src/Graphics/Plotly/Lucid.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}++{-|++Plot traces to html using lucid++Example code:++@+plotHtml :: Html ()+plotHtml = toHtml $ plotly "myDiv" [trace] & layout . title ?~ "my plot"+ & layout . width ?~ 300++@++where `trace` is a value of type `Trace`++-}+module Graphics.Plotly.Lucid where++import Lucid+import Graphics.Plotly+import Data.Monoid ((<>))+import Data.Text.Encoding (decodeUtf8)+import Data.ByteString.Lazy (toStrict)+import Data.Aeson++-- |`script` tag to go in the header to import the plotly.js javascript from the official CDN+plotlyCDN :: Monad m => HtmlT m ()+plotlyCDN = script_ [src_ "https://cdn.plot.ly/plotly-latest.min.js"] ""++-- |Activate a plot defined by a `Plotly` value+plotlyJS :: Monad m => Plotly -> HtmlT m ()+plotlyJS (Plotly divNm trs lay) =+ let trJSON = decodeUtf8 $ toStrict $ encode trs+ layoutJSON = decodeUtf8 $ toStrict $ encode lay+ in script_ ("Plotly.newPlot('"<>divNm<>"', "<>trJSON<>","<>layoutJSON<>", {displayModeBar: false});")++-- |Create a div for a Plotly value+plotlyDiv :: Monad m => Plotly -> HtmlT m ()+plotlyDiv (Plotly divNm _ _) =+ div_ [id_ divNm]+ ""++instance ToHtml Plotly where+ toHtml pl = plotlyDiv pl >> plotlyJS pl+ toHtmlRaw = toHtml
+ src/Graphics/Plotly/Utils.hs view
@@ -0,0 +1,27 @@+{-|++Helper functions for defining valid JSON instances++-}++module Graphics.Plotly.Utils where++import Data.List (stripPrefix)+import Data.Aeson.Types++unLens :: String -> String+unLens ('_':s) = s+unLens s = s++dropInitial :: String -> String -> String+dropInitial s s' = case stripPrefix s s' of+ Nothing -> s'+ Just s'' -> s''++rename :: String -> String -> String -> String+rename froms tos s | s == froms = tos+ | otherwise = s++jsonOptions :: Options+jsonOptions = defaultOptions {omitNothingFields = True,+ fieldLabelModifier = unLens }