diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Justin Sermeno (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/amby.cabal b/amby.cabal new file mode 100644 --- /dev/null +++ b/amby.cabal @@ -0,0 +1,65 @@ +name: amby +version: 0.2.0 +synopsis: Statistical data visualization. +description: Statistical data visualization. Provides a high-level + interface built on top of + + to quickly display attractive visualizations within GHCi. +homepage: https://github.com/githubuser/amby#readme +license: BSD3 +license-file: LICENSE +author: Justin Sermeno +maintainer: Justin Sermeno +copyright: Copyright (c) 2014-2016 Justin Sermeno +category: Graphics +build-type: Simple +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Amby + other-modules: Amby.Types + , Amby.Style + , Amby.Theme + , Amby.Numeric + , Amby.Plot + , Amby.Display + build-depends: base >= 4.7 && < 5 + , data-default-class + , Chart-cairo + , Chart-diagrams + , Chart + , vector + , statistics + , microlens + , colour + , scientific + , mtl + , safe + , either + , pretty-display + , process + , exceptions + , data-default + default-language: Haskell2010 + +executable amby-exe + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , amby + default-language: Haskell2010 + +test-suite amby-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , amby + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/githubuser/amby diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Amby + +main :: IO () +main = return () diff --git a/src/Amby.hs b/src/Amby.hs new file mode 100644 --- /dev/null +++ b/src/Amby.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE IncoherentInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module Amby + ( + -- * Modules + module Amby.Theme + , module Amby.Numeric + , module Amby.Types + , module Amby.Plot + ) where + +import Amby.Types +import Amby.Numeric +import Amby.Theme +import Amby.Style +import Amby.Plot +import Amby.Display () diff --git a/src/Amby/Display.hs b/src/Amby/Display.hs new file mode 100644 --- /dev/null +++ b/src/Amby/Display.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Amby.Display where + +import Control.Monad.Catch +import Data.Default (def) +import Text.Display +import System.IO.Unsafe (unsafePerformIO) +import System.Exit (ExitCode(..)) +import System.Process (readProcessWithExitCode) + +import Graphics.Rendering.Chart.Easy (Layout, EC) +import qualified Graphics.Rendering.Chart.Backend.Cairo as Cairo + +import qualified Amby.Plot as Plot +import Amby.Types + +instance {-# OVERLAPPING #-} Display (AmbyChart ()) where + display a = saveAndDisplay a + +instance {-# OVERLAPPING #-} Display (EC (Layout Double Double) ()) where + display a = saveAndDisplayEC a + +saveAndDisplay :: AmbyChart () -> DisplayText +saveAndDisplay chart = saveAndDisplayIO $ do + Plot.save chart + +saveAndDisplayEC :: EC (Layout Double Double) () -> DisplayText +saveAndDisplayEC chart = saveAndDisplayIO $ do + Cairo.toFile def Plot.cairoDefSave chart + +saveAndDisplayIO :: IO () -> DisplayText +{-# NOINLINE saveAndDisplayIO #-} +saveAndDisplayIO ioAction = unsafePerformIO $ do + ioAction + catch readImg cHandler + where + readImg = do + (ec, stdout, stderr) <- readProcessWithExitCode "imgcat" [Plot.cairoDefSave] "" + if | (ExitFailure code) <- ec -> return (mkDtStr "Unable to display chart.") + | otherwise -> return (mkDtStr stdout) + cHandler e + | Just (e :: SomeException) <- fromException e = + return $ mkDt "Could not find imgcat executable." + diff --git a/src/Amby/Numeric.hs b/src/Amby/Numeric.hs new file mode 100644 --- /dev/null +++ b/src/Amby/Numeric.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE FlexibleContexts #-} +module Amby.Numeric + ( contDistrDomain + , contDistrRange + , linspace + , arange + ) where + +import Data.Either.Combinators +import Data.Scientific +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Unboxed as U +import qualified Data.Vector as V +import Statistics.Distribution + +contDistrDomain :: (ContDistr d) => d -> Int -> U.Vector Double +contDistrDomain d num = linspace (quantile d 0.0001) (quantile d 0.9999) num + +contDistrRange :: (ContDistr d) => d -> U.Vector Double -> U.Vector Double +contDistrRange d x = U.map (density d) x + +linspace :: Double -> Double -> Int -> U.Vector Double +linspace start stop num + | num < 0 = error ("Number of samples, " ++ show num ++ ", must be non-negative.") + | num == 0 || num == 1 = addStart $ U.generate num ((* delta) . fromIntegral) + | otherwise = addStart $ U.generate num ((* step) . fromIntegral) + where + delta = stop - start + step = delta / fromIntegral (num - 1) + addStart = U.map (realToFrac . (+ start)) + +arange :: Double -> Double -> Double -> U.Vector Double +arange start stop step = U.fromList [start,(start + step)..stop] diff --git a/src/Amby/Plot.hs b/src/Amby/Plot.hs new file mode 100644 --- /dev/null +++ b/src/Amby/Plot.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE IncoherentInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module Amby.Plot + ( plot + , plotEq + , getEC + , save + , saveSvg + + , cairoDefSave + , diagramsDefSave + ) where + +import Control.Arrow +import Control.Monad +import Control.Monad.State +import qualified Data.List as L +import qualified Data.Vector.Generic as G + +import Data.Default.Class +import Graphics.Rendering.Chart.Easy hiding (plot) +import qualified Graphics.Rendering.Chart.Easy as Chart +import qualified Graphics.Rendering.Chart.Backend.Cairo as Cairo +import qualified Graphics.Rendering.Chart.Backend.Diagrams as Diagrams +import Lens.Micro +import Statistics.Distribution + +import Amby.Types +import Amby.Numeric +import Amby.Theme +import Amby.Style + +cairoDefSave :: FilePath +cairoDefSave = ".__amby.png" + +diagramsDefSave :: FilePath +diagramsDefSave = ".__amby.svg" + +getEC :: AmbyChart () -> EC (Layout Double Double) () +getEC compute = getLayout $ execState compute def + +getState :: AmbyChart () -> AmbyState +getState compute = execState compute def + +-- | Quick render. +-- Short-hand to render to png file using Cairo backend. +save :: AmbyChart () -> IO () +save chart = Cairo.toFile + def { Cairo._fo_size = size } + cairoDefSave + (getLayout st) + where + st = getState chart + size = getSize st + +-- | Short-hand to render to svg using Cairo backend +saveSvg :: AmbyChart () -> IO () +saveSvg chart = Diagrams.toFile + def { Diagrams._fo_size = join (***) fromIntegral size } + diagramsDefSave + (getLayout st) + where + st = getState chart + size = getSize st + +-- | Basic x y line plot. +instance (G.Vector v Double, G.Vector v (Double, Double)) + => AmbyContainer (v Double) Double where + plot :: v Double -> v Double -> AmbyChart () + plot x y = plotList $ G.toList (G.zip x y) + + plotEq :: v Double -> (Double -> Double) -> AmbyChart () + plotEq x fn = plotList $ G.toList (G.zip x (G.map fn x)) + +instance (Real a) => AmbyContainer [a] a where + plot :: [a] -> [a] -> AmbyChart () + plot x y = plotList $ L.zipWith (\a b -> (realToFrac a, realToFrac b)) x y + + plotEq x fn = plotList $ L.zipWith (\a b -> (realToFrac a, realToFrac b)) x (map fn x) + +plotList :: [(Double, Double)] -> AmbyChart () +plotList plotVals = do + theme <- takeTheme + layout <- takeLayout + putLayout $ layout >> mkLayout theme + where + + linePlot :: EC l (PlotLines Double Double) + linePlot = liftEC $ do + nextColor <- takeColor + plot_lines_values .= [plotVals] + plot_lines_style . line_width .= 2.5 + plot_lines_style . line_color .= nextColor + + mkLayout :: Theme -> EC (Layout Double Double) () + mkLayout theme = do + Chart.plot linePlot diff --git a/src/Amby/Style.hs b/src/Amby/Style.hs new file mode 100644 --- /dev/null +++ b/src/Amby/Style.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +module Amby.Style + ( roundAxisData + , noEdgeAxisData + , scaledPaddedAxis + , setThemeStyles + ) + where + +import Safe +import qualified Data.List as L +import Numeric + +import Graphics.Rendering.Chart.Easy hiding (plot) + +import Amby.Theme + +-- | Equalizes precision for all labels. +-- For example the labels [0, 0.2] become [0.0, 0.2]. +roundAxisData :: AxisData x -> AxisData x +roundAxisData axisData = axisData & axis_labels %~ go + where + go xs = map go' xs + go' xs = xs + & mapped . _2 + %~ \x -> case readMay x of + Just a -> showFFloat (Just precision) a "" + Nothing -> x + where + precision = maximum $ map (countAfterDecimal . snd) xs + +noEdgeAxisData :: AxisData x -> AxisData x +noEdgeAxisData axisData = axisData & axis_grid %~ removeEdges + where + removeEdges xs + | length xs < 2 = [] + | otherwise = (init . tail) xs + +scaledPaddedAxis :: forall x. (RealFloat x, PlotValue x) => [x] -> AxisData x +scaledPaddedAxis axisPoints = defaultAxis + & axis_grid %~ (\xs -> gridMin : xs ++ [gridMax]) + where + getGridLimits xs + | length xs < 1 = error "Not enough grid points" + | otherwise = (head xs - spacing, last xs + spacing) + where + getSpacing (x:y:xs) = y - x + spacing = getSpacing xs + defaultAxis = autoAxis axisPoints + (gridMin, gridMax) = getGridLimits (defaultAxis ^. axis_grid) + +countAfterDecimal :: String -> Int +countAfterDecimal xs = case L.findIndex (== '.') xs of + Nothing -> 0 + Just idx -> (length xs - 1) - idx + +setThemeStyles :: Theme -> EC (Layout Double Double) () +setThemeStyles theme = do + layout_background .= (FillStyleSolid $ getBgColor theme) + layout_plot_background .= Just (FillStyleSolid $ getPlotBgColor theme) + layout_all_font_styles . font_name .= (getFontFamily theme) + layout_all_font_styles . font_size .= (getFontSize theme) + layout_axes_styles . axis_line_style . line_width .= 0.0 + layout_axes_styles . axis_grid_style . line_color .= (getGridLineColor theme) + layout_axes_styles . axis_grid_style . line_width .= 1.5 + layout_axes_styles . axis_grid_style . line_dashes .= [] + layout_axes_styles . axis_label_gap .= 8 + layout_x_axis . laxis_override .= roundAxisData + layout_y_axis . laxis_override .= roundAxisData + layout_margin .= 10 diff --git a/src/Amby/Theme.hs b/src/Amby/Theme.hs new file mode 100644 --- /dev/null +++ b/src/Amby/Theme.hs @@ -0,0 +1,99 @@ +module Amby.Theme + ( Theme + + -- * Themes + , mutedTheme + , deepTheme + , cleanTheme + + -- * Accessors + , getBgColor + , getPlotBgColor + , getGridLineColor + , getColorCycle + , getFontFamily + , getFontSize + ) + where + +import Data.Colour +import Data.Colour.SRGB +import Data.Default.Class + +data Theme = Theme + { bgColor :: AlphaColour Double + , plotBgColor :: AlphaColour Double + , gridLineColor :: AlphaColour Double + , fontFamily :: String + , fontSize :: Double + , colorCycle :: [AlphaColour Double] + } + +instance Default Theme where + def = deepTheme + +mutedTheme :: Theme +mutedTheme = Theme + { bgColor = opaque (sRGB24read "#FFFFFF") + , plotBgColor = opaque (sRGB24read "#EAEAF2") + , gridLineColor = opaque (sRGB24read "#FFFFFF") + , fontFamily = "Verdana" + , fontSize = 14 + , colorCycle = + [ opaque (sRGB24read "#4878CF") + , opaque (sRGB24read "#6ACC65") + , opaque (sRGB24read "#D65F5F") + , opaque (sRGB24read "#B47CC7") + , opaque (sRGB24read "#C4AD66") + , opaque (sRGB24read "#77BEDB") + ] + } + +deepTheme :: Theme +deepTheme = Theme + { bgColor = opaque (sRGB24read "#FFFFFF") + , plotBgColor = opaque (sRGB24read "#EAEAF2") + , gridLineColor = opaque (sRGB24read "#FFFFFF") + , fontFamily = "Verdana" + , fontSize = 14 + , colorCycle = + [ opaque (sRGB24read "#4C72B0") + , opaque (sRGB24read "#55A868") + , opaque (sRGB24read "#C44E52") + , opaque (sRGB24read "#8172B2") + , opaque (sRGB24read "#CCB974") + , opaque (sRGB24read "#64B5CD") + ] + } + +cleanTheme :: Theme +cleanTheme = def + { bgColor = opaque (sRGB24read "#FFFFFF") + , plotBgColor = opaque (sRGB24read "#FFFFFF") + , gridLineColor = opaque (sRGB24read "#EEEEEE") + , colorCycle = + [ opaque (sRGB24read "#1776B6") + , opaque (sRGB24read "#FF962A") + , opaque (sRGB24read "#24A122") + , opaque (sRGB24read "#CF0407") + , opaque (sRGB24read "#9564BF") + ] + } + +getBgColor :: Theme -> AlphaColour Double +getBgColor = bgColor + +getPlotBgColor :: Theme -> AlphaColour Double +getPlotBgColor = plotBgColor + +getGridLineColor :: Theme -> AlphaColour Double +getGridLineColor = gridLineColor + +getColorCycle :: Theme -> [AlphaColour Double] +getColorCycle = colorCycle + +getFontFamily :: Theme -> String +getFontFamily = fontFamily + +getFontSize :: Theme -> Double +getFontSize = fontSize diff --git a/src/Amby/Types.hs b/src/Amby/Types.hs new file mode 100644 --- /dev/null +++ b/src/Amby/Types.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE TemplateHaskell #-} +module Amby.Types + ( AmbyContainer(..) + , AmbyState + , AmbyChart + + -- * Accessors + , takeTheme + , theme + , xlim + , ylim + , size + , takeLayout + , getLayout + , getSize + , putLayout + ) + where + +import Control.Monad.State +import Data.Default.Class +import Graphics.Rendering.Chart.Easy hiding (plot) +import Graphics.Rendering.Chart.Backend.Cairo (FileOptions(..)) + +import Amby.Theme +import Amby.Style + +data AmbyState = AmbyState + { _asThemeState :: Theme + , _asLayoutState :: EC (Layout Double Double) () + , _asSize :: (Int, Int) + } + +instance Default AmbyState where + def = AmbyState + { _asThemeState = def + , _asLayoutState = do + setColors (getColorCycle def) + setThemeStyles def + , _asSize = _fo_size def + } + +$( makeLenses ''AmbyState) + +type AmbyChart a = State AmbyState a + +class AmbyContainer c a | c -> a where + plot :: c -> c -> AmbyChart () + plotEq :: c -> (a -> a) -> AmbyChart () + +getLayout :: AmbyState -> EC (Layout Double Double) () +getLayout s = s ^. asLayoutState + +getSize :: AmbyState -> (Int, Int) +getSize s = s ^. asSize + +takeTheme :: AmbyChart Theme +takeTheme = do + t <- use asThemeState + return t + +takeLayout :: AmbyChart (EC (Layout Double Double) ()) +takeLayout = do + l <- use asLayoutState + return l + +putLayout :: EC (Layout Double Double) () -> AmbyChart () +putLayout l = do + asLayoutState .= l + +theme :: Theme -> AmbyChart () +theme t = do + l <- use asLayoutState + asLayoutState .= do + l + setColors (getColorCycle t) + setThemeStyles t + asThemeState .= t + +xlim :: (Double, Double) -> AmbyChart () +xlim rs = do + l <- use asLayoutState + asLayoutState .= do + l + layout_x_axis . laxis_generate .= scaledAxis def rs + +ylim :: (Double, Double) -> AmbyChart () +ylim rs = do + l <- use asLayoutState + asLayoutState .= do + l + layout_y_axis . laxis_generate .= scaledAxis def rs + +size :: (Int, Int) -> AmbyChart () +size rs = do + l <- use asSize + asSize .= rs + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"