packages feed

plotlyhs 0.2 → 0.2.1

raw patch · 7 files changed

+338/−88 lines, 7 filesdep +time

Dependencies added: time

Files

plotlyhs.cabal view
@@ -1,5 +1,5 @@ Name:                plotlyhs-Version:             0.2+Version:             0.2.1 Synopsis:            Haskell bindings to Plotly.js Description:             Generate web-based plots with the Plotly.js library.@@ -12,8 +12,8 @@ Maintainer:          tanielsen@gmail.com build-type:          Simple Cabal-Version: 	     >= 1.10-homepage:            https://github.com/filopodia/open/plotlyhs-bug-reports:         https://github.com/filopodia/open/issues+homepage:            https://github.com/diffusionkinetics/open/plotlyhs+bug-reports:         https://github.com/diffusionkinetics/open/issues category:            Graphics, Charts Tested-With:         GHC == 7.8.4, GHC == 7.10.2, GHC == 7.10.3, GHC == 8.0.1 @@ -45,6 +45,7 @@                , blaze-html                , blaze-markup                , text+               , time                , bytestring                , microlens-th                , microlens
src/Graphics/Plotly/Base.hs view
@@ -54,13 +54,13 @@ -- * Traces  -- |How should traces be drawn? (lines or markers)-data Mode = Markers | Lines deriving Show+data Mode = Markers | Lines | ModeText deriving Show  instance {-# OVERLAPS #-} ToJSON [Mode] where-  toJSON = toJSON . intercalate "+" . map (map toLower . show)+  toJSON = toJSON . intercalate "+" . map (map toLower . dropInitial "Mode" . show)  -- | What kind of plot type are we building - scatter (inluding line plots) or bars?-data TraceType = Scatter | Bar deriving Show+data TraceType = Scatter | Scatter3D | Bar | Mesh3D | Pie | Contour deriving Show  instance ToJSON TraceType where   toJSON = toJSON . map toLower . show@@ -71,6 +71,16 @@            | ColRGB Int Int Int -- ^ use this RGB color for every point in the trace            | ColIx Int  -- ^ use a different color index for each point +instance Eq Color where+  (ColRGBA r0 g0 b0 a0) == (ColRGBA r1 g1 b1 a1) = (r0,g0,b0,a0) == (r1,g1,b1,a1)+  (ColRGB  r0 g0 b0)    == (ColRGB  r1 g1 b1)    = (r0,g0,b0)    == (r1,g1,b1)+  (ColIx   i0)          == (ColIx   i1)          = i0 == i1++  (ColRGBA r0 g0 b0 1)  == (ColRGB  r1 g1 b1)    = (r0,g0,b0) == (r1,g1,b1)+  (ColRGB  r0 g0 b0)    == (ColRGBA r1 g1 b1 1)  = (r0,g0,b0) == (r1,g1,b1)++  _ == _ = False+ instance ToJSON Color where   toJSON (ColRGB r g b) = toJSON $ "rgb("<>show r<>","<>show g<>","<>show b<>")"   toJSON (ColRGBA r g b a) = toJSON $ "rgba("<>show r<>","<>show g<>","<>show b<>","<> show a<>")"@@ -84,10 +94,11 @@   in List $ map (toJSON . ColIx . f) xs  -- | Different types of markers-data Symbol = Circle | Square | Diamond | Cross deriving (Show, Eq)+data Symbol = Circle | Square | Diamond | Cross | CustomSymbol Text deriving (Show, Eq)  instance ToJSON Symbol where-  toJSON = toJSON . map toLower . show+  toJSON (CustomSymbol t) = toJSON t+  toJSON s = toJSON . map toLower . show $ s  data ListOrElem a = List [a] | All a deriving Eq @@ -95,22 +106,46 @@   toJSON (List xs) = toJSON xs   toJSON (All x) = toJSON x +data Sizemode = Diameter | Area deriving (Show, Eq)++instance ToJSON Sizemode where+  toJSON = toJSON . map toLower . show++-- | Marker line specification+data MarkerLine = MarkerLine+  { _markerlinewidth :: Maybe (ListOrElem Double)+  , _markerlinecolor :: Maybe (ListOrElem Value)+  } deriving (Generic, Eq)++makeLenses ''MarkerLine++instance ToJSON MarkerLine where+  toJSON = genericToJSON jsonOptions {fieldLabelModifier = dropInitial "markerline" . unLens}++-- | default marker line specification+defMarkerLine :: MarkerLine+defMarkerLine = MarkerLine Nothing Nothing+ -- | Marker specification data Marker = Marker   { _size :: Maybe (ListOrElem Value)+  , _sizeref :: Maybe Value+  , _sizeMode :: Maybe Sizemode   , _markercolor :: Maybe (ListOrElem Value)-  , _symbol :: Maybe Symbol+  , _markercolors :: Maybe (ListOrElem Value) -- for pie charts+  , _symbol :: Maybe (ListOrElem Symbol)   , _opacity :: Maybe Double+  , _markerline :: Maybe MarkerLine   } deriving (Generic, Eq)  makeLenses ''Marker  instance ToJSON Marker where-  toJSON = genericToJSON jsonOptions {fieldLabelModifier = rename "markercolor" "color" . unLens}+  toJSON = genericToJSON jsonOptions {fieldLabelModifier = dropInitial "marker" . unLens}  -- | default marker specification defMarker :: Marker-defMarker  = Marker Nothing Nothing Nothing Nothing+defMarker  = Marker Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing   -- | Dash type specification@@ -127,15 +162,22 @@   toJSON Vertical = "v"  -- | Are we filling area plots from the zero line or to the next Y value?-data Fill = ToZeroY | ToNextY deriving Show+data Fill = FillNone | ToZeroY | ToNextY | ToZeroX | ToNextX | ToSelf | ToNext deriving Show  instance ToJSON Fill where+  toJSON = toJSON . map toLower . dropInitial "Fill" . show+++data LineShape = Linear | Spline | Hv | Hvh | Vh | Vhv deriving Show++instance ToJSON LineShape where   toJSON = toJSON . map toLower . show  -- | line specification data Line = Line   { _linewidth :: Maybe Double   , _linecolor :: Maybe Color+  , _lineshape :: Maybe LineShape   , _dash :: Maybe Dash   } deriving Generic @@ -145,51 +187,131 @@   toJSON = genericToJSON jsonOptions { fieldLabelModifier = dropInitial "line" . unLens}  defLine :: Line-defLine = Line Nothing Nothing Nothing+defLine = Line Nothing Nothing Nothing Nothing +data HoverElem = HoverX | HoverY | HoverZ | HoverText | HoverName+  deriving (Generic, Show)++data HoverInfo = HoverPlus [HoverElem] | HoverAll | HoverNone | HoverSkip+  deriving (Generic, Show)++instance ToJSON HoverInfo where+  toJSON (HoverPlus elems) = toJSON . intercalate "+" $ (map toLower . dropInitial "Hover" . show) <$> elems+  toJSON x                 = toJSON . map toLower . dropInitial "Hover" $ show x++data HoverOn = HoverPoints | HoverFills deriving (Generic, Show)++instance {-# OVERLAPS #-} ToJSON [HoverOn] where+  toJSON = toJSON . intercalate "+" . map (map toLower . dropInitial "Hover" . show)++data TextPosition+  = TopLeft    | TopCenter    | TopRight+  | MiddleLeft | MiddleCenter | MiddleRight+  | BottomLeft | BottomCenter | BottomRight+  deriving (Generic, Show)++instance ToJSON TextPosition where+  toJSON = toJSON . camelTo2 ' ' . show+ -- | A `Trace` is the component of a plot. Multiple traces can be superimposed. data Trace = Trace   { _x :: Maybe [Value] -- ^ x values, as numbers   , _y :: Maybe [Value] -- ^ y values, as numbers+  , _z :: Maybe [Value] -- ^ z values, as numbers+  , _values :: Maybe [Value] -- values for pie chart+  , _labels :: Maybe [Text] -- labels for pie chart+  , _hole :: Maybe Value -- pie chart hole property   , _mode :: Maybe [Mode] -- ^ select one or two modes.   , _name :: Maybe Text -- ^ name of this trace, for legend   , _text :: Maybe [Text]+  , _textposition :: Maybe TextPosition   , _tracetype :: TraceType   , _marker :: Maybe Marker   , _line :: Maybe Line   , _fill :: Maybe Fill   , _orientation :: Maybe Orientation+  , _visible :: Maybe Value+  , _traceshowlegend :: Maybe Bool+  , _legendgroup :: Maybe Text+  , _customdata :: Maybe [Value]+  , _hoverinfo :: Maybe HoverInfo+  , _hovertext :: Maybe (ListOrElem Text)+  , _hoveron :: Maybe [HoverOn]+  , _connectgaps :: Maybe Bool++  -- Pie+  , _sort :: Maybe Bool++  -- 3D mesh+  , _i :: Maybe [Int] -- ^ i values, as ints+  , _j :: Maybe [Int] -- ^ j values, as ints+  , _k :: Maybe [Int] -- ^ k values, as ints+  , _tracecolor :: Maybe Color+  , _traceopacity :: Maybe Double++  -- Sub-plots+  , _tracexaxis :: Maybe Text -- ^ X-axis name+  , _traceyaxis :: Maybe Text -- ^ Y-axis name   } deriving Generic  makeLenses ''Trace +mkTrace :: TraceType -> Trace+mkTrace tt = Trace Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing tt Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing+ -- |an empty scatter plot scatter :: Trace-scatter = Trace Nothing Nothing Nothing Nothing Nothing Scatter Nothing Nothing Nothing Nothing+scatter = mkTrace Scatter +-- |an empty 3D scatter plot+scatter3d :: Trace+scatter3d = mkTrace Scatter3D+ -- |an empty bar plot bars :: Trace-bars = Trace Nothing Nothing Nothing Nothing Nothing Bar Nothing Nothing Nothing Nothing+bars = mkTrace Bar +-- |an empty 3D mesh plot+mesh3d :: Trace+mesh3d = mkTrace Mesh3D +-- |an empty 3D mesh plot+contour :: Trace+contour = mkTrace Contour++-- | an empty pie chart+pie :: Trace+pie = mkTrace Pie+ instance ToJSON Trace where-  toJSON = genericToJSON jsonOptions {fieldLabelModifier = rename "tracetype" "type" . unLens}+  toJSON = genericToJSON jsonOptions {fieldLabelModifier = renamer}+    where renamer = dropInitial "trace" . unLens +data AxisType = Log | Date | Category deriving Show++instance ToJSON AxisType where+  toJSON = toJSON . map toLower . show+ -- |Options for axes data Axis = Axis   { _range :: Maybe (Double,Double)+  , _axistype :: Maybe AxisType   , _axistitle :: Maybe Text   , _showgrid :: Maybe Bool   , _zeroline :: Maybe Bool+  , _axisvisible :: Maybe Bool+  , _tickvals :: Maybe [Value]+  , _ticktext :: Maybe [Text]+  , _domain :: Maybe (Double,Double)   } deriving Generic  makeLenses ''Axis  instance ToJSON Axis where-  toJSON = genericToJSON jsonOptions {fieldLabelModifier = rename "axistitle" "axis" . unLens}+  toJSON = genericToJSON jsonOptions {fieldLabelModifier = dropInitial "axis" . unLens}  defAxis :: Axis-defAxis = Axis Nothing Nothing Nothing Nothing+defAxis = Axis Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing  -- * Layouts @@ -218,24 +340,83 @@ thinMargins = Margin 50 25 30 10 4 titleMargins = Margin 50 25 30 40 4 +-- | Options for Fonts.+data Font = Font+  { _fontfamily :: Maybe Text+  , _fontsize   :: Maybe Double+  , _fontcolor  :: Maybe Color+  } deriving Generic +makeLenses ''Font++instance ToJSON Font where+  toJSON = genericToJSON jsonOptions { fieldLabelModifier = dropInitial "font" . unLens}++defFont :: Font+defFont = Font Nothing Nothing Nothing++data Align+  = AlignLeft | AlignCenter | AlignRight+  deriving (Generic, Show)++instance ToJSON Align where+  toJSON = toJSON . map toLower . dropInitial "Align" . show++-- | Options for annotations+data Annotation = Annotation+  { _annotationvisible     :: Maybe Bool+  , _annotationtext        :: Maybe Text+  , _annotationfont        :: Maybe Font+  , _annotationwidth       :: Maybe Double+  , _annotationheight      :: Maybe Double+  , _annotationopacity     :: Maybe Double+  , _annotationalign       :: Maybe Align+  , _annotataonbgcolor     :: Maybe Color+  , _annotationbordercolor :: Maybe Color+  , _annotationshowarrow   :: Maybe Bool+  , _annotationx           :: Maybe Value+  , _annotationxref        :: Maybe Text -- ^ "paper" or X-axis name+  , _annotationxshift      :: Maybe Double+  , _annotationy           :: Maybe Value+  , _annotationyref        :: Maybe Text -- ^ "paper" or Y-axis name+  , _annotationyshift      :: Maybe Double+  } deriving Generic++makeLenses ''Annotation++defAnnotation :: Annotation+defAnnotation = Annotation Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing++instance ToJSON Annotation where+  toJSON = genericToJSON jsonOptions {fieldLabelModifier = dropInitial "annotation" . unLens}+ -- |options for the layout of the whole plot data Layout = Layout-  { _xaxis :: Maybe Axis-  , _yaxis :: Maybe Axis-  , _title :: Maybe Text+  { _xaxis  :: Maybe Axis+  , _xaxis2 :: Maybe Axis+  , _xaxis3 :: Maybe Axis+  , _xaxis4 :: Maybe Axis+  , _yaxis  :: Maybe Axis+  , _yaxis2 :: Maybe Axis+  , _yaxis3 :: Maybe Axis+  , _yaxis4 :: Maybe Axis+  , _zaxis  :: Maybe Axis+  , _title  :: Maybe Text+  , _titlefont :: Maybe Font   , _showlegend :: Maybe Bool   , _height :: Maybe Int   , _width :: Maybe Int   , _barmode :: Maybe Barmode   , _margin :: Maybe Margin+  , _font :: Maybe Font+  , _annotations :: Maybe [Annotation]   } deriving Generic  makeLenses ''Layout  -- |a defaultlayout defLayout :: Layout-defLayout = Layout Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing+defLayout = Layout Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing  instance ToJSON Layout where   toJSON = genericToJSON jsonOptions@@ -247,7 +428,10 @@   { _elemid :: Text   , _traces :: [Trace]   , _layout :: Layout-  }+  } deriving Generic++instance ToJSON Plotly where+  toJSON = genericToJSON jsonOptions  makeLenses ''Plotly
src/Graphics/Plotly/Blaze.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  {-|
src/Graphics/Plotly/GoG.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE OverloadedStrings, FlexibleInstances, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE TypeFamilies       #-}+{-# LANGUAGE TypeApplications   #-}  {-| A limited Grammar of Graphics-like interface.@@ -14,18 +18,17 @@                       & y .~ snd)                  myPts @--- -}- module Graphics.Plotly.GoG where +import           Data.Aeson+import           Data.Text (Text)+import           Data.Time+import           Lens.Micro+ import qualified Graphics.Plotly.Base as Plot-import Data.Text (Text)-import Lens.Micro-import Data.Aeson + class ToJSON a => AxisValue a  instance AxisValue Double@@ -33,6 +36,7 @@ instance AxisValue Text instance AxisValue String instance AxisValue Int+instance AxisValue Day  data RGB a = RGB a a a data RGBA a = RGBA a a a a@@ -42,14 +46,14 @@  instance ToJSON (RGB Double) where   toJSON (RGB r g b) = toJSON $ concat ["rgb(",showd r,",",showd g, ",", showd b,")"]-   where showd = show . floor . (*256)+   where showd = show @Int. floor . (*256)  instance ToJSON (RGBA Int) where   toJSON (RGBA r g b a) = toJSON $ concat ["rgba(",show r,",",show g, ",", show b,",", show a, ")"]  instance ToJSON (RGBA Double) where   toJSON (RGBA r g b a) = toJSON $ concat ["rgb(",showd r,",",showd g, ",", showd b,",", showd a,")"]-   where showd = show . floor . (*256)+   where showd = show @Int. floor . (*256)  class ToJSON a => IsColor a @@ -69,40 +73,59 @@ type instance CVal (x,y,c,s) = c type instance SVal (x,y,c,s) = s -data Aes t a = Aes { _x :: (a -> XVal t)-                   , _y :: (a -> YVal t)-                   , _color :: Maybe (a -> CVal t)-                   , _size :: Maybe (a -> SVal t)-                   }+data Aes t a = Aes+    { _x     :: a -> XVal t+    , _y     :: a -> YVal t+    , _color :: Maybe (a -> CVal t)+    , _size  :: Maybe (a -> SVal t)+    }++ aes :: Aes ((), (), (), ()) a aes = Aes (const ()) (const ()) Nothing Nothing -setx :: AxisValue v => Aes (vx,vy,vc,vs) a -> (a -> v) -> Aes (v, vy, vc, vs) a-setx (Aes _ fy fc fs) f = (Aes f fy fc fs) -x :: AxisValue v => Lens (Aes (vx,vy, vc, vs) a) (Aes (v,vy, vc, vs) a) (a -> vx) (a -> v)+setx :: (AxisValue v)+    => Aes (vx,vy,vc,vs) a -> (a -> v) -> Aes (v, vy, vc, vs) a+setx (Aes _ fy fc fs) f = Aes f fy fc fs+++x :: (AxisValue v)+    => Lens (Aes (vx,vy, vc, vs) a) (Aes (v,vy, vc, vs) a) (a -> vx) (a -> v) x = lens _x setx -sety :: AxisValue v => Aes (vx,vy, vc, vs) a -> (a -> v) -> Aes (vx, v, vc, vs) a-sety (Aes fx _ fc fs) f = (Aes fx f fc fs) -y :: AxisValue v => Lens (Aes (vx,vy, vc, vs) a) (Aes (vx,v, vc, vs) a) (a -> vy) (a -> v)+sety :: (AxisValue v)+    => Aes (vx,vy, vc, vs) a -> (a -> v) -> Aes (vx, v, vc, vs) a+sety (Aes fx _ fc fs) f = Aes fx f fc fs+++y :: (AxisValue v)+    => Lens (Aes (vx,vy, vc, vs) a) (Aes (vx,v, vc, vs) a) (a -> vy) (a -> v) y = lens _y sety -setcol :: IsColor v => Aes (vx,vy, vc, vs) a -> Maybe (a -> v) -> Aes (vx, vy, v, vs) a-setcol (Aes fx fy _ fs) f = (Aes fx fy f fs) -color :: IsColor v => Lens (Aes (vx,vy, vc, vs) a) (Aes (vx,vy,v,vs) a) (Maybe (a -> vc)) (Maybe (a -> v))+setcol :: (IsColor v)+    => Aes (vx,vy, vc, vs) a -> Maybe (a -> v) -> Aes (vx, vy, v, vs) a+setcol (Aes fx fy _ fs) f = Aes fx fy f fs+++color :: (IsColor v)+    => Lens (Aes (vx,vy, vc, vs) a) (Aes (vx,vy,v,vs) a) (Maybe (a -> vc)) (Maybe (a -> v)) color = lens _color setcol -setsize :: (AxisValue v, Num v) => Aes (vx,vy, vc, vs) a -> Maybe (a -> v) -> Aes (vx, vy, vc, v) a-setsize (Aes fx fy fc _) f = (Aes fx fy fc f) -size :: (AxisValue v, Num v) => Lens (Aes (vx,vy, vc, vs) a) (Aes (vx,vy,vc,v) a) (Maybe (a -> vs)) (Maybe (a -> v))+setsize :: (AxisValue v, Num v)+    => Aes (vx,vy, vc, vs) a -> Maybe (a -> v) -> Aes (vx, vy, vc, v) a+setsize (Aes fx fy fc _) = Aes fx fy fc+++size :: (AxisValue v, Num v)+    => Lens (Aes (vx,vy, vc, vs) a) (Aes (vx,vy,vc,v) a) (Maybe (a -> vs)) (Maybe (a -> v)) size = lens _size setsize  -points :: (AxisValue (XVal t), AxisValue (YVal t), Num (XVal t), Num (YVal t), ToJSON (CVal t), ToJSON (SVal t))+points :: (AxisValue (XVal t), AxisValue (YVal t), ToJSON (CVal t), ToJSON (SVal t))        => Aes t a -> [a] -> Plot.Trace points a xs =  setSize (_size a) $ setColors (_color a) $ Plot.scatter                  & Plot.x ?~ map (toJSON . _x a) xs@@ -115,14 +138,15 @@         setSize (Just setS) p           = p & Plot.marker . non Plot.defMarker . Plot.size ?~ Plot.List (map (toJSON . setS) xs) -line :: (AxisValue (XVal t), AxisValue (YVal t), Num (XVal t), Num (YVal t))+line :: (AxisValue (XVal t), AxisValue (YVal t))        => Aes t a -> [a] -> Plot.Trace line a xs = Plot.scatter & Plot.x ?~ map (toJSON . _x a) xs                  & Plot.y ?~ map (toJSON . _y a) xs                  & Plot.mode ?~ [Plot.Lines] -hbars :: (AxisValue (XVal t), AxisValue (YVal t), Num (XVal t))+hbars :: (AxisValue (XVal t), AxisValue (YVal t))        => Aes t a -> [a] -> Plot.Trace hbars a xs = Plot.bars & Plot.x ?~ map (toJSON . _x a) xs                  & Plot.y ?~ map (toJSON . _y a) xs                  & Plot.orientation ?~ Plot.Horizontal+
src/Graphics/Plotly/Histogram.hs view
@@ -6,10 +6,11 @@  module Graphics.Plotly.Histogram where -import Graphics.Plotly.Base+import Graphics.Plotly.Base hiding (sort) import Data.List (sort, group) import Lens.Micro import Data.Aeson (toJSON)+import Data.Text (Text)  -- | build a histogram with a given binsize histogram :: Int -- ^ number of bins@@ -18,16 +19,38 @@ histogram nbins pts =   let (lo, hi) = (minimum pts, maximum pts)       binSize = (hi - lo) / realToFrac nbins-      binf :: Double -> Int-      binf xv = floor $ (xv - lo) / binSize       binToX :: Int -> Double       binToX binN = realToFrac binN * binSize + lo+      binMap :: [(Int, Int)]+      binMap = getBinMap lo binSize pts+  in bars & x ?~ map (toJSON . binToX . fst) binMap & y ?~ map (toJSON .  snd) binMap+++histMany :: Int -> [(Text, [Double])] -> [Trace]+histMany nbins hdata =+  let allPts = concat $ map snd hdata+      (lo, hi) = (minimum allPts, maximum allPts)+      binSize = (hi - lo) / realToFrac nbins+      binToX :: Int -> Double+      binToX binN = realToFrac binN * binSize + lo+      getTrace (nm,pts) =+        let binMap = getBinMap lo binSize pts+        in bars & x ?~ map (toJSON . binToX . fst) binMap+                & y ?~ map (toJSON .  snd) binMap+                & name ?~ nm+  in map getTrace hdata++goFill :: [(Int,Int)] -> [(Int,Int)]+goFill (car@(bin1,_):cdr@((bin2,_):_))+   | bin2 == bin1 + 1 =  car : goFill cdr+   | otherwise = car : goFill ((bin1+1,0):cdr)+goFill l = l++getBinMap :: Double -> Double -> [Double] -> [(Int, Int)]+getBinMap lo binSize pts =+  let binf :: Double -> Int+      binf xv = floor $ (xv - lo) / binSize       bins = group $ sort $ map binf pts-      goFill (car@(bin1,_):cdr@((bin2,_):_))-         | bin2 == bin1 + 1 =  car : goFill cdr-         | otherwise = car : goFill ((bin1+1,0):cdr)-      goFill l = l       binMap :: [(Int, Int)]       binMap = goFill $ map (\is -> (head is, length is)) bins--  in bars & x ?~ map (toJSON . binToX . fst) binMap & y ?~ map (toJSON .  snd) binMap+  in binMap
src/Graphics/Plotly/Lucid.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  {-| @@ -27,7 +28,7 @@  -- |`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"] ""+plotlyCDN = script_ [src_ "https://cdn.plot.ly/plotly-latest.min.js"] $ toHtml (""::String)  -- |Activate a plot defined by a `Plotly` value plotlyJS :: Monad m => Plotly -> HtmlT m ()
src/Graphics/Plotly/Simple.hs view
@@ -1,41 +1,57 @@-{-# LANGUAGE OverloadedStrings #-}- {-|--Functions to build Traces from standard data. Generated traces can still be customized with lenses-+Functions to build Traces from standard data. Generated traces can still be+customized with lenses. -}- module Graphics.Plotly.Simple where -import Graphics.Plotly.Base-import Lens.Micro-import Data.Text (Text) import Data.Aeson+import Data.Text (Text)+import Lens.Micro +import Graphics.Plotly.Base + -- |Generate a scatterplot from pairs-scatterPlot :: [(Double,Double)] -> Trace-scatterPlot xys = scatter & x ?~ map (toJSON .fst) xys-                          & y ?~ map (toJSON .snd) xys-                          & mode ?~ [Markers]+scatterPlot :: (ToJSON a, ToJSON b) => [(a, b)] -> Trace+scatterPlot xys = scatter+    & x     ?~ fmap (toJSON . fst) xys+    & y     ?~ fmap (toJSON . snd) xys+    & mode  ?~ [Markers]++ -- |Generate a line plot from pairs-linePlot :: [(Double,Double)] -> Trace-linePlot xys    = scatter & x ?~ map (toJSON .fst) xys-                          & y ?~ map (toJSON .snd) xys-                          & mode ?~ [Lines]+linePlot :: (ToJSON a, ToJSON b) => [(a, b)] -> Trace+linePlot xys = scatter+    & x     ?~ fmap (toJSON . fst) xys+    & y     ?~ fmap (toJSON . snd) xys+    & mode  ?~ [Lines] + -- |Generate a horizontal bar chart from pairs of text and value. hbarChart :: [(Text, Double)] -> Trace-hbarChart tvs = bars & y ?~ map (toJSON . fst) tvs-                     & x ?~ map (toJSON .snd) tvs-                     & orientation ?~ Horizontal+hbarChart tvs = bars+    & y             ?~ fmap (toJSON . fst) tvs+    & x             ?~ fmap (toJSON . snd) tvs+    & orientation   ?~ Horizontal ++-- |Generate a horizontal bar chart from pairs of text and value.+vbarChart :: [(Text, Double)] -> Trace+vbarChart tvs = bars+    & x             ?~ fmap (toJSON . fst) tvs+    & y             ?~ fmap (toJSON . snd) tvs+    & orientation   ?~ Vertical++ -- |Generate a fan plot with a given width in standard deviations and --  (x,(y,sd)) data fanPlot :: Double -> [(Double, (Double, Double))] -> Trace-fanPlot sdCount tmnsds =-  let xs = map fst tmnsds ++ reverse (map fst tmnsds)-      ys = map ((\(m,sd) -> m+sdCount*sd) . snd) tmnsds-           ++ reverse ( map ((\(m,sd) -> m-sdCount*sd) . snd) tmnsds)-  in  scatter & x ?~ map toJSON xs & y ?~ map toJSON ys & fill ?~ ToZeroY+fanPlot sdCount tmnsds = scatter+    & x     ?~ fmap toJSON xs+    & y     ?~ fmap toJSON ys+    & fill  ?~ ToZeroY+  where+    xs = fmap fst tmnsds ++ reverse (fmap fst tmnsds)+    ys = fmap ((\(m, sd) -> m + sdCount * sd) . snd) tmnsds+            ++ reverse (fmap ((\(m, sd) -> m - sdCount * sd) . snd) tmnsds)+