diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,17 @@ +# Ansigraph Changelog + +## Version 0.2 + +* Improved method of displaying animations so that successive frames overwrite previous ones instead of generating many pages of output. This requires the addition of the `graphHeight :: Graphable a => a -> Int` type class method. + +* Improved matrix graphing. Now there are distinct colors to represent positive and negative values, as well as real versus imaginary components. Examples added. + +* The `Coloring` data type representing possible terminal colorings has been changed to take `Maybe AnsiColor`s, where `Nothing` indicates use of the default terminal colors. + +* Some names have been changed for greater clarity and consistency. + +* Dependency bounds updated for GHC 8. + +## Version 0.1 + +Initial release. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,71 @@ +# ansigraph + +[![Build Status](https://travis-ci.org/BlackBrane/ansigraph.svg?branch=master)](https://travis-ci.org/BlackBrane/ansigraph) +[![Hackage](https://img.shields.io/hackage/v/ansigraph.svg)](http://hackage.haskell.org/package/ansigraph) +[![Ansigraph on Stackage Nightly](http://stackage.org/package/ansigraph/badge/nightly)](http://stackage.org/nightly/package/ansigraph) + + +__Terminal-based graphing via ANSI and Unicode__ + + + +### Overview + +Ansigraph is an ultralightweight terminal-based graphing utility. It uses Unicode characters and ANSI escape codes to display and animate colored graphs of vectors/functions in real and complex variables. + +Specifically we use the Unicode characters `▁▂▃▄▅▆▇█` which allow for graphing of quantities in units of 1/8. By utilizing ANSI SGR coloring codes, we can also include a region for negative values by using the same characters and swapping the foreground and background colors. There's also functionality for displaying matrices via the "density"-like characters `░▒▓█`. Both kinds of graphs have complex number versions, which show real and imaginary components separately with distinct colors. + +In all cases the resulting view is necessarily a rough one; the intended role of this library is to provide very easy, low-overhead, "quick and dirty" views of data sets when a more weighty graphing solution would be overkill. + +### Usage + +This functionality is provided by a `Graphable` type class, whose method `graphWith` draws a graph at the terminal. Another function `animateWith` takes a list of Graphable elements and displays an animation by rendering them in sequence. Both of these functions take an options record as an argument. The `graph` and `animate` functions are defined to use the default options, and the user can define similar functions based on their own settings. + +The package is intended to be used in one of two ways. + +Importing `System.Console.Ansigraph` provides all the functionality we typically use. This includes the _FlexibleInstances_ extension, which makes it marginally more convenient to use graphing functions by allowing instances like `Graphable [Double]`. + +If you want to use the package without activating _FlexibleInstances_ then you can import `System.Console.Ansigraph.Core`, which provides everything except these instances. Then you must use one of a few newtype wrappers, namely: `Graph`, `PosGraph`, `CGraph`, `Mat`, `CMat`. These wrappers are also available from the standard `Ansigraph` module. + +Some of these wrappers may be useful even when working from the main module because it indicates a particular kind of graph is to be used. For example, `PosGraph` holds the same kind of data as `Graph` but uses a graph style that assumes its data to be positive. For the same reason it may prove useful to define other wrapper data types when new approaches to terminal graphing are devised. + +### Examples + +A minimal example would be the following. + +``` +λ> import System.Console.Ansigraph +λ> let v = [1..30] :: [Double] +λ> graph v +▁▁▁▁▂▂▂▂▃▃▃▃▄▄▄▅▅▅▅▆▆▆▆▇▇▇▇██ + +``` + +Notice that the graph is always normalized relative to the maximum value present. +Since in this case our data is strictly-positive, we could have instead opted for the corresponding +positive graph style via `graph (PosGraph v)`, which would generate the same output except the blank +line at the bottom, corresponding to the empty negative region, would be absent. + +In the `Examples` module included in the package, we also define a complex exponential wave, +which is depicted at the top of this page. The static version is defined and graphed like this: + +``` +λ> import Data.Complex +λ> let wave = cis . (*) (pi/20) <$> [0..79] :: [Complex Double] +λ> graph wave +``` +To make an animation, we need a list of graphable elements. This one is created by multiplying the wave by _exp(it)_ in some units. + +``` +λ> let deltas = (*) (-pi/10) <$> [0..50] +λ> let waves = zipWith (\z -> map (* z)) (cis <$> deltas) $ replicate 50 wave +λ> animate waves +``` + +This produces the animation seen at the top of this page. + +### Future work + +Some of the type signatures could, and probably should be generalized, in particular to eliminate the need for annotating floating point types at the REPL, like I did above. I also plan to add support for sideways style graphs, like I use in my [probability](https://github.com/BlackBrane/probability) package. + +Of course, feedback and pull requests are welcome. diff --git a/ansigraph.cabal b/ansigraph.cabal --- a/ansigraph.cabal +++ b/ansigraph.cabal @@ -1,5 +1,5 @@ name: ansigraph -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Terminal-based graphing via ANSI and Unicode description: Ansigraph is an ultralightweight terminal-based graphing utility. It uses @@ -31,8 +31,7 @@ . The "System.Console.Ansigraph.Examples" module contains examples of all the - graph types with animations of various plane waves, and also shows the - available ANSI colors. + graph types, and also shows the available ANSI colors. homepage: https://github.com/BlackBrane/ansigraph @@ -40,15 +39,15 @@ license-file: LICENSE author: Cliff Harvey maintainer: cs.hbar+hs@gmail.com -copyright: 2015 +copyright: 2015-2016 Cliff Harvey category: Graphics build-type: Simple +extra-source-files: README.md, + CHANGELOG.md, + img/wavedemo.gif cabal-version: >=1.10 -source-repository head - type: git - location: git://github.com/BlackBrane/ansigraph.git library exposed-modules: System.Console.Ansigraph, @@ -60,6 +59,35 @@ System.Console.Ansigraph.Internal.Horizontal, System.Console.Ansigraph.Internal.Matrix - build-depends: base >=4.8 && <4.9, ansi-terminal >=0.6 && <0.7 + build-depends: base >=4.8 && <4.10, + ansi-terminal >=0.6 && <0.7 + hs-source-dirs: src + default-language: Haskell2010 + + ghc-options: -Wall + -fno-warn-orphans + -fno-warn-unused-do-bind + -fno-warn-missing-signatures + + +test-suite test-ansigraph + type: exitcode-stdio-1.0 + + hs-source-dirs: test + + main-is: test-ansigraph.hs + + default-language: Haskell2010 + + build-depends: base == 4.*, + ansigraph, + hspec == 2.*, + QuickCheck == 2.* + + +source-repository head + type: git + + location: git://github.com/BlackBrane/ansigraph.git diff --git a/img/wavedemo.gif b/img/wavedemo.gif new file mode 100644 Binary files /dev/null and b/img/wavedemo.gif differ diff --git a/src/System/Console/Ansigraph.hs b/src/System/Console/Ansigraph.hs --- a/src/System/Console/Ansigraph.hs +++ b/src/System/Console/Ansigraph.hs @@ -15,13 +15,12 @@ -- -- * __By directly importing "System.Console.Ansigraph.Core"__, which does not activate -- FlexibleInstances but includes everything else provided by the other module. This just means --- you must use one of a handful of newtype wrappers, namely: 'Graph', 'PosGraph', 'CGraph', --- 'Mat', 'CMat'. These wrappers are also available from the standard module. +-- you must use one of a few newtype wrappers, namely: 'Graph', 'PosGraph', 'CGraph', +-- 'Mat', 'CMat'. They are also available from the standard module. module System.Console.Ansigraph ( - module System.Console.Ansigraph.Internal.FlexInstances - , module System.Console.Ansigraph.Core + module System.Console.Ansigraph.Core ) where import System.Console.Ansigraph.Core -import System.Console.Ansigraph.Internal.FlexInstances +import System.Console.Ansigraph.Internal.FlexInstances () diff --git a/src/System/Console/Ansigraph/Core.hs b/src/System/Console/Ansigraph/Core.hs --- a/src/System/Console/Ansigraph/Core.hs +++ b/src/System/Console/Ansigraph/Core.hs @@ -11,42 +11,50 @@ -- 'Graphable [Double]'. -- -- --- * __By directly importing "System.Console.Ansigraph.Core"__, which does not activate FlexibleInstances but --- includes everything else provided by the other module. This just means you must use one of a --- handful of newtype wrappers, namely: 'Graph', 'PosGraph', 'CGraph', 'Mat', 'CMat'. --- These wrappers are also available from the standard module. +-- * __By directly importing "System.Console.Ansigraph.Core"__, which does not activate +-- FlexibleInstances but includes everything else provided by the other module. This just means +-- you must use one of a few newtype wrappers, namely: 'Graph', 'PosGraph', 'CGraph', +-- 'Mat', 'CMat'. They are also available from the standard module. module System.Console.Ansigraph.Core ( -- * Core Functionality - -- *** The Graphable class - Graphable (graphWith) + -- ** The Graphable class + Graphable (..) , graph , animateWith , animate + , transientAnim + , transientAnimWith -- *** Graphing options - , AGSettings (..) + , GraphSettings (..) -- *** Default options , graphDefaults - , blue, pink, white + , blue, pink, white, red, green + , noColoring -- *** ANSI data , AnsiColor (..) , Coloring (..) -- *** ANSI helpers + , mkColoring + , fromFG + , fromBG , realColors , imagColors , colorSets , invert - , setFG - , setBG - , lineClear + , interpAnsiColor + , setColor , clear - , applyColor + , clearLn + , applyColoring , colorStr , colorStrLn + , boldStr + , boldStrLn -- * Graphable wrapper types , Graph (..) @@ -56,21 +64,24 @@ , CMat (..) -- * Graphing - -- *** Horizontal vector graphing + -- *** Horizontal vector graphing (IO actions) + , displayPV , displayRV , displayCV - , displayPV - , simpleRender - , simpleRenderR + -- *** Horizontal rendering logic (producing strings) + , renderPV + , renderRV + , renderCV + -- *** Matrix graphing - , matShow , displayMat , displayCMat + , matShow -- *** Simple (non-ANSI) graphing for strictly-positive data - , posgraph - , posanim + , posGraph + , posAnim ) where @@ -79,34 +90,39 @@ import System.Console.Ansigraph.Internal.Matrix import System.Console.ANSI -import System.IO (hFlush,stdout) import Control.Concurrent (threadDelay) -import Data.List (intersperse,transpose) -import Data.Complex (Complex,realPart,imagPart,magnitude) +import Control.Monad (replicateM_) +import Data.Complex (Complex) --- | Things that ansigraph knows how to render at the terminal are --- instances of this class. +-- | Things that ansigraph knows how to render at the terminal are instances of this class. +-- +-- In general, when ANSI codes are involved, a 'graphWith' method should fush stdout when +-- finished, and whenever codes are invoked to i.e. change terminal colors. This is easily +-- handled by defining it in terms of 'colorStr' and 'colorStrLn'. +-- +-- The 'graphHeight' function specifies how many vertical lines a graph occupies and is +-- needed for animations to work properly class Graphable a where - graphWith :: AGSettings -> a -> IO () + -- | Render a graph to standard output. + graphWith :: GraphSettings -> a -> IO () + + -- | The number of vertical lines a graph occupies. + graphHeight :: a -> Int + -- | Invokes the 'Graphable' type class method 'graphWith' with the --- default 'AGSettings' record, 'graphDefaults'. +-- default 'GraphSettings' record, 'graphDefaults'. graph :: Graphable a => a -> IO () graph = graphWith graphDefaults ---- IO / ANSI helpers ---- --- | Pauses for the specified number of µs. -pauseFor :: Int -> IO () -pauseFor n = hFlush stdout >> threadDelay n - --- | 'pauseFor' some time interval, then clear screen and set the cursor at (0,0). -next :: Int -> IO () -next n = do pauseFor n - clearScreen - setCursorPosition 0 0 +clearBack :: Int -> IO () +clearBack n = do + putStr "\r" -- return cursor to horizontal position 0 + replicateM_ n (cursorUpLine 1 *> clearLine) -- | For some number of frames per second, return the corresponding time delta in microseconds. deltaFromFPS :: Int -> Int @@ -115,59 +131,82 @@ ---- Animation ---- +clearGraph :: Graphable a => a -> IO () +clearGraph = clearBack . graphHeight + +animationFrame :: Graphable a => GraphSettings -> a -> IO () +animationFrame s x = do + graphWith s x + threadDelay . deltaFromFPS . framerate $ s + clearGraph x + -- | Any list of a 'Graphable' type can be made into an animation, by -- 'graph'ing each element with a time delay and screen-clear after each. --- 'AGSettings' are used to determine the time delta and any coloring/scaling options. -animateWith :: Graphable a => AGSettings -> [a] -> IO () -animateWith s xs = let delta = deltaFromFPS $ framerate s in - sequence_ $ intersperse (next delta) (graphWith s <$> xs) +-- 'GraphSettings' are used to determine the time delta and any coloring/scaling options. +animateWith :: Graphable a => GraphSettings -> [a] -> IO () +animateWith _ [] = return () +animateWith s [x] = graphWith s x +animateWith s (x:y:zs) = animationFrame s x *> animateWith s (y:zs) -- | Perform 'animateWith' using default options. Equivalent to 'graph'ing each member -- of the supplied list with a short delay and screen-clear after each. animate :: Graphable a => [a] -> IO () animate = animateWith graphDefaults +-- | Like 'animateWith', only it does not leave the final frame of the animation visible. +transientAnimWith :: Graphable a => GraphSettings -> [a] -> IO () +transientAnimWith = mapM_ . animationFrame +-- | Like 'animate', only it does not leave the final frame of the animation visible. +transientAnim :: Graphable a => [a] -> IO () +transientAnim = transientAnimWith graphDefaults + + ---- Wrappers to avoid needing FlexibleInstances ---- --- | Wrapper type for graph of a real vector/function +-- | Wrapper type for graph of a real vector/function. newtype Graph = Graph { unGraph :: [Double] } --- | Wrapper type for graph of a complex vector/function +-- | Wrapper type for graph of a complex vector/function. newtype CGraph = CGraph { unCGraph :: [Complex Double] } --- | Wrapper type for graph of a non-negative real vector/function +-- | Wrapper type for graph of a non-negative real vector/function. newtype PosGraph = PosGraph { unPosGraph :: [Double] } --- | Wrapper type for graph of a real two-index vector/two-argument function +-- | Wrapper type for graph of a real two-index vector/two-argument function. newtype Mat = Mat { unMat :: [[Double]] } --- | Wrapper type for graph of a complex two-index vector/two-argument function +-- | Wrapper type for graph of a complex two-index vector/two-argument function. newtype CMat = CMat { unCMat :: [[Complex Double]] } instance Graphable Graph where graphWith s = displayRV s . unGraph + graphHeight _ = 2 instance Graphable CGraph where graphWith s = displayCV s . unCGraph + graphHeight _ = 4 instance Graphable PosGraph where graphWith s = displayPV s . unPosGraph + graphHeight _ = 1 instance Graphable Mat where graphWith s = displayMat s . unMat + graphHeight = length . unMat instance Graphable CMat where graphWith s = displayCMat s . unCMat + graphHeight = length . unCMat ---- helpers for graphing/animating strictly-positive real functions ---- -- | Display a graph of the supplied (non-negative) real vector. -posgraph :: [Double] -> IO () -posgraph = graph . PosGraph +posGraph :: [Double] -> IO () +posGraph = graph . PosGraph -- | Display an animation of the supplied list of (non-negative) real vectors. -posanim :: [[Double]] -> IO () -posanim = animate . map PosGraph +posAnim :: [[Double]] -> IO () +posAnim = animate . map PosGraph diff --git a/src/System/Console/Ansigraph/Examples.hs b/src/System/Console/Ansigraph/Examples.hs --- a/src/System/Console/Ansigraph/Examples.hs +++ b/src/System/Console/Ansigraph/Examples.hs @@ -1,32 +1,42 @@ --- | A module that exports some simple demonstrations of how to use the package. +-- | A module that shows some simple examples demonstrating how to use the package. module System.Console.Ansigraph.Examples ( - waveDemo - , waveDemoR - , waveDemoP + + demo + , legend , showColors - , demo + +-- * Horizontal graphs + , waveDemoComplex + , waveDemoReal + , waveDemoPositive , wave + +-- * Matrix graphs + + , matDemoReal + , matDemoComplex + , unitary + ) where import System.Console.Ansigraph + import System.Console.ANSI -import Control.Monad (forM_) -import Data.Complex +import Control.Monad (forM_) +import Data.Complex (Complex (..), cis, realPart) ---- Wave Demo ---- +-- | A complex wave vector, part of the graph of /z(x,t) = exp(ix - it)/ in some units. wave :: [Complex Double] wave = cis . (*) (pi/20) <$> [0..79] deltas :: [Double] -deltas = (*) (-pi/10) <$> [0..50] +deltas = (*) (-pi/10) <$> [0..80] waves :: [[Complex Double]] -waves = zipWith (\z -> map (* z)) (cis <$> deltas) $ replicate 50 wave - -pwave :: PosGraph -pwave = PosGraph $ (+1) . realPart <$> wave +waves = zipWith (\z -> map (* z)) (cis <$> deltas) $ repeat wave rwaves :: [[Double]] rwaves = map (map realPart) waves @@ -35,34 +45,168 @@ pwaves = PosGraph . map (+1) <$> rwaves -- | Display an animation of the positive real function /p(x,t) = cos(x-t) + 1/ in some units. -waveDemoP :: IO () -waveDemoP = animate pwaves +waveDemoPositive :: IO () +waveDemoPositive = animate pwaves -- | Display an animation of the real function /r(x,t) = cos(x-t)/ in the standard style, i.e. with both -- positive and negative regions. -waveDemoR :: IO () -waveDemoR = animate rwaves +waveDemoReal :: IO () +waveDemoReal = animate rwaves -- | Display an animation of the complex wave /z(x,t) = exp(ix - it)/ in some units. -waveDemo :: IO () -waveDemo = animate waves +waveDemoComplex :: IO () +waveDemoComplex = animate waves +---- Matrix Demos ---- + +vscale :: Num a => a -> [a] -> [a] +vscale x = map (* x) + +mscale :: Num a => a -> [[a]] -> [[a]] +mscale x = map $ map (* x) + + +-- The following is a quick implementation of the matrix tensor product ('mox'). +-- The details are not relevant to the library, but are only used for this example. + +fromRealVs :: [Double] -> [Double] -> [Complex Double] +fromRealVs = zipWith (:+) + +fromRealMs :: [[Double]] -> [[Double]] -> [[Complex Double]] +fromRealMs = zipWith fromRealVs + +vox :: Num a => [a] -> [a] -> [a] +vox v w = concat $ map (flip vscale w) v + +-- matrix tensor product +stepOne, stepTwo, mox :: Num a => [[a]] -> [[a]] -> [[a]] +stepOne m1 m2 = concat $ map (replicate (length m2)) m1 +stepTwo m1 m2 = concat $ replicate (length m1) m2 +mox m1 m2 = zipWith vox (stepOne m1 m2) (stepTwo m1 m2) + + +---- Complex matrix example ---- + +sx, sz, sI :: [[Double]] +sz = [[1,0],[0,-1]] +sx = [[0,1],[1,0]] +sI = [[1,0],[0,1]] + +-- Time-exponentials of pauli matrices +-- exp(itσ) = cos(t)I + i sin(t)σ +sinSX, sinSZ :: Double -> [[Complex Double]] +sinSX t = fromRealMs (mscale (cos t) sI) (mscale (sin t) sx) +sinSZ t = fromRealMs (mscale (cos t) sI) (mscale (sin t) sz) + +-- | An example of a time-dependent complex matrix. +unitary :: Double -> [[Complex Double]] +unitary t = sinSZ t `mox` sinSX (2*t) + +slowDeltas :: [Double] +slowDeltas = (*) (pi/50) <$> [0..100] + +-- | Shows an animation of an example time-dependent matrix formed from Pauli matrices, called +-- 'unitary'. Specifically, it is the tensor product of σz and σx exponentiated with different +-- frequencies. +matDemoComplex :: IO () +matDemoComplex = animate $ unitary <$> slowDeltas + + +---- Real matrix example ---- + +ry :: Double -> [[Double]] +ry t = [[cos t, 0, (sin t)] + ,[0, 1, 0] + ,[-(sin t),0,cos t]] + +-- | An example real matrix animation. +matDemoReal :: IO () +matDemoReal = animate $ (\t -> ry t `mox` ry (2*t)) <$> slowDeltas + + ---- Show ANSI Colors ---- colors = [Black,Red,Green,Yellow,Blue,Magenta,Cyan,White] intensities = [Dull,Vivid] --- | Show all of the available 'AnsiColor's and corresponding 'ColorIntensity', 'Color' pairs. +ansicolors :: [AnsiColor] +ansicolors = [ AnsiColor i c | c <- colors, i <- intensities ] + +-- | Show all of the available 'AnsiColor's with corresponding 'ColorIntensity', 'Color' pairs. showColors = do - putStrLn "\n Available colors:" - forM_ colors $ \clr -> do - forM_ intensities $ \inten -> do - setSGR [SetColor Foreground inten clr] - putStr $ replicate 20 '█' - setSGR [Reset] - putStrLn $ " " ++ show inten ++ " " ++ show clr + boldStrLn noColoring "Available colors" + newline + forM_ ansicolors $ \c -> do + let clr = Coloring Nothing (Just c) + colorStr clr $ replicate 20 ' ' + putStrLn $ " " ++ show (intensity c) ++ " " ++ show (color c) setSGR [Reset] +cb, bc :: Coloring +cb = mkColoring (AnsiColor Dull Black) (AnsiColor Vivid Cyan) +bc = invert cb + +newline = putStrLn "" + +verticalPad io = do + newline + io + newline + newline + +-- | Displays a legend showing color conventions for supported graph types. +legend = do + boldStrLn cb " Legend " + newline + + boldStrLn noColoring "Horizontal Graphs" + newline + colorStr (fromBG blue) " " + putStrLn " Real component (positive and negative)" + newline + colorStr (fromBG pink) " " + putStrLn " Imag component (positive and negative)" + newline + + boldStrLn noColoring "Matrix Graphs" + newline + putStr " " + colorStr (mkColoring white pink) "+i" + putStrLn " " + colorStr (mkColoring white red) "-r" + putStr " " + colorStrLn (mkColoring white blue) "+r" + putStr " " + colorStr (mkColoring white green) "-i" + putStrLn " " + + -- | Run all of the demos in sequence. -demo = sequence_ [waveDemoP,waveDemoR,waveDemo,showColors] +demo = do + + verticalPad $ boldStrLn cb " Ansigraph demo " + + putStr "Positive function graph " + colorStrLn bc " cos (x - t) + 1 " + verticalPad waveDemoPositive + + putStr "Real function graph " + colorStrLn bc " cos (x - t) " + verticalPad waveDemoReal + + putStr "Complex function graph " + colorStrLn bc " exp (ix - it) " + verticalPad waveDemoComplex + + putStr "Real matrix graph " + colorStrLn bc " rotate_Y(t) ⊗ rotate_Y(2t) " + verticalPad matDemoReal + + putStr "Complex matrix graph " + colorStrLn bc " exp (it σz) ⊗ exp (2it σx) " + verticalPad matDemoComplex + + verticalPad showColors + + verticalPad legend diff --git a/src/System/Console/Ansigraph/Internal/Core.hs b/src/System/Console/Ansigraph/Internal/Core.hs --- a/src/System/Console/Ansigraph/Internal/Core.hs +++ b/src/System/Console/Ansigraph/Internal/Core.hs @@ -1,107 +1,152 @@ -module System.Console.Ansigraph.Internal.Core ( - AnsiColor (..) - , AGSettings (..) - , blue, pink, white - , graphDefaults - , Coloring (..) - , realColors - , imagColors - , colorSets - , invert - , setFG - , setBG - , lineClear - , clear - , applyColor - , colorStr - , colorStrLn -) where +-- | Core functionality of the package. Import from either "System.Console.Ansigraph" or +-- "System.Console.Ansigraph.Core". +module System.Console.Ansigraph.Internal.Core where import System.Console.ANSI import System.IO (hFlush, stdout) ---- Basics ---- --- | ANSI colors are characterized by a 'Color' and a 'ColorIntensity'. This --- data type holds one of each. -data AnsiColor = AnsiColor ColorIntensity Color deriving Show +-- | ANSI colors are characterized by a 'Color' and a 'ColorIntensity'. +data AnsiColor = AnsiColor { + intensity :: ColorIntensity + , color :: Color + } deriving Show -- | Record that holds graphing options. -data AGSettings = - AGSettings - { - -- | Foreground color for real number component +data GraphSettings = GraphSettings { + + -- | Foreground color for real number component. realColor :: AnsiColor -- | Foreground color for imaginary number component. , imagColor :: AnsiColor + -- | Foreground color for negative real values. For matrix graphs only. + , realNegColor :: AnsiColor + -- | Foreground color for negative imaginary values. For matrix graphs only. + , imagNegColor :: AnsiColor -- | Background color for real number component. - , realBG :: AnsiColor + , realBG :: AnsiColor -- | Background color for imaginary number component. - , imagBG :: AnsiColor - -- | Framerate in fps. + , imagBG :: AnsiColor + -- | Framerate in FPS. , framerate :: Int - -- | How to rescale the size of a vector before displaying it - -- (which is not implemented yet). - , scaling :: (Int -> Int) + } -blue = AnsiColor Vivid Blue -pink = AnsiColor Vivid Magenta -white = AnsiColor Vivid White -graphDefaults = AGSettings blue pink white white 15 (max 150) +-- | 'Vivid' 'Blue' – used as the default real foreground color. +blue = AnsiColor Vivid Blue --- | Holds two 'AnsiColor's representing foreground and background colors for display via ANSI. -data Coloring = Coloring AnsiColor AnsiColor deriving Show +-- | 'Vivid' 'Magenta' – used as the default foreground color for imaginary +-- graph component. +pink = AnsiColor Vivid Magenta +-- | 'Vivid' 'White' – used as the default graph background color +-- for both real and imaginary graph components. +white = AnsiColor Vivid White + +-- | 'Vivid' 'Red' – used as the default foreground color for negative real component. +red = AnsiColor Vivid Red + +-- | 'Dull' 'Green' – used as the default foreground color for negative imaginary component. +green = AnsiColor Dull Green + +-- | Default graph settings. +graphDefaults = GraphSettings blue pink red green white white 15 + +-- | Holds two 'Maybe' 'AnsiColor's representing foreground and background colors for display via ANSI. +-- 'Nothing' means use the default terminal color. +data Coloring = Coloring { foreground :: Maybe AnsiColor, + background :: Maybe AnsiColor } deriving Show + +-- | A 'Coloring' representing default terminal colors, i.e. two 'Nothing's. +noColoring = Coloring Nothing Nothing + +-- | Helper constructor function for 'Coloring' that takes straight 'AnsiColor's without 'Maybe'. +mkColoring :: AnsiColor -> AnsiColor -> Coloring +mkColoring c1 c2 = Coloring (Just c1) (Just c2) + -- | Projection retrieving foreground and background colors -- for real number graphs in the form of a 'Coloring'. -realColors :: AGSettings -> Coloring -realColors sets = Coloring (realColor sets) (realBG sets) +realColors :: GraphSettings -> Coloring +realColors s = mkColoring (realColor s) (realBG s) -- | Projection retrieving foreground and background colors -- for imaginary component of complex number graphs in the form of a 'Coloring'. -imagColors :: AGSettings -> Coloring -imagColors sets = Coloring (imagColor sets) (imagBG sets) +imagColors :: GraphSettings -> Coloring +imagColors s = mkColoring (imagColor s) (imagBG s) -- | Retrieves a pair of 'Coloring's for real and imaginary graph components respectively. -colorSets :: AGSettings -> (Coloring,Coloring) -colorSets s = (Coloring (realColor s) (realBG s), Coloring (imagColor s) (imagBG s)) +colorSets :: GraphSettings -> (Coloring,Coloring) +colorSets s = (realColors s, imagColors s) -- | Swaps foreground and background colors within a 'Coloring'. invert :: Coloring -> Coloring invert (Coloring fg bg) = Coloring bg fg --- | 'SGR' command to set the foreground to the specified 'AnsiColor'. -setFG :: AnsiColor -> SGR -setFG (AnsiColor ci c) = SetColor Foreground ci c +-- | The SGR command corresponding to a particular 'ConsoleLayer' and 'AnsiColor'. +interpAnsiColor :: ConsoleLayer -> AnsiColor -> SGR +interpAnsiColor l (AnsiColor i c) = SetColor l i c --- | 'SGR' command to set the background to the specified 'AnsiColor'. -setBG :: AnsiColor -> SGR -setBG (AnsiColor ci c) = SetColor Background ci c +-- | Set the given 'AnsiColor' on the given 'ConsoleLayer'. +setColor :: ConsoleLayer -> AnsiColor -> IO () +setColor l c = setSGR [interpAnsiColor l c] --- | Clear any SGR settings, then print a new line and flush stdout. -lineClear :: IO () -lineClear = setSGR [Reset] >> putStrLn "" >> hFlush stdout +-- | Easily create a 'Coloring' by specifying the background 'AnsiColor' and no custom foreground. +fromBG :: AnsiColor -> Coloring +fromBG c = Coloring Nothing (Just c) +-- | Easily create a 'Coloring' by specifying the foreground 'AnsiColor' and no custom background. +fromFG :: AnsiColor -> Coloring +fromFG c = Coloring (Just c) Nothing + +-- | Produce a (possibly empty) list of 'SGR' commands from a 'ConsoleLayer' and 'AnsiColor'. +-- An empty 'SGR' list is equivalent to 'Reset'. +sgrList :: ConsoleLayer -> Maybe AnsiColor -> [SGR] +sgrList l = fmap (interpAnsiColor l) . maybe [] (\x -> [x]) + +-- | Apply both foreground and background color contained in a 'Coloring'. +applyColoring :: Coloring -> IO () +applyColoring (Coloring fg bg) = do + setSGR [Reset] + setSGR $ sgrList Foreground fg ++ sgrList Background bg + -- | Clear any SGR settings and then flush stdout. clear :: IO () -clear = setSGR [Reset] >> hFlush stdout +clear = setSGR [Reset] *> hFlush stdout --- | Apply both foreground and background color. -applyColor :: Coloring -> IO () -applyColor (Coloring fg bg) = setSGR [setFG fg, setBG bg] +-- | Clear any SGR settings, flush stdout and print a new line. +clearLn :: IO () +clearLn = clear *> putStrLn "" --- | Use a particular ANSI 'Coloring' to print a string at the terminal (without a newline), +-- | Use a particular ANSI 'Coloring' to print a string at the terminal (without a new line), -- then clear all ANSI SGR codes and flush stdout. colorStr :: Coloring -> String -> IO () -colorStr c s = do applyColor c - putStr s - clear +colorStr c s = do + applyColoring c + putStr s + clear -- | Use a particular ANSI 'Coloring' to print a string at the terminal, --- then clear all ANSI SGR codes, print a newline and flush stdout. +-- then clear all ANSI SGR codes, flush stdout and print a new line. colorStrLn :: Coloring -> String -> IO () -colorStrLn c s = do applyColor c - putStr s - lineClear +colorStrLn c s = do + applyColoring c + putStr s + clearLn + +-- | Like 'colorStr' but prints bold text. +boldStr :: Coloring -> String -> IO () +boldStr c s = do + applyColoring c + setSGR [SetConsoleIntensity BoldIntensity] + putStr s + clear + +-- | Like 'colorStrLn' but prints bold text. +boldStrLn :: Coloring -> String -> IO () +boldStrLn c s = do + applyColoring c + setSGR [SetConsoleIntensity BoldIntensity] + putStr s + clearLn diff --git a/src/System/Console/Ansigraph/Internal/FlexInstances.hs b/src/System/Console/Ansigraph/Internal/FlexInstances.hs --- a/src/System/Console/Ansigraph/Internal/FlexInstances.hs +++ b/src/System/Console/Ansigraph/Internal/FlexInstances.hs @@ -1,19 +1,30 @@ {-# LANGUAGE FlexibleInstances #-} +-- | 'Graphable' Instances for lists of real or complex floating point numbers. +-- Users FlexibleInstances. module System.Console.Ansigraph.Internal.FlexInstances where import System.Console.Ansigraph.Core + import Data.Complex +-- | 1-dimensional real vector graph. instance Graphable [Double] where graphWith = displayRV + graphHeight _ = 2 +-- | 1-dimensional complex vector graph. instance Graphable [Complex Double] where graphWith = displayCV + graphHeight _ = 4 +-- | 2-dimensional real matrix graph. instance Graphable [[Double]] where graphWith = displayMat + graphHeight = length +-- | 2-dimensional complex matrix graph. instance Graphable [[Complex Double]] where graphWith = displayCMat + graphHeight = length diff --git a/src/System/Console/Ansigraph/Internal/Horizontal.hs b/src/System/Console/Ansigraph/Internal/Horizontal.hs --- a/src/System/Console/Ansigraph/Internal/Horizontal.hs +++ b/src/System/Console/Ansigraph/Internal/Horizontal.hs @@ -1,18 +1,20 @@ +-- | Functionality for graphing 1-dimensional vectors. module System.Console.Ansigraph.Internal.Horizontal ( displayRV , displayCV , displayPV - , simpleRender - , simpleRenderR + , renderPV + , renderRV + , renderCV ) where import System.Console.Ansigraph.Internal.Core + import Data.Complex -import System.IO (hFlush, stdout) ---- Graphing Infrastructure ---- -barChars = "█▇▆▅▄▃▂▁" +barChars = "█▇▆▅▄▃▂▁ " -- These values delineate regions for rounding to the nearest 1/8. barVals :: [Double] @@ -23,34 +25,41 @@ for positive and negative graph regions respectively -} bars, barsR :: [(Double,Char)] -bars = zipWith (,) barVals barChars +bars = zip barVals barChars -barsR = zipWith (,) barVals (reverse barChars) +barsR = zip barVals (reverse barChars) selectBar, selectBarR :: Double -> Char -selectBar x = let l = filter (\p -> fst p < x) bars in case l of - [] -> ' ' - (p:ss) -> snd p +selectBar x = let l = filter (\p -> fst p < x) bars in + case l of + [] -> ' ' + (p:_) -> snd p -selectBarR x = let l = filter (\p -> fst p < x) barsR in case l of - [] -> '█' - (p:ss) -> snd p +selectBarR x = let l = filter (\p -> fst p < x) barsR in + case l of + [] -> '█' + (p:_) -> snd p --- | Simple vector rendering. Yields a string of unicode chars representing graph bars --- varying in units of 1/8. To be primarily invoked via 'graph', 'graphWith', --- 'animate', 'animateWith'. -simpleRender :: [Double] -> String -simpleRender xs = let mx = maximum xs in - (selectBar . (/mx)) <$> xs --- | Simple vector rendering – inverted version. Rarely used directly. --- It is needed to render negative graph regions. -simpleRenderR :: [Double] -> String -simpleRenderR xs = let mx = maximum xs in - (selectBarR . (/mx)) <$> xs +-- | Simple vector to String rendering that assumes positive input. Yields String of Unicode chars +-- representing graph bars varying in units of 1/8. The IO 'display' functions are preferable +-- for most use cases. +renderPV :: [Double] -> String +renderPV xs = let mx = maximum (filter (>= 0) $ 0:xs) in + (selectBar . (/mx)) <$> xs +-- | Simple real vector rendering as a pair of strings. The IO 'display' functions are +-- preferable for most use cases. +renderRV :: [Double] -> (String,String) +renderRV l = let rp = l + rm = negate <$> rp + mx = maximum $ rp ++ rm + in (selectBar . (/mx) <$> rp, + selectBarR . (/mx) <$> rm) +-- | Simple complex vector rendering as a pair of strings. The IO 'display' functions are +-- preferable for most use cases. renderCV :: [Complex Double] -> (String,String,String,String) renderCV l = let rp = realPart <$> l rm = negate <$> rp @@ -62,33 +71,27 @@ selectBar . (/mx) <$> ip, selectBarR . (/mx) <$> im) -renderRV :: [Double] -> (String,String) -renderRV l = let rp = l - rm = negate <$> rp - mx = maximum $ rp ++ rm - in (selectBar . (/mx) <$> rp, - selectBarR . (/mx) <$> rm) --- | ANSI based display for complex vectors. To be primarily invoked via 'graph', 'graphWith', +-- | ANSI based display for positive real vectors. Primarily invoked via 'graph', 'graphWith', -- 'animate', 'animateWith'. -displayCV :: AGSettings -> [Complex Double] -> IO () -displayCV s l = let (rp,rm,ip,im) = renderCV l - (rcol,icol) = colorSets s - in do colorStrLn rcol rp - colorStrLn (invert rcol) rm - colorStrLn icol ip - colorStrLn (invert icol) im +displayPV :: GraphSettings -> [Double] -> IO () +displayPV s l = let (rp,_) = renderRV l + rcol = realColors s in colorStrLn rcol rp --- | ANSI based display for real vectors. To be primarily invoked via 'graph', 'graphWith', +-- | ANSI based display for real vectors. Primarily invoked via 'graph', 'graphWith', -- 'animate', 'animateWith'. -displayRV :: AGSettings -> [Double] -> IO () +displayRV :: GraphSettings -> [Double] -> IO () displayRV s l = let (rp,rm) = renderRV l - rcol = realColors s + rcol = realColors s in do colorStrLn rcol rp colorStrLn (invert rcol) rm --- | ANSI based display for positive real vectors. To be primarily invoked via 'graph', 'graphWith', +-- | ANSI based display for complex vectors. Primarily invoked via 'graph', 'graphWith', -- 'animate', 'animateWith'. -displayPV :: AGSettings -> [Double] -> IO () -displayPV s l = let (rp,_) = renderRV l - rcol = realColors s in colorStrLn rcol rp +displayCV :: GraphSettings -> [Complex Double] -> IO () +displayCV s l = let (rp,rm,ip,im) = renderCV l + (rcol,icol) = colorSets s + in do colorStrLn rcol rp + colorStrLn (invert rcol) rm + colorStrLn icol ip + colorStrLn (invert icol) im diff --git a/src/System/Console/Ansigraph/Internal/Matrix.hs b/src/System/Console/Ansigraph/Internal/Matrix.hs --- a/src/System/Console/Ansigraph/Internal/Matrix.hs +++ b/src/System/Console/Ansigraph/Internal/Matrix.hs @@ -1,11 +1,15 @@ +-- | Functionality for graphing 2-dimensional matrices. module System.Console.Ansigraph.Internal.Matrix ( matShow , displayMat , displayCMat ) where + import System.Console.Ansigraph.Internal.Core + import Data.Complex +import Data.List (intersperse) ---- Matrices ---- @@ -21,41 +25,61 @@ densityVals = (+ 0.125) . (/4) <$> [3,2,1,0] -- = [7/8, 5/8, 3/8, 1/8] -blocks, blocksR :: [(Double,Char)] -blocks = zipWith (,) densityVals densityChars +blocks :: [(Double,Char)] +blocks = zip densityVals densityChars -blocksR = zipWith (,) densityVals (reverse densityChars) +data MatElement = MatElement !Bool {-# UNPACK #-} !Char +elemChar :: MatElement -> Char +elemChar (MatElement _ c) = c -selectBlock :: Double -> Char -selectBlock x = let l = filter (\p -> fst p < abs x) blocks in case l of - [] -> ' ' - (p:ss) -> snd p +putRealElement :: GraphSettings -> MatElement -> IO () +putRealElement s (MatElement b c) = colorStr clring (c : " ") + where clr = if b then realNegColor s else realColor s + clring = mkColoring clr (realBG s) + +putImagElement :: GraphSettings -> MatElement -> IO () +putImagElement s (MatElement b c) = colorStr clring $ c : " " + where clr = if b then imagNegColor s else imagColor s + clring = mkColoring clr (imagBG s) + +selectMatElement :: Double -> MatElement +selectMatElement x = let l = filter (\p -> fst p < abs x) blocks in case l of + [] -> MatElement False ' ' + (p:_) -> MatElement (x < 0) (snd p) + + +matElements :: [[Double]] -> [[MatElement]] +matElements m = let mx = mmax m + in mmap (selectMatElement . (/ mx)) m + -- | Given a matrix of Doubles, return the list of strings illustrating the absolute value -- of each entry relative to the largest, via unicode chars that denote a particular density. +-- Used for testing purposes. matShow :: [[Double]] -> [String] -matShow m = let mx = mmax m - in mmap (selectBlock . (/ mx)) m +matShow = mmap elemChar . matElements --- | Use ANSI coloring (specified by an 'AGSettings') to visually display a Real matrix. -displayMat :: AGSettings -> [[Double]] -> IO () -displayMat s = mapM_ (colorStrLn (realColors s)) . matShow +newline = putStrLn "" +intersperse' x l = intersperse x l ++ [x] -matShow_Imag :: [[Complex Double]] -> [String] -matShow_Imag m = let mx = max (mmax $ mmap realPart m) - (mmax $ mmap imagPart m) - in mmap (selectBlock . (/ mx) . imagPart) m -matShow_Real :: [[Complex Double]] -> [String] -matShow_Real m = let mx = max (mmax $ mmap realPart m) - (mmax $ mmap imagPart m) - in mmap (selectBlock . (/ mx) . realPart) m +-- | Use ANSI coloring (specified by an 'GraphSettings') to visually display a Real matrix. +displayMat :: GraphSettings -> [[Double]] -> IO () +displayMat s = sequence_ . concat . intersperse' [newline] . displayRealMat s --- | Use ANSI coloring (specified by an 'AGSettings') to visually display a Complex matrix. -displayCMat :: AGSettings -> [[Complex Double]] -> IO () -displayCMat s m = sequence_ $ - zipWith (\x y -> x >> putStr " " >> y) - (colorStr (realColors s) <$> matShow_Real m) - (colorStrLn (imagColors s) <$> matShow_Imag m) +-- | Use ANSI coloring (specified by a 'GraphSettings') to visually display a Real matrix. +displayRealMat :: GraphSettings -> [[Double]] -> [[IO ()]] +displayRealMat s = mmap (putRealElement s) . matElements + +-- | Use ANSI coloring (specified by a 'GraphSettings') to visually display a Real matrix. +displayImagMat :: GraphSettings -> [[Double]] -> [[IO ()]] +displayImagMat s = mmap (putImagElement s) . matElements + +-- | Use ANSI coloring (specified by an 'GraphSettings') to visually display a Complex matrix. +displayCMat :: GraphSettings -> [[Complex Double]] -> IO () +displayCMat s m = sequence_ . concat . intersperse' [newline] $ + zipWith (\xs ys -> xs ++ putStr " " : ys) + (displayRealMat s $ mmap realPart m) + (displayImagMat s $ mmap imagPart m) diff --git a/test/test-ansigraph.hs b/test/test-ansigraph.hs new file mode 100644 --- /dev/null +++ b/test/test-ansigraph.hs @@ -0,0 +1,157 @@ +module Main where + +import Test.Hspec +import Test.QuickCheck +import System.Console.Ansigraph +import System.Console.Ansigraph.Examples (wave) +import Data.Complex +import Data.Char (isSpace) + + +---- For horizontal graphing tests ---- + +bars = " ▁▂▃▄▅▆▇█" + +eighths :: [Double] +eighths = (/8) <$> [0..8] + +{- These two vectors have a maximum element of 8, to maintain a particular normalization, + while displacing other entries by just under one half. Both vectors should display + as █▇▆▅▄▃▂▁. Same idea for m1, m_hi, m_low below. -} + +v_hi :: [Double] +v_hi = 8 : map (+0.48) (reverse [0..7]) + +v_low :: [Double] +v_low = 8 : map (\x -> x - 0.48) (reverse [0..7]) + +{- These functions are for testing the property that: + simpleRender v == complement <$> simpleRenderR v-} + +-- the 'complement' of a particular bar character is the one representing the negation of the +-- corresponding numeric value (when displayed with reversed foreground/background colors). +complement :: Char -> Char +complement c = match c bars (reverse bars) + +match :: Eq a => a -> [a] -> [a] -> a +match x (y:ys) (z:zs) = if x == y then z else match x ys zs + + +rwave = realPart <$> wave + +barInvert :: (String,String) -> (String,String) +barInvert (x,y) = (complement <$> y, complement <$> x) + +barInvertC :: (String,String,String,String) -> (String,String,String,String) +barInvertC (x1,y1,x2,y2) = (complement <$> y1, + complement <$> x1, + complement <$> y2, + complement <$> x2) + +---- For matrix graphing tests ---- + +fourths :: [Double] +fourths = (/4) <$> [1..4] + +mmap :: (a -> b) -> [[a]] -> [[b]] +mmap = map . map + +m1 :: [[Double]] +m1 = [[1,2,3],[3,4,4]] + +m_low :: [[Double]] +m_low = [[0.55,1.55,2.55], [2.55,3.55,4]] + +m_hi :: [[Double]] +m_hi = [[1.45,2.45,3.45], [3.45,4,4]] + + +---- The spec ---- + +main :: IO () +main = hspec $ do + + describe "renderPV" $ do + + it "maps exact multiples of 1/8 to the correct characters" $ + renderPV eighths `shouldBe` bars + + it "maps scaled multiples of 1/8 to the correct characters" $ + renderPV ((* 1337) <$> eighths) `shouldBe` bars + + it "maps values near tops of rounding regions to the correct characters" $ + renderPV v_hi `shouldBe` reverse bars + + it "maps values near bottoms of rounding regions to the correct characters" $ + renderPV v_low `shouldBe` reverse bars + + it "maps zero vectors to whitespace" $ + renderPV [0,0,0] `shouldBe` " " + + it "maps non-positive vectors to whitespace" $ + renderPV [-1,-23,-0.02] `shouldBe` " " + + it "maps null vectors to null strings" $ + renderPV [] `shouldBe` "" + + + describe "renderRV" $ do + + it "inverts 'rwave' consistently" $ + let (p,n) = renderRV rwave + in renderRV (negate <$> rwave) `shouldBe` (complement <$> n, complement <$> p) + + it "inverts arbitrary vectors consistently" $ + property $ \xs -> renderRV xs == barInvert (renderRV $ negate <$> xs) + + it "maps arbitrary-dimensional zero vectors to whitespace, for positive components" $ + property $ \n -> let (p,m) = renderRV $ replicate n 0 + in all isSpace p + + it "maps arbitrary-dimensional zero vectors to solid bocks █, for negative components" $ + property $ \n -> let (p,m) = renderRV $ replicate n 0 + in all (== '█') m + + describe "renderCV" $ do + + it "inverts 'wave' consistently" $ do + let (rp,rn,ip,im) = renderCV wave + renderCV (negate <$> wave) `shouldBe` (complement <$> rn, + complement <$> rp, + complement <$> im, + complement <$> ip) + + it "inverts arbitrary complex vectors consistently" $ + property $ \zs -> renderCV zs == barInvertC (renderCV $ negate <$> zs) + + it "maps arbitrary dimensional zero vectors to whitespace, for positive components" $ + property $ \n -> let (r1,_,i1,_) = renderCV $ replicate n (0.0 :+ 0.0) + in all isSpace $ r1 ++ i1 + + it "maps arbitrary dimensional zero vectors to solid bocks █, for negative components" $ + property $ \n -> let (_,r2,_,i2) = renderCV $ replicate n (0.0 :+ 0.0) + in all (== '█') $ r2 ++ i2 + + it "transforms appropriately under exchange of real and complex components" $ + property $ \v -> let v' = (\(x :+ y) -> (y :+ x)) <$> v + (x1,y1,x2,y2) = renderCV v + (x3,y3,x4,y4) = renderCV v' + in and [x1 == x4, + y1 == y4, + x2 == x3, + y2 == y3] + + describe "matShow" $ do + + it "maps exact multiples of 1/4 to the correct characters" $ + matShow [[1/4,2/4],[3/4,4/4]] `shouldBe` ["░▒", "▓█"] + + it "maps scaled multiples of 1/4 to the correct characters" $ do + matShow (mmap (* 3097) [[1,2],[3,4]]) `shouldBe` ["░▒", "▓█"] + matShow m1 `shouldBe` ["░▒▓", "▓██"] + + it "maps values near top of rounding regions to the correct characters" $ + matShow m_hi `shouldBe` ["░▒▓", "▓██"] + + it "maps values near bottom of rounding regions to the correct characters" $ + matShow m_low `shouldBe` ["░▒▓", "▓██"]