chart-unit 0.1.0.0 → 0.3.0

raw patch · 8 files changed

+1290/−552 lines, 8 filesdep +HUnitdep +ListLikedep +QuickCheckdep −diagrams-rasterificdep −random-funew-component:exe:chart-unit-examplesPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, ListLike, QuickCheck, SVGFonts, ad, formatting, linear, mwc-probability, mwc-random, numhask, numhask-range, reflection, smallcheck, tasty, tasty-hspec, tasty-hunit, tasty-quickcheck, tasty-smallcheck, tdigest

Dependencies removed: diagrams-rasterific, random-fu

API changes (from Hackage documentation)

Files

• chart-unit.cabal +89/−14
• examples/FakeData.hs +118/−0
• examples/examples.hs +328/−0
• readme.lhs +0/−226
• src/Chart.hs +21/−0
• src/Chart/Types.hs +274/−93
• src/Chart/Unit.hs +408/−219
• test/test.hs +52/−0

@@ -1,11 +1,11 @@ name:   chart-unit version:-  0.1.0.0+  0.3.0 synopsis:   A set of native haskell charts. description:-  readme.lhs+  See https://tonyday567.github.io/chart-unit/index.html for some description. category:   charts homepage:@@ -29,6 +29,7 @@   hs-source-dirs:     src   exposed-modules:+    Chart,     Chart.Unit,     Chart.Types   ghc-options:@@ -43,12 +44,16 @@     diagrams-core,     diagrams-lib,     diagrams-svg,-    diagrams-rasterific,     foldl,+    formatting,     lens,-    primitive,+    linear,+    numhask >= 0.0.4 && < 1,+    numhask-range >= 0.0.2 && < 1,     protolude,-    text+    text,+    QuickCheck,+    SVGFonts   default-language:     Haskell2010   default-extensions:@@ -85,34 +90,104 @@     TypeFamilies,     TypeOperators -executable readme+executable chart-unit-examples   default-language:     Haskell2010   ghc-options:     -funbox-strict-fields     -fforce-recomp-    -threaded-    -rtsopts-    -with-rtsopts=-N   hs-source-dirs:-    ./+    examples   main-is:-    readme.lhs+    examples.hs+  other-modules:+    FakeData   build-depends:     base >= 4.7 && < 5,     chart-unit,+    protolude,     containers,     diagrams,     diagrams-core,     diagrams-lib,-    diagrams-rasterific,     diagrams-svg,+    linear,     foldl,     lens,+    text,+    formatting,+    SVGFonts,+    numhask,+    numhask-range,+    -- for data examples+    mwc-random,+    mwc-probability,     primitive,+    ad,+    ListLike,+    reflection,+    tdigest+    -- diagrams-rasterific++  default-extensions:+    NoImplicitPrelude,+    UnicodeSyntax,+    BangPatterns,+    BinaryLiterals,+    DeriveFoldable,+    DeriveFunctor,+    DeriveGeneric,+    DeriveTraversable,+    DisambiguateRecordFields,+    EmptyCase,+    FlexibleContexts,+    FlexibleInstances,+    FunctionalDependencies,+    GADTSyntax,+    InstanceSigs,+    KindSignatures,+    LambdaCase,+    MonadComprehensions,+    MultiParamTypeClasses,+    MultiWayIf,+    NegativeLiterals,+    OverloadedStrings,+    ParallelListComp,+    PartialTypeSignatures,+    PatternSynonyms,+    RankNTypes,+    RecordWildCards,+    RecursiveDo,+    ScopedTypeVariables,+    TupleSections,+    TypeFamilies,+    TypeOperators++test-suite test+  default-language:+    Haskell2010+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    test+  main-is:+    test.hs+  build-depends:+    base >= 4.7 && < 5,+    HUnit,+    QuickCheck,+    chart-unit,     protolude,-    random-fu,-    text+    smallcheck,+    tasty,+    tasty-hunit,+    tasty-hspec,+    tasty-quickcheck,+    tasty-smallcheck,+    numhask,+    numhask-range,+    data-default,+    diagrams-lib   default-extensions:     NoImplicitPrelude,     UnicodeSyntax,

@@ -0,0 +1,118 @@+{-+various fake data+-}++{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# LANGUAGE DataKinds #-}++module FakeData where++import Chart+import NumHask.Prelude++import Control.Monad.Primitive (PrimState)+import Data.Reflection+import Numeric.AD+import Numeric.AD.Internal.Reverse+import System.Random.MWC+import System.Random.MWC.Probability+import qualified Control.Foldl as L+import qualified Protolude as P+import Data.TDigest++{-+Standard normal random variates in one dimension.+-}++rvs :: Gen (PrimState IO) -> Int -> IO [Double]+rvs gen n = samples n standard gen++{-+This generates n V2 random variates where the x and y parts are correlated.+-}++rvsCorr :: Gen (PrimState IO) -> Int -> Double -> IO [V2 Double]+rvsCorr gen n c = do+  s0 <- rvs gen n+  s1 <- rvs gen n+  let s1' = zipWith (\x y -> c * x + sqrt (1 - c * c) * y) s0 s1+  pure $ zipWith V2 s0 s1'++mkScatterData :: IO [[V2 Double]]+mkScatterData = do+    g <- create+    xys <- rvsCorr g 1000 0.7+    xys1 <- rvsCorr g 1000 -0.5+    pure [ over _y (+1) . over _x (\x -> x^^2 + 3*x - 1) <$> xys+         , over _x (\x -> x^^2 + 3*x + 1) <$> xys1]++makeHist :: Int -> [Double] -> [Rect Double]+makeHist n xs = fromHist (IncludeOvers 1) (fill cuts xs)+  where+    r = Chart.range xs+    cuts = linearSpace OuterPos r n++makeRvs :: IO [[Double]]+makeRvs = do+    g <- create+    xys <- rvs g 1000+    xys1 <- rvs g 1000+    pure [xys, (1.5*) <$> xys1]++mkHistData :: IO [[Rect Double]]+mkHistData = do+    d0 <- makeRvs+    pure $ makeHist 30 <$> d0 ++mkHistogramData :: IO [Histogram]+mkHistogramData = do+    d0 <- makeRvs+    let cuts = linearSpace OuterPos (Range (-3.0,3.0)) 6+    pure $ fill cuts  <$> d0++makeRectQuantiles :: Double -> IO [Rect Double]+makeRectQuantiles n = do+    vs <- makeQuantiles n+    let begin = ([],Nothing)+    let step :: ([V4 Double],Maybe Double) -> Double -> ([V4 Double],Maybe Double)+        step (_,   Nothing) a = ([], Just a)+        step (acc, Just l)  a = (acc <> [V4 l 0 a (0.1/(a-l))], Just a)+    let h = L.fold (L.Fold step begin fst) vs+    pure $ view rect <$> h++makeQuantiles :: Double -> IO [Double]+makeQuantiles n = do+    g <- create+    xs <- rvs g 100000+    let qs = ((1/n)*) <$> [0..n]+    let vs = L.fold (tDigestQuantiles qs) xs+    pure vs++tDigestQuantiles :: [Double] -> L.Fold Double [Double]+tDigestQuantiles qs = L.Fold step begin done+  where+    step x a = Data.TDigest.insert a x+    begin = tdigest ([]::[Double]) :: TDigest 25+    done x = fromMaybe nan . (`quantile` compress x) <$> qs++arrowData :: [V4 Double]+arrowData = zipWith (\(V2 x y) (V2 z w) -> V4 x y z w) pos dir'+  where+    pos = gridP OuterPos (Rect (V2 (-1 ... 1) (-1 ... 1))) (V2 20 20)+    dir' = gradF rosenbrock 0.01 <$> pos++gradF ::+    (forall s. (Reifies s Tape) => [Reverse s Double] -> Reverse s Double) ->+    Double ->+    V2 Double ->+    V2 Double+gradF f step (V2 x y) =+    - r2 ((\[x',y'] -> (x',y')) $+          gradWith (\x0 x1 -> x0 + (x1 - x0) * step) f [x,y])++rosenbrock :: (Num a) => [a] -> a+rosenbrock [] = 0+rosenbrock [x] = 100 P.* (P.negate x P.^ 2) P.^ 2 P.+ (x P.- 1) P.^ 2+rosenbrock (x:y:_) = 100 P.* (y P.- x P.^ 2) P.^ 2 P.+ (x P.- 1) P.^ 2+

@@ -0,0 +1,328 @@+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}++import Chart+import NumHask.Prelude++import FakeData++import qualified Control.Foldl as L+import Data.List ((!!))+import Data.Text (pack)++scratch :: Chart SVG -> IO ()+scratch = fileSvg "other/scratchpad.svg" (600,400)++exampleBox :: Chart a+exampleBox = box one++exampleAxes :: Chart' a+exampleAxes = axes def++exampleEmpty :: Chart' a+exampleEmpty =+    withChart def (\_ _ -> mempty) [corners one]++exampleGrid :: Chart a+exampleGrid =+    scatterChart+    [ScatterConfig 0.01 (palette!!4)]+    sixbyfour+    [V2 <$> [0..10] <*> [0..10]]++lineDefs :: [LineConfig]+lineDefs =+    [ LineConfig 0.01 (Color 0.945 0.345 0.329 0.8)+    , LineConfig 0.02 (Color 0.698 0.569 0.184 0.5)+    , LineConfig 0.005 (Color 0.5 0.5 0.5 1.0)+    ]++lineData :: [[V2 Double]]+lineData =+    fmap r2 <$>+    [ [(0.0,1.0),(1.0,1.0),(2.0,5.0)]+    , [(0.0,0.0),(3.0,3.0)]+    , [(0.5,4.0),(0.5,0)]+    ]++exampleLine :: Chart a+exampleLine = lineChart lineDefs sixbyfour lineData++exampleLineAxes :: Chart' a+exampleLineAxes =+    lineChart lineDefs sixbyfour lineData <>+    axes (chartRange .~ Just (rangeR2s lineData) $ def)++exampleLineAxes2 :: Chart' a+exampleLineAxes2 =+    withChart def (lineChart lineDefs) lineData++scatterDefs :: [ScatterConfig]+scatterDefs = zipWith ScatterConfig [0.01,0.02,0.03] (opacs 0.5 palette)++exampleScatter :: [[V2 Double]] -> Chart' a+exampleScatter xys =+    withChart (chartAspect .~ asquare $ def) (scatterChart scatterDefs) xys++exampleScatter2 :: [[V2 Double]] -> Chart' a+exampleScatter2 xys =+    withChart (chartAspect .~ asquare $ def) (scatterChart scatterDefs) xys1+  where+    xys1 = fmap (over _x (*1e8) . over _y (*1e-8)) <$> xys++histDefs :: [RectConfig]+histDefs =+    [ def+    , rectBorderColor .~ Color 0 0 0 0+      $ rectColor .~ Color 0.333 0.333 0.333 0.4+      $ def+    ]++-- | withCharts doesn't work with a V4 where w and z effect the XY plane range+exampleHist :: [[Rect Double]] -> Chart' a+exampleHist rs =+    histChart histDefs widescreen rs <>+    axes+    ( chartRange .~ Just (fold . fold $ rs)+    $ chartAspect .~ widescreen+    $ def)++exampleHistGrey :: [Rect Double] -> Chart' a+exampleHistGrey xys =+    histChart [histDefs!!1] widescreen [xys] <>+    axes+    ( chartRange .~ Just (fold xys)+    $ chartAspect .~ widescreen+    $ def)++exampleHistCompare :: DealOvers -> Histogram -> Histogram -> Chart' a+exampleHistCompare o h1 h2 =+    let h = fromHist o h1+        h' = fromHist o h2+        h'' = zipWith (\(Rect (V2 (Range (x,y)) (Range (z,w)))) (Rect (V2 _ (Range (_,w')))) -> Rect (V2 (Range (x,y)) (Range (z,w-w')))) h h'+        flat = Aspect $ Rect (V2 (Range (-0.75,0.75)) (Range (-0.25,0.25)))+    in+      pad 1.1 $+        beside (r2 (0,-1)) (histChart+        [ def+        , rectBorderColor .~ Color 0 0 0 0+        $ rectColor .~ Color 0.333 0.333 0.333 0.1+        $ def ] sixbyfour [h,h'] <>+        axes (ChartConfig 1.1+              [def]+              (Just (fold $ fold [h,h']))+              sixbyfour (uncolor transparent)))+        (histChart+        [ rectBorderColor .~ Color 0 0 0 0+        $ rectColor .~ Color 0.888 0.333 0.333 0.8+        $ def ] flat [h''] <>+        axes (ChartConfig 1.1+              [ axisAlignedTextBottom .~ 0.65 $+                axisAlignedTextRight .~ 1 $+                axisOrientation .~ Y $+                axisPlacement .~ AxisLeft $+                def+              ]+              (Just (fold h''))+              flat (uncolor transparent)))++exampleHistGrey2 :: [Rect Double] -> Chart' a+exampleHistGrey2 rs =+    lineChart lineDefs widescreen+    [(\(Rect (V2 (Range (x,z)) (Range (_,w)))) -> V2 ((x+z)/(one+one)) w) <$>+      rs] <>+    axes+    ( chartRange .~ Just (fold rs)+    $ chartAspect .~ widescreen+    $ def)++exampleLabelledBar :: Chart' a+exampleLabelledBar =+    histChart [def]+    sixbyfour+    [rs] <>+    axes+    ( chartAxes .~+      [ axisTickStyle .~+        TickLabels labels' $ def+      ]+      $ chartAspect .~ sixbyfour+      $ chartRange .~ Just (fold rs)+      $ def+    )+  where+    labels' = fmap pack <$> take 10 $ (:[]) <$> ['a'..]+    rs :: [Rect Double]+    rs = abs . view rect <$>+        zipWith4 V4 [0..10] (replicate 11 0) [1..11] [1,2,3,5,8,0,-2,11,2,1]++exampleArrow :: [V4 Double] -> Chart' a+exampleArrow xs =+    arrowChart def (V4 one one one one) xs <>+    axes ( chartRange .~ Just+           ( rangeV42Rect $ rangeV4 $ scaleV4s (V4 one one one one) xs)+           $ chartAspect .~ asquare $ def)++-- clipping+exampleClipping :: Chart a+exampleClipping =+    L.fold (L.Fold step1 mempty identity) $+    (\y -> L.fold (L.Fold step mempty identity)+      (Rect . (`V2` y) <$> qb)) <$>+    qb+  where+    step x a = beside (r2 (1,0)) x (pad 1.05 $ center $ blob (Color 0 0 0 0.02) box a <> clip ch a)+    step1 x a = beside (r2 (0,1)) x (pad 1.05 $ center a)+    qs = fromIntegral <$> ([0..4] :: [Int]) :: [Double]+    qb = (\x -> (-0.5 + x*0.2) ... (-0.5 + (x+1.0)*0.2)) <$> qs+    clip ch1 sq = clipped (pathFromLocTrail $ box sq) ch1+    ch = lineChart lineDefs asquare lineData++-- compound charts+exampleCompound :: IO [QChart a]+exampleCompound = do+    xys <- mkScatterData+    let qsc = QChart (scatterChart scatterDefs) (rangeR2s xys) xys+    let xy0 = rangeR2s $ lineData <> xys+    pure [qsc, qaxes xy0, qline]+  where+      qline = QChart (lineChart lineDefs) (rangeR2s lineData) lineData+      qaxes xy =+          QChart+          (\a _ -> axes+            ( chartRange .~ Just xy+            $ chartAspect .~ a+            $ def)) xy ()++exampleScatterHist :: [[V2 Double]] -> Chart' a+exampleScatterHist xys =+    beside (r2 (1,0))+    (beside (r2 (0,-1))+    (sc1 <> axes1)+    (reflectY histx))+    (reflectY $ rotateBy (3/4) histy)+  where+    sc1 = scatterChart [scatterColor .~ Color 0.365 0.647 0.855 0.1 $ def, def] asquare xys+    histx = histChart defHist xyHist hx+    histy = histChart defHist xyHist hy+    defHist =+        [ def+        , rectBorderColor .~ Color 0 0 0 0+          $ rectColor .~ Color 0.333 0.333 0.333 0.4+          $ def+        ]+    xyHist = Aspect (Rect (V2 one ((0.2*)<$>one)))+    hx = makeHist 50 . fmap (view _x) <$> xys+    hy = makeHist 50 . fmap (view _y) <$> xys+    axes2 =+        [ axisAlignedTextBottom .~ 0.65 $+          axisAlignedTextRight .~ 0.5 $+          axisLabelStrut .~ 0.04 $+          axisOrientation .~ X $+          axisPlacement .~ AxisTop $+          def,+          axisInsideStrut .~ 0.05 $+          axisAlignedTextBottom .~ 0.65 $+          axisAlignedTextRight .~ 1 $+          axisOrientation .~ Y $+          axisPlacement .~ AxisLeft $+          def]+    axes1 =+        axes+        (ChartConfig 1 axes2 (Just $ rangeR2s xys) asquare (Color 0.5 0.5 1 0.04))++exampleGgplot :: Chart' a+exampleGgplot =+    lineChart (repeat (LineConfig 0.002 (Color 0.98 0.98 0.98 1))) sixbyfour (gridX <> gridY) <>+    blob (Color 0.92 0.92 0.92 1) (box (Rect (V2 ((1.5*) <$> one) one))) <>+    axes ggdef+  where+    gridX = (\x -> [V2 0 x, V2 10 x]) . fromIntegral <$> ([0..10] :: [Int])+    gridY = (\x -> [V2 x 0, V2 x 10]) . fromIntegral <$> ([0..10] :: [Int])+    ggdef =+        ChartConfig+        1.1+        [defx]+        (Just $ Rect (V2 (0 ... 10) (0 ... 10)))+        sixbyfour+        (Color 1 1 1 0)+    defx =+        AxisConfig+        1.0+        X+        AxisBottom+        0+        (Color 0 0 0 0.2)+        0.018+        (Color 0 0 0 1)+        0+        0.01+        0.04+        (Color 0.2 0.2 0.2 0.7)+        (TickRound 5)+        0.5+        1++examplePixels :: Chart' a+examplePixels =+    pixelf+    (pixelGrain .~ V2 10 10 $ def)+    asquare (Rect (V2 (-1 ... 1) (-1 ... 1)))+    (\(V2 x y) -> x*y+x*x) <>+    axes+    ( chartRange .~ Just (Rect (V2 (-1 ... 1) (-1 ... 1)))+    $ chartAspect .~ asquare+    $ def)++makeOneDim :: IO [[(Double,Text)]]+makeOneDim = do+    qs <- makeQuantiles 20+    qs5 <- makeQuantiles 4+    let labels5 = ["min","3rd Q","median","1st Q","max"]+    pure [zip qs5 labels5, zip qs (repeat "")]++exampleOneDim :: [[(Double,Text)]] -> Chart' a+exampleOneDim qss =+    axes (ChartConfig 1.1 [def] (Just (Rect (V2 (range $ fst <$> (qss!!0)) (Range (0,0))))) skinny (uncolor transparent)) <>+    axes (ChartConfig 1.1 [axisColor .~ uncolor transparent $ axisMarkSize .~ 0.05 $ axisMarkColor .~ uncolor (withOpacity red 0.3) $ axisTickStyle .~ TickPlaced (qss!!1) $ def] (Just (Rect (V2 (range $ fst <$> (qss!!1)) (Range (0,0))))) skinny (uncolor transparent)) <>+    axes (ChartConfig 1.1 [axisColor .~ uncolor transparent $ axisMarkSize .~ 0.1 $ axisTextSize .~ 0.08 $ axisMarkColor .~ uncolor (withOpacity black 0.5) $ axisTickStyle .~ TickPlaced (qss!!0) $ def] (Just (Rect (V2 (range $ fst <$> (qss!!0)) (Range (0,0))))) skinny (uncolor transparent))+  where+    skinny = Aspect (Rect (V2 ((5*) <$> one) one))++main :: IO ()+main = do+  let sOne = (400,400)+  let s6by4 = (600,400)+  let sWide = (750,250)++  fileSvg "other/exampleBox.svg" s6by4 exampleBox+  fileSvg "other/exampleAxes.svg" s6by4 exampleAxes+  fileSvg "other/exampleEmpty.svg" s6by4 exampleEmpty+  fileSvg "other/exampleGgplot.svg" sWide exampleGgplot+  fileSvg "other/exampleGrid.svg" sOne exampleGrid+  fileSvg "other/exampleLine.svg" s6by4 exampleLine+  fileSvg "other/exampleLineAxes.svg" s6by4 exampleLineAxes+  fileSvg "other/exampleLineAxes2.svg" s6by4 exampleLineAxes2+  xys <- mkScatterData+  fileSvg "other/exampleScatter.svg" sOne (exampleScatter xys)+  fileSvg "other/exampleScatter2.svg" sOne (exampleScatter2 xys)+  xs <- mkHistData+  fileSvg "other/exampleHist.svg" sWide (exampleHist xs)+  rectqs <- makeRectQuantiles 50+  fileSvg "other/exampleHistUnequal.svg" sWide (exampleHistGrey rectqs)+  fileSvg "other/exampleHistUnequal2.svg" sWide (exampleHistGrey2 rectqs)+  hs <- mkHistogramData+  fileSvg "other/exampleHistCompare.svg" s6by4 (exampleHistCompare (IncludeOvers 1) (hs!!0) (hs!!1))+  fileSvg "other/exampleScatterHist.svg" sOne (pad 1.1 $ center $ exampleScatterHist xys)+  fileSvg "other/exampleLabelledBar.svg" s6by4 exampleLabelledBar+  fileSvg "other/exampleArrow.svg" sOne (exampleArrow arrowData)+  exc <- exampleCompound+  fileSvg "other/exampleCompound.svg" s6by4 (pad 1.1 $ center $ combine golden exc)+  fileSvg "other/exampleClipping.svg" sOne exampleClipping+  fileSvg "other/examplePixels.svg" sOne examplePixels+  qss <- makeOneDim+  fileSvg "other/exampleOneDim.svg" (750,150) (exampleOneDim qss)++  scratch (exampleHistCompare (IncludeOvers 1) (hs!!0) (hs!!1))+  -- fileSvg "other/scratchpad.svg" (600,150) $ pad 1.1 $+  --     showOrigin $ exampleOneDim qss

@@ -1,226 +0,0 @@-```include-other/header.md-```--[chart-unit](https://tonyday567.github.io/chart-unit.html) [![Build Status](https://travis-ci.org/tonyday567/chart-unit.png)](https://travis-ci.org/tonyday567/chart-unit)-===--scratchpad------My newest chart `padsvg $ linesXY def [[(0,0),(1,1)],[(0,0),(1,2)]]`--![](other/scratchpad.svg)--This slowly growing collection of charts:--- renders nicely over a wide chart size range, svg and png formats.-- render similarly at different scale-- are opinionated minimalism-- are unit shapes in the spirit of the [diagrams](http://projects.haskell.org/diagrams/doc/quickstart.html) design space.-- can be quickly integrated into ad-hoc haskell data analytics, providing a visual feedback loop.--charts------Scatter--![](other/scatter.svg)--Histogram--![](other/hist.svg)--Line--![](other/line.svg)--Lines--![](other/lines.svg)--Labelled Bar Chart--![](other/bar.svg)--rasterific png renders------![](other/scratchpad.png)--Scatter--![](other/scatter.png)--Histogram--![](other/hist.png)--Line--![](other/line.png)--Lines--![](other/lines.png)--Labelled Bar Chart--![](other/bar.png)--> {-# OPTIONS_GHC -Wall #-}-> {-# OPTIONS_GHC -fno-warn-type-defaults #-}-> {-# OPTIONS_GHC -fno-warn-missing-signatures #-}-> import Protolude-> import Control.Monad.Primitive (unsafeInlineIO)-> import Diagrams.Prelude hiding ((<>))-> import qualified Control.Foldl as L-> import qualified Data.Random as R-> import qualified Data.Map.Strict as Map-> import qualified Data.Text as Text->-> import Chart.Unit--some test data------Standard normal random variates.  Called ys to distinguish from the horizontal axis of the chart (xs) which are often implicitly [0..]--> ys :: Int -> IO [Double]-> ys n =->   replicateM n $ R.runRVar R.stdNormal R.StdRandom->--A bunch of ys, accumulated.--> yss :: (Int, Int) -> [[Double]]-> yss (n,m) = unsafeInlineIO $ do->   yss' <- replicateM m $ ys n->   pure $ (drop 1 . L.scan L.sum) <$> yss'->--xys is a list of X,Y pairs, correlated normal random variates to add some shape to chart examples.--> rXYs :: Int -> Double -> [(Double,Double)]-> rXYs n c = unsafeInlineIO $ do->   s0 <- replicateM n $ R.runRVar R.stdNormal R.StdRandom->   s1 <- replicateM n $ R.runRVar R.stdNormal R.StdRandom->   let s1' = zipWith (\x y -> c * x + sqrt (1 - c * c) * y) s0 s1->   pure $ zip s0 s1'->-> xys = rXYs 1000 0.8->--XY random walk--> rwxy = L.scan (L.Fold (\(x,y) (x',y') -> (x+x',y+y')) (0.0,0.0) identity) (take 100 xys)->--xysHist is a histogram of 10000 one-dim random normals.--The data out is a (X,Y) pair list, with mid-point of the bucket as X, and bucket count as Y.--> xysHist :: [(Double,Double)]-> xysHist = unsafeInlineIO $ do->   ys' <- replicateM 10000 $ R.runRVar R.stdNormal R.StdRandom :: IO [Double]->   let (f,s,n) = mkTicks' (range1D ys') 100->   let cuts = (\x -> f+s*fromIntegral x) <$> [0..n]->   let mids = (+(s/2)) <$> cuts->   let count = L.Fold (\x a -> Map.insertWith (+) a 1 x) Map.empty identity->   let countBool = L.Fold (\x a -> x + if a then 1 else 0) 0 identity->   let histMap = L.fold count $ (\x -> L.fold countBool (fmap (x >) cuts)) <$> ys'->   let histList = (\x -> Map.findWithDefault 0 x histMap) <$> [0..n]->   return (zip mids (fromIntegral <$> histList))->--Scale Robustness------xys rendered on the XY plane as dots - a scatter chart with no axes - is invariant to scale.  The data could be multiplied by any scalar, and look exactly the same.--![](other/dots.svg)--Axes break this scale invariance. Ticks and tick labels can hide this to some extent and look almost the same across scales.--![](other/scatter.svg)--This chart will look the same on a data scale change, except for tick magnitudes.--main------>-> main :: IO ()-> main = do- -See develop section below for my workflow.-->   padsvg $->       linesXY def [[(0,0),(1,1)],[(0,0),(1,2)]]->   fileSvg "other/line.svg" (200,200) $->     (lineXY def rwxy)->   filePng "other/line.png" (200,200) $->     (lineXY def rwxy)->   fileSvg "other/lines.svg" (200,200) $->     (linesXY def $ zip [0..] <$> yss (1000, 10))->   filePng "other/lines.png" (200,200) $->     (linesXY def $ zip [0..] <$> yss (1000, 10))->   fileSvg "other/dots.svg" (200,200) $->     (scatter def xys)->   filePng "other/dots.png" (200,200) $->     (scatter def xys)->   fileSvg "other/scatter.svg" (200,200) $->     (scatterXY def xys)->   filePng "other/scatter.png" (200,200) $->     (scatterXY def xys)->   fileSvg "other/bar.svg" (200,200) $->     barLabelled def (unsafeInlineIO $ ys 10) (fmap Text.pack <$> take 10 $ (:[]) <$> ['a'..])->   filePng "other/bar.png" (200,200) $->     barLabelled def (unsafeInlineIO $ ys 10) (fmap Text.pack <$> take 10 $ (:[]) <$> ['a'..])->   fileSvg "other/hist.svg" (200,200) $->     barRange def xysHist->   filePng "other/hist.png" (200,200) $->     barRange def xysHist--diagrams development recipe------In constructing new `units`:--- diagrams go from abstract to concrete-- start with the unitSquare: 4 points, 1x1, origin in the center-- work out where the origin should be, given the scaling needed.-- turn the pointful shape into a Trail-- close the Trail into a SVG-like loop-- turn the Trail into a QDiagram--You can slide up and down the various diagrams abstraction levels creating transformations at each level.  For example, here's something I use to work at the point level:--> unitp f = unitSquare # f # fromVertices # closeTrail # strokeTrail--workflow------> padsvg :: ChartSvg -> IO ()-> padsvg t =->   fileSvg "other/scratchpad.svg" (400,400) t->-> padpng :: ChartPng -> IO ()-> padpng t =->   filePng "other/scratchpad.png" (400,400) t->--Create a markdown version of readme.lhs:--~~~-pandoc -f markdown+lhs -t html -i readme.lhs -o index.html-~~~--Then fire up an intero session, and use padq to display coding results on-the-fly, mashing the refresh button on a browser pointed to readme.html.--or go for a compilation loop like:--~~~-stack install && readme && pandoc -f markdown+lhs -t html -i readme.lhs -o index.html --mathjax --filter pandoc-include && pandoc -f markdown+lhs -t markdown -i readme.lhs -o readme.md --mathjax --filter pandoc-include-~~~-

@@ -0,0 +1,21 @@+{-# OPTIONS_GHC -Wall #-}++module Chart+  ( module X+  , SVG+  , V4(..)+  , zipWith4+  , module Diagrams.Prelude+  ) where++import Data.List (zipWith4)+import Diagrams.Backend.SVG (SVG)+import Diagrams.Prelude hiding+    ((<>), arrow, Color(..), lineColor, scaleX, scaleY, width, zero, unsnoc, uncons, Additive, Loop, Magma, Metric, getLast, getFirst, normalize, inv, First, Last, (&), Strict, unit, from, to, size, distance, (.-.), (-~), (*.), rect, element, aspect, project, intersection)+import Linear (V4(..))++import NumHask.Range as X+import NumHask.Rect as X+import NumHask.Histogram as X+import Chart.Types as X+import Chart.Unit as X

@@ -1,137 +1,318 @@+{-# LANGUAGE GADTs #-} {-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} {-# LANGUAGE TemplateHaskell #-} -module Chart.Types where+module Chart.Types+  ( Chart+  , Chart'+  , Aspect(..)+  , aspect+  , asquare+  , sixbyfour+  , golden+  , widescreen+  , QChart(..)+  , Orientation(..)+  , Placement(..)+  , TickStyle(..)+  , Color(..)+  , color+  , uncolor+  , opac+  , opacs+  , palette+  , AxisConfig(..)+  , axisPad+  , axisOrientation+  , axisPlacement+  , axisHeight+  , axisColor+  , axisMarkSize+  , axisMarkColor+  , axisInsideStrut+  , axisLabelStrut+  , axisTextSize+  , axisTextColor+  , axisTickStyle+  , axisAlignedTextRight+  , axisAlignedTextBottom+  , ChartConfig(..)+  , chartPad+  , chartAxes+  , chartRange+  , chartAspect+  , chartCanvasColor+  , LineConfig(..)+  , lineSize+  , Chart.Types.lineColor+  , ScatterConfig(..)+  , scatterSize+  , scatterColor+  , RectConfig(..)+  , rectBorderWidth+  , rectBorderColor+  , rectColor+  , ArrowConfig(..)+  , arrowMinHeadSize+  , arrowMaxHeadSize+  , arrowHeadSize+  , arrowMinStaffLength+  , arrowMaxStaffLength+  , arrowStaffLength+  , arrowMinStaffWidth+  , arrowMaxStaffWidth+  , arrowStaffWidth+  , arrowColor+  , PixelConfig(..)+  , pixelGradient+  , pixelGrain+  , TextConfig+  , textPad+  , textOrientation+  , textPlacement+  , textSize+  , textColor+  , textRight+  , textBottom+  ) where -import Protolude-import Diagrams.Prelude--- import Data.Default-import Diagrams.Backend.SVG (SVG, renderSVG)-import Diagrams.Backend.Rasterific (Rasterific, renderRasterific)+import NumHask.Prelude+import Diagrams.Prelude hiding (Color(..), aspect)+import qualified Diagrams.TwoD.Text+import NumHask.Range+import NumHask.Rect+import Data.Colour -type ChartSvg = QDiagram SVG V2 Double Any-type ChartPng = QDiagram Rasterific V2 Double Any+-- | a Chart has a concrete scale, and combinatory options amount to mappend (on top of) and beside+type Chart a =+    ( Renderable (Path V2 Double) a+    ) =>+    QDiagram a V2 Double Any+ +-- | an alternative synonym where text is involved.+type Chart' a =+    ( Renderable (Path V2 Double) a+    , Renderable (Diagrams.TwoD.Text.Text Double) a+    ) =>+    QDiagram a V2 Double Any -fileSvg ∷ FilePath → (Double, Double) → ChartSvg → IO ()-fileSvg f s = renderSVG f (mkSizeSpec (Just <$> r2 s))+-- | the rendering aspect (or plane) of the chart.  Wrapped to distinguish this from a plain XY+data Aspect = Aspect { unAspect :: Rect Double} -filePng ∷ FilePath → (Double,Double) → ChartPng → IO ()-filePng f s = renderRasterific f (mkSizeSpec (Just <$> r2 s))+aspect :: Double -> Aspect+aspect a = Aspect (Rect (V2 ((a*) <$> one) one)) -rgba :: (Floating a, Ord a) => (a, a, a, a) -> AlphaColour a-rgba (r,g,b,a) = withOpacity (sRGB (r/255) (g/255) (b/255)) a+asquare :: Aspect+asquare = aspect 1 +sixbyfour :: Aspect+sixbyfour = aspect 1.5++golden :: Aspect+golden = aspect 1.61803398875++widescreen :: Aspect+widescreen = aspect 3++-- | The concrete nature of a QDiagram, and a desire to scale data and hud items naturally, a QChart is mostly a late binding of the Aspect that the chart is to be projected on to and the data.+data QChart a = forall b. QChart+    { _qChart :: ( ( Renderable (Diagrams.TwoD.Text.Text Double) a)+                  , Renderable (Path V2 Double) a) =>+                Aspect -> b -> QDiagram a V2 Double Any+    , _qXY :: Rect Double+    , _qData :: b+    }++makeLenses ''QChart+ data Orientation = X | Y  data Placement = AxisLeft | AxisRight | AxisTop | AxisBottom -data TickStyle = TickNone | TickLabels [Text] | TickNumber Int+data TickStyle = TickNone | TickLabels [Text] | TickRound Int | TickExact Int | TickPlaced [(Double,Text)] +data Color =+    Color+    { _red :: Double+    , _green :: Double+    , _blue :: Double+    , _aaa :: Double+    } deriving (Eq, Show)++color ∷ Color → AlphaColour Double+color (Color r g b a)= withOpacity (sRGB r g b) a++uncolor ∷ AlphaColour Double → Color+uncolor c = Color r g b a+  where+    a = alphaChannel c+    (RGB r g b) = toSRGB (Data.Colour.over c black)++palette ∷ [Color]+palette =+    [ Color 0.333 0.333 0.333 1.00 -- grey+    , Color 0.365 0.647 0.855 1.00 -- blue+    , Color 0.980 0.647 0.855 1.00 -- orange+    , Color 0.376 0.741 0.408 1.00 -- green+    , Color 0.945 0.486 0.690 1.00 -- pink+    , Color 0.698 0.569 0.184 1.00 -- brown+    , Color 0.698 0.463 0.698 1.00 -- purple+    , Color 0.871 0.812 0.247 1.00 -- yellow+    , Color 0.945 0.345 0.329 1.00 -- red+    ]++opacs :: Double -> [Color] -> [Color]+opacs t cs = (\(Color r g b o) -> Color r g b (o*t)) <$> cs++opac :: Double -> Color -> Color+opac t (Color r g b o) = Color r g b (o*t)+ data AxisConfig = AxisConfig-  { _axisOrientation :: Orientation-  , _axisPlacement :: Placement-  , _axisHeight :: Double-  , _axisColor :: AlphaColour Double-  , _axisMarkSize :: Double -- mark length-  , _axisMarkColor :: AlphaColour Double-  , _axisStrutSize :: Double -- distance of label from mark-  , _axisTextSize :: Double-  , _axisTextColor :: AlphaColour Double-  , _axisTickStyle :: TickStyle-  , _axisAlignedTextRight :: Double-  , _axisAlignedTextBottom :: Double-  }+    { _axisPad :: Double+    , _axisOrientation :: Orientation+    , _axisPlacement :: Placement+    , _axisHeight :: Double+    , _axisColor :: Color+    , _axisMarkSize :: Double -- mark length+    , _axisMarkColor :: Color+    , _axisInsideStrut :: Double -- distance of axis from plane+    , _axisLabelStrut :: Double -- distance of label from mark+    , _axisTextSize :: Double+    , _axisTextColor :: Color+    , _axisTickStyle :: TickStyle+    , _axisAlignedTextRight :: Double+    , _axisAlignedTextBottom :: Double+    }  instance Default AxisConfig where-  def =-    AxisConfig -    X-    AxisBottom-    0.02-    (rgba(94, 19, 94, 0.5))-    0.02-    (rgba (0, 102, 200, 0.5))-    0.02-    0.04-    (rgba (30,30,30,0.7))-    (TickNumber 10)-    0.5-    1+    def =+        AxisConfig+        1+        X+        AxisBottom+        0.02+        (Color 0.333 0.333 0.333 0.2)+        0.02+        (Color 0.1 0.4 0.8 0.5)+        0.05+        0.02+        0.04+        (Color 0.2 0.2 0.2 0.7)+        (TickRound 8)+        0.5+        1 -makeLenses ''AxisConfig +makeLenses ''AxisConfig  data ChartConfig = ChartConfig-  { _chartPad :: Double-  , _chartColor :: AlphaColour Double-  , _chartAxes :: [AxisConfig]-  }+    { _chartPad :: Double+    , _chartAxes :: [AxisConfig]+    , _chartRange :: Maybe (Rect Double)+    , _chartAspect :: Aspect+    , _chartCanvasColor :: Color+    }  instance Default ChartConfig where-  def =-    ChartConfig-    1.3-    (rgba(128, 128, 128, 0.6))-    [def,-     axisAlignedTextBottom .~ 0.65 $-     axisAlignedTextRight .~ 1 $-     axisOrientation .~ Y $-     axisPlacement .~ AxisLeft $-     def]+    def =+        ChartConfig+        1.3+        [def,+         axisAlignedTextBottom .~ 0.65 $+         axisAlignedTextRight .~ 1 $+         axisOrientation .~ Y $+         axisPlacement .~ AxisLeft $+         def]+        Nothing+        sixbyfour+        (Color 1 1 1 0.02)  makeLenses ''ChartConfig +data LineConfig = LineConfig+    { _lineSize :: Double+    , _lineColor :: Color+    }++instance Default LineConfig where+    def = LineConfig 0.02 (Color 0.365 0.647 0.855 1.00)++makeLenses ''LineConfig+ data ScatterConfig = ScatterConfig-  { _scatterChart :: ChartConfig-  , _scatterSize :: Double-  }+    { _scatterSize :: Double+    , _scatterColor :: Color+    }  instance Default ScatterConfig where-  def = ScatterConfig (chartColor .~ rgba(128, 128, 128, 0.1) $ def) 0.03+    def = ScatterConfig 0.03 (Color 0.33 0.33 0.33 0.2)  makeLenses ''ScatterConfig -data BarConfig = BarConfig-  { _barChart :: ChartConfig-  , _barSep :: Double-  }+data RectConfig = RectConfig+    { _rectBorderWidth :: Double+    , _rectBorderColor :: Color+    , _rectColor :: Color+    } -instance Default BarConfig where-  def = BarConfig (chartColor .~ rgba(59, 89, 152, 0.6) $ def) 0.01+instance Default RectConfig where+    def = RectConfig 1 (Color 0.333 0.333 0.333 0.4) (Color 0.365 0.647 0.855 0.5) -makeLenses ''BarConfig+makeLenses ''RectConfig -data LineConfig = LineConfig-  { _lineChart :: ChartConfig-  , _lineSize :: Double-  }+data ArrowConfig a = ArrowConfig+    { _arrowMinHeadSize :: a+    , _arrowMaxHeadSize :: a+    , _arrowHeadSize :: a+    , _arrowMinStaffLength :: a+    , _arrowMaxStaffLength :: a+    , _arrowStaffLength :: a+    , _arrowMinStaffWidth :: a+    , _arrowMaxStaffWidth :: a+    , _arrowStaffWidth :: a+    , _arrowColor :: Color+    } -instance Default LineConfig where-  def = LineConfig (chartColor .~ rgba(59, 89, 152, 0.6) $ def) 0.001+instance Default (ArrowConfig Double) where+    def = ArrowConfig 0.01 0.05 0.03 0.1 0.1 0.1 0.01 0.005 0.2+          (Color 0.333 0.333 0.888 0.8) -makeLenses ''LineConfig+makeLenses ''ArrowConfig -data OneLine = OneLine-    { _lColor :: AlphaColour Double-    , _lSize :: Double+data PixelConfig =+    PixelConfig+    { _pixelGradient :: Range Color+    , _pixelGrain :: V2 Int     } -instance Default OneLine where-  def = OneLine (rgba(59, 89, 152, 0.6)) 0.001+instance Default PixelConfig where+    def = PixelConfig+        (Range ( Color 1 1 1 1+               , Color 0 0 0 1))+        (V2 20 20) -makeLenses ''OneLine+makeLenses ''PixelConfig -data LinesConfig = LinesConfig-  { _linesChart :: ChartConfig-  , _linesLines :: [OneLine]-  }+data TextConfig = TextConfig+    { _textPad :: Double+    , _textOrientation :: Orientation+    , _textPlacement :: Placement+    , _textSize :: Double+    , _textColor :: Color+    , _textRight :: Double+    , _textBottom :: Double+    } -instance Default LinesConfig where-  def = LinesConfig def [ OneLine (rgba(60,90,150,1)) 0.002-                        , OneLine (rgba(0,128,255,1)) 0.002-                        , OneLine (rgba(255,128,0,1)) 0.002-                        , OneLine (rgba(128,0,255,1)) 0.002-                        , OneLine (rgba(0,255,255,1)) 0.002-                        ]+instance Default TextConfig where+    def =+        TextConfig+        1+        X+        AxisBottom+        0.08+        (Color 0.333 0.333 0.333 0.2)+        0.5+        1 -makeLenses ''LinesConfig+makeLenses ''TextConfig+

@@ -1,267 +1,385 @@ {-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} -module Chart.Unit (-    range1D,-    range1Ds,-    unit,-    units,-    unitXY,-    unitsXY,-    chartXY,-    scatter,-    scatterXY,-    barRange,-    barLabelled,-    bars,-    line,-    lines,-    lineXY,-    linesXY,-    axisXY,-    -- toFile,-    mkTicks,-    mkTicks',-    module Chart.Types,-    module Control.Lens,-    module Data.Default-) where+module Chart.Unit+  ( scaleX+  , scaleY+  , blob+  , line1+  , scatter1+  , rect1+  , pixel1+  , arrow1+  , box+  , lineChart+  , scatterChart+  , histChart+  , arrowChart+  , rangeV4+  , rangeV42Rect+  , scaleV4s+  , toPixels+  , rescalePixels+  , pixelf+  , withChart+  , axes+  , combine+  , fileSvg+  , bubble+  -- , text1+  , histCompare+  ) where +import NumHask.Prelude hiding (min,max,from,to,(&))++import NumHask.Range+import NumHask.Rect+import NumHask.Histogram import Chart.Types++import Control.Lens hiding (beside, none, (#), at)+import Data.Ord (max, min)+import Diagrams.Backend.SVG (SVG, renderSVG)+import Diagrams.Prelude hiding (width, unit, D, Color, scale, zero, scaleX, scaleY, aspect, rect, project)+import Formatting+import Linear hiding (zero, identity, unit, project)+ import qualified Control.Foldl as L-import Control.Lens hiding (beside, none, (#))-import Data.Default (def) import qualified Data.Text as Text-import Diagrams.Prelude hiding (unit) -import Protolude hiding (min,max)-import Text.Printf-import qualified Diagrams.TwoD.Text+import qualified Diagrams.Prelude as Diagrams -range1D :: (Fractional t, Ord t, Foldable f) => f t -> (t, t)-range1D = L.fold (L.Fold step initial extract)-  where-    step Nothing x = Just (x,x)-    step (Just (min,max)) x =-      Just (min' x min, max' x max)-    max' x1 x2 = if x1 > x2 then x1 else x2-    min' x1 x2 = if x1 < x2 then x1 else x2-    initial = Nothing-    extract = fromMaybe (-0.5,0.5)+-- | avoiding the scaleX zero throw+eps :: N [Point V2 Double]+eps = 1e-8 -range1Ds :: (Fractional t, Ord t, Foldable f, Foldable f') => f' (f t) -> (t, t)-range1Ds xss = L.fold (L.Fold step initial extract) xss-  where-    step Nothing x = Just (range1D x)-    step (Just (min, max)) x =-      Just (min', max')-      where-        (min'', max'') = range1D x-        min' = if min'' < min then min'' else min-        max' = if max'' > max then max'' else max-    initial = Nothing-    extract = fromMaybe (-0.5,0.5)+scaleX :: Double -> [Point V2 Double] -> [Point V2 Double]+scaleX s = Diagrams.scaleX (if s==zero then eps else s) --- unit scales and translates to a [-0.5,0.5] range-unit :: (Fractional b, Functor f, Ord b, Foldable f) => f b -> f b-unit xs =-  let (minX,maxX) = range1D xs in-  (\x -> (x-minX)/(maxX-minX) - 0.5) <$> xs+scaleY :: Double -> [Point V2 Double] -> [Point V2 Double]+scaleY s = Diagrams.scaleY (if s==zero then eps else s) --- units scales multiple xs to a common range-units :: (Fractional b, Functor f, Ord b, Foldable f, Functor f', Foldable f') =>-    f' (f b) -> f' (f b)-units xss =-  let (minX,maxX) = range1Ds xss in-  (fmap (\x -> (x-minX)/(maxX-minX) - 0.5)) <$> xss+-- * chartlets are recipes for constructing QDiagrams from traversable containers of vectors and a configuration+-- a solid blob (shape) with a colour fill and no border+blob ∷ (Floating (N a), Ord (N a), Typeable (N a), HasStyle a, V a ~ V2) ⇒+    Chart.Types.Color → a → a+blob c = fcA (color c) # lcA (withOpacity black 0) # lw none --- scale 2d points (XY) to ((-0.5,-0.5), (0.5,0.5))-unitXY :: (Fractional b, Fractional a, Ord b, Ord a) => [(a, b)] -> [(a, b)]-unitXY xys = zip (unit $ fst <$> xys) (unit $ snd <$> xys)+-- a line is just a scatter chart rendered with a line+-- (and with a usually stable x-value series)+line1 ∷ (Traversable f, R2 r) => LineConfig → f (r Double) → Chart b+line1 (LineConfig s c) ps = case NumHask.Prelude.head ps of+  Nothing -> mempty+  Just p0 -> stroke (trailFromVertices (toList $ (p2 . unr2) . view _xy <$> ps)+              `at`+              p2 (unr2 (view _xy p0))) # lcA (color c) # lwN s --- scale multiple 2d series-unitsXY :: (Fractional a, Ord a, Fractional b, Ord b) => [[(a, b)]] -> [[(a, b)]]-unitsXY xyss = zipWith (\x y -> zip x y) xs' ys'-  where-    xs = fmap fst <$> xyss-    ys = fmap snd <$> xyss-    xs' = units xs-    ys' = units ys+-- dots on the XY plane+scatter1 ∷ (Traversable f, R2 r) => ScatterConfig → f (r Double) → Chart b+scatter1 (ScatterConfig s c) ps =+  atPoints (toList $ (p2 . unr2) . view _xy <$> ps)+    (repeat $ circle s #+     blob c+    ) -chartXY :: (Renderable (Path V2 Double) a, (Renderable (Diagrams.TwoD.Text.Text Double) a)) => ChartConfig-  -> ([(Double, Double)] -> QDiagram a V2 Double Any)-  -> [(Double, Double)]-  -> QDiagram a V2 Double Any-chartXY (ChartConfig p _ axes) chart xys =-  L.fold (L.Fold step (chart xys) (pad p)) axes+-- | rectangles specified using a V4 x y z w where+-- (x,y) is location of lower left corner+-- (z,w) is location of upper right corner+rect1 :: (Traversable f) => RectConfig -> f (Rect Double) -> Chart b+rect1 cfg rs = mconcat $ toList $+    (\(Rect (V2 (Range (x,z)) (Range (y,w)))) ->+       (unitSquare #+        moveTo (p2 (0.5,0.5)) #+        Diagrams.scaleX (if z-x==zero then eps else z-x) #+        Diagrams.scaleY (if w-y==zero then eps else w-y) #+        moveTo (p2 (x,y)) #+        fcA (color $ cfg ^. rectColor) #+        lcA (color $ cfg ^. rectBorderColor) #+        lw 1+       )) <$> rs++arrow1 :: (Traversable f) => ArrowConfig Double -> f (V4 Double) -> Chart b+arrow1 cfg qs =+    fcA (color $ cfg ^. arrowColor) $ position $+    zip+    ((\(V4 x y _ _) -> p2 (x,y)) <$> toList qs)+    (arrowStyle cfg <$> toList qs)++arrowStyle :: ArrowConfig Double -> V4 Double -> Chart b+arrowStyle cfg (V4 _ _ z w) =+    arrowAt' opts (p2 (0, 0)) (sL *^ V2 z w)   where-    step x a =-      beside (v (a ^. axisPlacement))-      x-      (axisXY a (d (a ^. axisOrientation)))+    trunc minx maxx a = min (max minx a) maxx+    m = norm (V2 z w)+    hs = trunc (cfg ^. arrowMinHeadSize) (cfg ^. arrowMaxHeadSize) (cfg ^. arrowHeadSize * m)+    sW = trunc (cfg ^. arrowMinStaffWidth) (cfg ^. arrowMaxStaffWidth) (cfg ^. arrowStaffWidth * m)+    sL = trunc (cfg ^. arrowMinStaffLength) (cfg ^. arrowMaxStaffLength) (cfg ^. arrowStaffLength * m)+    opts = with & arrowHead .~ tri &+           headLength .~ global hs &+           shaftStyle %~ (lwG sW & lcA (color $ cfg ^. arrowColor)) &+           headStyle %~ (lcA (color $ cfg ^. arrowColor) & fcA (color $ cfg ^. arrowColor)) -    v AxisBottom = r2 (0,-1)-    v AxisTop = r2 (0,1)-    v AxisLeft = r2 (-1,0)-    v AxisRight = r2 (1,0)+-- | convert from an XY to a polymorphic qdiagrams rectangle+box ::+    ( Field (N t)+    , N t ~ Double+    , V t ~ V2+    , HasOrigin t+    , Transformable t+    , TrailLike t) =>+    Rect Double -> t+box (Rect (V2 x y)) =+    moveOriginTo (p2 ( -x^.low - (x^.width/2)+                     , -y^.low - (y^.width/2))) $+    Diagrams.scaleX (if x^.width==zero then eps else x^.width) $+    Diagrams.scaleY (if y^.width==zero then eps else y^.width)+    unitSquare -    d X = range1D $ fst <$> xys-    d Y = range1D $ snd <$> xys+-- | a pixel is a rectangle with a color.+pixel1 :: (Traversable f) => f (Rect Double, Color) -> Chart b+pixel1 rs = mconcat $ toList $+    (\(Rect (V2 (Range (x,z)) (Range (y,w))), c) ->+       (unitSquare #+        moveTo (p2 (0.5,0.5)) #+        Diagrams.scaleX (if z-x==zero then eps else z-x) #+        Diagrams.scaleY (if w-y==zero then eps else w-y) #+        moveTo (p2 (x,y)) #+        fcA (color c) #+        lcA transparent #+        lw 0+       )) <$> rs --- axis rendering-axisXY :: ((Renderable (Diagrams.TwoD.Text.Text Double) a), Renderable (Path V2 Double) a) => AxisConfig -> (Double,Double) -> QDiagram a V2 Double Any-axisXY cfg range = centerXY $-  atPoints-    (p2 . t <$> tickLocations)-    ((\x -> mkLabel x cfg) <$> tickLabels)-  `atop`-  (axisRect (cfg ^. axisHeight) (-0.5,0.5)-   # unitRect (cfg ^. axisColor))-  where-    t = case cfg ^. axisOrientation of-      X -> \x -> (x,0)-      Y -> \y -> (-(cfg ^. axisMarkSize), y)-    tickLocations = case cfg ^. axisTickStyle of-      TickNone -> []-      TickNumber n -> unit $ mkTicks range n-      TickLabels ls -> unit $ fromIntegral <$> [1..length ls]-    tickLabels = case cfg ^. axisTickStyle of-      TickNone -> []-      TickNumber n -> Text.pack . printf "%7.1g" <$> mkTicks range n-      TickLabels ls -> ls-    axisRect h (min, max) = case cfg ^. axisOrientation of-      X -> moveTo (p2 (max,0)) .-          strokeTrail .-          closeTrail .-          fromVertices .-          scaleX (max-min) .-          scaleY h $-          unitSquare-      Y -> moveTo (p2 (0,min)) .-          strokeTrail .-          closeTrail .-          fromVertices .-          scaleY (max-min) .-          scaleX h $-          unitSquare+-- * charts are recipes for constructing a QDiagram from a specification of the XY plane to be projected on to (XY), a list of traversable vector containers and a list of configurations. --- somewhat a base class of a wide variety of chart marks-unitRect ∷ (Floating (N a), Ord (N a), Typeable (N a), HasStyle a, V a ~ V2) ⇒-    AlphaColour Double → a → a-unitRect c = fcA c # lcA (withOpacity black 0) # lw none+scatterChart ::+    (R2 r, Traversable f) =>+    [ScatterConfig] ->+    Aspect ->+    [f (r Double)] ->+    Chart a+scatterChart defs (Aspect xy) xyss = mconcat $ zipWith scatter1 defs (scaleR2s xy xyss) --- polymorphic dots-scatter :: (Typeable (N r), Monoid r, Semigroup r, Transformable r,HasStyle r, HasOrigin r, TrailLike r, V r ~ V2, N r ~ Double) =>-    ScatterConfig -> [(N r, N r)] -> r-scatter cfg xys =-  atPoints (p2 <$> unitXY xys)-    (repeat $ circle (cfg ^. scatterSize) #-     unitRect (cfg ^. scatterChart ^. chartColor)-    )+lineChart ::+    (R2 r, Traversable f) =>+    [LineConfig] ->+    Aspect ->+    [f (r Double)] ->+    Chart a+lineChart defs (Aspect xy) xyss = mconcat $ zipWith line1 defs (scaleR2s xy xyss) -scatterXY :: (Renderable (Path V2 Double) a, (Renderable (Diagrams.TwoD.Text.Text Double) a)) => ScatterConfig -> [(Double,Double)] -> QDiagram a V2 Double Any-scatterXY cfg xys =-  chartXY (cfg ^. scatterChart) (scatter cfg) xys+histChart ::+    (Traversable f) =>+    [RectConfig] ->+    Aspect ->+    [f (Rect Double)] ->+    Chart a+histChart defs (Aspect xy) rs =+    centerXY . mconcat . zipWith rect1 defs $ scaleRectss xy rs --- bar-bars :: (Renderable (Path V2 Double) a) => BarConfig -> [Double] -> QDiagram a V2 Double Any-bars cfg ys =-  cat' (r2 (1,0)) (with Diagrams.Prelude.& sep .~ cfg ^. barSep)-  ((\y ->-    unitSquare-    # moveOriginTo (p2 (-0.5,-0.5))-    # if y==0 then scaleY epsilon else scaleY y) <$> ys)-    # unitRect (cfg ^. barChart ^. chartColor)-    # centerXY-    # scaleX (1/fromIntegral (length ys)) # scaleY (1/(max-min))+toPixels :: Rect Double -> (V2 Double -> Double) -> PixelConfig -> [(Rect Double, Color)]+toPixels xy f cfg = zip g cs+    where+      g = grid xy (view pixelGrain cfg)+      xs = f . midRect <$> g+      (Range (lx,ux)) = range xs+      (Range (lc0,uc0)) = view pixelGradient cfg+      cs = uncolor . (\x -> blend ((x - lx)/(ux - lx)) (color lc0) (color uc0)) <$> xs++rescalePixels :: Rect Double -> [(Rect Double, Color)] -> [(Rect Double, Color)]+rescalePixels xy xys = zip vs cs   where-    (min,max) = range1D ys-    epsilon = 1e-8+    vs = scaleRects xy (fst <$> xys)+    cs = snd <$> xys -barRange :: (Renderable (Path V2 Double) a, (Renderable (Diagrams.TwoD.Text.Text Double) a)) => BarConfig -> [(Double, Double)] -> QDiagram a V2 Double Any-barRange cfg xys = chartXY (cfg ^. barChart) (\x -> bars cfg (snd <$> x)) xys+-- | pixels over an XY using a function+pixelf ::+    PixelConfig ->+    Aspect ->+    Rect Double ->+    (V2 Double -> Double) ->+    Chart a+pixelf cfg (Aspect asp) xy f =+    pixel1 $ rescalePixels asp (toPixels xy f cfg) -barLabelled :: (Renderable (Path V2 Double) a, (Renderable (Diagrams.TwoD.Text.Text Double) a)) => BarConfig -> [Double] -> [Text] -> QDiagram a V2 Double Any-barLabelled cfg ys labels = barRange-     ( barChart . chartAxes .~-       [ axisTickStyle .~-         TickLabels labels $ def-       ]-       $ cfg-     ) (zip [0..] ys)+-- | arrow lengths and sizes also need to be scaled, and so arrows doesnt fit as neatly into the whole scaling idea+arrowChart ::+    (Traversable f) =>+    ArrowConfig Double ->+    V4 (Range Double) ->+    f (V4 Double) ->+    Chart a+arrowChart cfg xy xs =+    arrow1 cfg $ scaleV4s xy xs --- a line is just a scatter chart rendered with a line (and with a usually stable x-value series)-line :: (Renderable (Path V2 Double) a) => [(Double,Double)] -> QDiagram a V2 Double Any-line xys = strokeT $ trailFromVertices $ p2 <$> unitXY xys+-- | rescale a V4 from rold to rnew+rescaleV4P :: V4 (Range Double) -> V4 (Range Double) -> V4 Double -> V4 Double+rescaleV4P rold rnew q =+    over _x (project (rold^._x) (rnew^._x)) $+    over _y (project (rold^._y) (rnew^._y)) $+    over _z (project (rold^._z) (rnew^._z)) $+    over _w (project (rold^._w) (rnew^._w))+    q -lineXY :: (Renderable (Path V2 Double) a, (Renderable (Diagrams.TwoD.Text.Text Double) a)) => LineConfig -> [(Double,Double)] -> QDiagram a V2 Double Any-lineXY cfg xys =-    chartXY (cfg ^. lineChart)-    (\x -> line x # centerXY # lcA (cfg ^. lineChart ^. chartColor) # lwN (cfg ^. lineSize))-    xys+-- | rescale a container of V4s+rescaleV4 :: (Functor f) =>+    V4 (Range Double) -> V4 (Range Double) -> f (V4 Double) -> f (V4 Double)+rescaleV4 rold rnew qs = rescaleV4P rold rnew <$> qs --- multiple lines with a common range for both x and y values-lines :: (Renderable (Path V2 Double) a) => LinesConfig -> [[(Double,Double)]] -> QDiagram a V2 Double Any-lines cfg xyss = centerXY $ mconcat $-    zipWith (\d c -> d # lcA (c ^. lColor) # lwN (c ^. lSize))-    (l xyss)-    (cycle $ cfg ^.linesLines)-  where-    l xyss' = strokeT . trailFromVertices . fmap p2 <$> unitsXY xyss'+-- | scale a double container of V4s from the current range+scaleV4s :: (Traversable f) =>+    V4 (Range Double) -> f (V4 Double) -> f (V4 Double)+scaleV4s r f = rescaleV4 (rangeV4 f) r f -linesXY :: ((Renderable (Diagrams.TwoD.Text.Text Double) a), Renderable (Path V2 Double) a) =>-  LinesConfig-  -> [[(Double, Double)]]-  -> QDiagram a V2 Double Any-linesXY cfg@(LinesConfig (ChartConfig p _ axes) _) xyss =-  L.fold (L.Fold step (lines cfg xyss) (pad p)) axes+-- | V4 range of a V4 container+rangeV4 :: (Traversable f) => f (V4 Double) -> V4 (Range Double)+rangeV4 qs = V4 rx ry rz rw   where-    step x a =-      beside (v (a ^. axisPlacement))-      x-      (axisXY a (d (a ^. axisOrientation)))+    rx = range $ toList (view _x <$> qs)+    ry = range $ toList (view _y <$> qs)+    rz = range $ toList (view _z <$> qs)+    rw = range $ toList (view _w <$> qs) -    v AxisBottom = r2 (0,-1)-    v AxisTop = r2 (0,1)-    v AxisLeft = r2 (-1,0)-    v AxisRight = r2 (1,0)+rangeV42Rect :: V4 (Range Double) -> Rect Double+rangeV42Rect (V4 x y z w) = Rect (V2 (x<>z) (y<>w)) -    d X = range1Ds $ fmap fst <$> xyss-    d Y = range1Ds $ fmap snd <$> xyss+-- * axis rendering +-- | render with a chart configuration+withChart ::+    ( Traversable f+    , R2 r) =>+    ChartConfig ->+    (Aspect -> [f (r Double)] -> QDiagram a V2 Double Any) ->+    [f (r Double)] ->+    Chart' a+withChart conf renderer d = case conf^.chartRange of+  Nothing ->+      renderer (conf^.chartAspect) d <>+      axes (chartRange .~ Just (rangeR2s d) $ conf)+  Just axesRange ->+      combine (conf ^. chartAspect)+      [ QChart renderer r d+      , QChart+        (\asp _ ->+           axes+           ( chartAspect.~asp+           $ chartRange .~ Just axesRange+           $ conf))+        r+        ()+      ]+    where+      r = rangeR2s d -mkTicks :: (Double,Double) -> Int -> [Double]-mkTicks r n = (f +) . (s *) . fromIntegral <$> [0..n']+axes ::+    ChartConfig ->+    Chart' a+axes (ChartConfig p a r (Aspect asp@(Rect (V2 ax ay))) cc) =+    L.fold (L.Fold step begin (pad p)) a   where-    (f,s,n') = mkTicks' r n+    begin = box asp # fcA (color cc) # lcA (withOpacity black 0) # lw none+    step x cfg = beside dir x (mo $ axis1 cfg rendr tickr)+      where+        rendr = case view axisOrientation cfg of+              X -> ax+              Y -> ay+        tickr = case view axisOrientation cfg of+              X -> rx+              Y -> ry+        dir   = case view axisPlacement cfg of+              AxisBottom -> r2 (0,-1)+              AxisTop -> r2 (0,1)+              AxisLeft -> r2 (-1,0)+              AxisRight -> r2 (1,0)+        mo    = case view axisOrientation cfg of+              X -> moveOriginTo (p2 ((-ax^.low)-(ax^.width)/2,0))+              Y -> moveOriginTo (p2 (0,(-ay^.low)-(ay^.width)/2))+        (Rect (V2 rx ry)) = fromMaybe one r -mkTicks' :: (Double,Double) -> Int -> (Double, Double, Int)-mkTicks' (min, max) n = (f, step', n')+axis1 ::+    AxisConfig ->+    Range Double ->+    Range Double ->+    Chart' b+axis1 cfg rendr tickr = pad (cfg ^. axisPad) $ strut2 $ centerXY $+  atPoints+    (t <$> tickLocations)+    ((`mkLabel` cfg) <$> tickLabels)+  `atop`+  (axisRect (cfg ^. axisHeight) rendr+   # blob (cfg ^. axisColor))   where-    span' = max - min-    step' = 10 ^^ floor (logBase 10 (span'/fromIntegral n))-    err = fromIntegral n / span' * step'-    step-      | err <= 0.15 = 10 * step'-      | err <= 0.35 = 5 * step'-      | err <= 0.75 = 2 * step'-      | otherwise = step'-    f = step * fromIntegral (floor (min/step))-    l = step * fromIntegral (floor (max/step))-    n' = round ((l - f)/step)+    strut2 x = beside dir x $ strut1 (cfg ^. axisInsideStrut)+    dir = case cfg ^. axisPlacement of+      AxisBottom -> r2 (0,1)+      AxisTop -> r2 (0,-1)+      AxisLeft -> r2 (1,0)+      AxisRight -> r2 (-1,0)+    strut1 = case cfg ^. axisOrientation of+      X -> strutY+      Y -> strutX+    t = case cfg ^. axisOrientation of+      X -> \x -> p2 (x, 0)+      Y -> \y -> p2 (-(cfg ^. axisMarkSize), y)+    ticks0 = case cfg ^. axisTickStyle of+      TickNone -> []+      TickRound n -> linearSpaceSensible OuterPos tickr n+      TickExact n -> linearSpace OuterPos tickr n+      TickLabels _ -> []+      TickPlaced xs -> fst <$> xs+    tickLocations = case cfg ^. axisTickStyle of+      TickNone -> []+      {- To Do:+        rounded ticks introduce the possibility of marks beyond the existing range.+        if this happens, it should really be fed into the chart rendering as a new,+        revised range.+      -}+      TickRound _ -> project tickr rendr <$> ticks0+      TickExact _ -> project tickr rendr <$> ticks0+      TickLabels ls ->+          project+          (Range (0, fromIntegral $ length ls))+          rendr <$>+          ((\x -> x - 0.5) . fromIntegral <$> [1..length ls])+      TickPlaced _ -> project tickr rendr <$> ticks0+    tickLabels = case cfg ^. axisTickStyle of+      TickNone -> []+      TickRound _ -> tickFormat <$> ticks0+      TickExact _ -> tickFormat <$> ticks0+      TickLabels ls -> ls+      TickPlaced xs -> snd <$> xs+    tickFormat = sformat (prec 2)+    axisRect h (Range (l,u)) = case cfg ^. axisOrientation of+      X -> moveTo (p2 (u,0)) .+          strokeTrail .+          closeTrail .+          fromVertices .+          scaleY h .+          scaleX (u-l) $+          unitSquare+      Y -> moveTo (p2 (0,l)) .+          strokeTrail .+          closeTrail .+          fromVertices .+          scaleX h .+          scaleY (u-l) $+          unitSquare -mkLabel :: ((Renderable (Diagrams.TwoD.Text.Text Double) a), Renderable (Path V2 Double) a) => Text -> AxisConfig -> QDiagram a V2 Double Any+mkLabel ::+    Text ->+    AxisConfig ->+    Chart' b mkLabel label cfg =   beside dir   (beside dir    (rule (cfg ^. axisMarkSize) #-   lcA (cfg ^. axisMarkColor))+   lcA (color $ cfg ^. axisMarkColor))     s)   (Diagrams.Prelude.alignedText     (cfg ^. axisAlignedTextRight)     (cfg ^. axisAlignedTextBottom)     (Text.unpack label) #-  scale (cfg ^. axisTextSize) #-  fcA (cfg ^.axisTextColor))+  Diagrams.scale (cfg ^. axisTextSize) #+  fcA (color $ cfg ^.axisTextColor))   where     dir = case cfg ^. axisOrientation of       X -> r2 (0,-1)@@ -270,6 +388,77 @@       X -> vrule       Y -> hrule     s = case cfg ^. axisOrientation of-      X -> strutY (cfg ^. axisStrutSize)-      Y -> strutX (cfg ^. axisStrutSize)+      X -> strutY (cfg ^. axisLabelStrut)+      Y -> strutX (cfg ^. axisLabelStrut) +{-+text1 ::+    TextConfig ->+    Text ->+    Chart' b+text1 cfg label =+  Diagrams.Prelude.alignedText+    (cfg ^. textRight)+    (cfg ^. textBottom)+    (Text.unpack label) #+  Diagrams.scale (cfg ^. textSize) #+  fcA (color $ cfg ^.textColor)+  where+    dir = case cfg ^. textOrientation of+      X -> r2 (0,-1)+      Y -> r2 (-1,0)+-}++-- * rendering+-- | render a list of qcharts using a common scale+combine :: Aspect -> [QChart a] -> Chart' a+combine (Aspect xy) qcs = mconcat $+    (\(QChart c xy1 x) -> c+          (Aspect $ xy `times` xy1 `times` recip xysum)+          x) <$> qcs+    where+      xysum = mconcat $ (\(QChart _ xy1 _) -> xy1) <$> qcs++fileSvg ∷ FilePath → (Double, Double) → Chart SVG → IO ()+fileSvg f s = renderSVG f (mkSizeSpec (Just <$> r2 s))++-- outline of a chart+bubble ∷ ∀ a. (FromInteger (N a), MultiplicativeGroup (N a), RealFloat (N a), Traced a, V a ~ V2) ⇒ [a] → Int → [V a (N a)]+bubble chart' n = bubble'+  where+    bubble' = ps+    ps = catMaybes $ maxRayTraceV (p2 (0,0)) <$>+        ((\x -> view (Diagrams.Prelude.from r2PolarIso) (1, x @@ rad)) .+         (\x -> fromIntegral x/10.0) <$> [0..n]) <*>+        chart'++histCompare :: DealOvers -> Histogram -> Histogram -> Chart' a+histCompare o h1 h2 =+    let h = fromHist o h1+        h' = fromHist o h2+        h'' = zipWith (\(Rect (V2 (Range (x,y)) (Range (z,w)))) (Rect (V2 _ (Range (_,w')))) -> Rect (V2 (Range (x,y)) (Range (z,w-w')))) h h'+        flat = Aspect $ Rect (V2 (Range (-0.75,0.75)) (Range (-0.25,0.25)))+    in+      pad 1.1 $+        beside (r2 (0,-1)) (histChart+        [ def+        , rectBorderColor .~ Color 0 0 0 0+        $ rectColor .~ Color 0.333 0.333 0.333 0.1+        $ def ] sixbyfour [h,h'] <>+        axes (ChartConfig 1.1+              [def]+              (Just (fold $ fold [abs <$> h,abs <$> h']))+              sixbyfour (uncolor transparent)))+        (histChart+        [ rectBorderColor .~ Color 0 0 0 0+        $ rectColor .~ Color 0.888 0.333 0.333 0.8+        $ def ] flat [abs <$> h''] <>+        axes (ChartConfig 1.1+              [ axisAlignedTextBottom .~ 0.65 $+                axisAlignedTextRight .~ 1 $+                axisOrientation .~ Y $+                axisPlacement .~ AxisLeft $+                def+              ]+              (Just (fold $ abs <$> h''))+              flat (uncolor transparent)))

@@ -0,0 +1,52 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE DataKinds #-}++module Main where++import Chart+import NumHask.Prelude++import Test.Tasty (testGroup, defaultMain)+import Test.Tasty.Hspec++testWithChart :: SpecWith ()+testWithChart = describe "withChart" $ do+    it "axes and chartWith should render the same" $ do+        fileSvg "test/empty.svg" (400,400) emptyChart +        fileSvg "test/justAxes.svg" (400,400) justAxesChart +        t1 <- readFile "test/empty.svg"+        t2 <- readFile "test/justAxes.svg"+        t1 `shouldBe` t2++    it "chartWith lines and lines <> axes" $ do+        fileSvg "test/line.svg" (400,400) line1Chart+        fileSvg "test/line2.svg" (400,400) line2Chart +        t1 <- readFile "test/line.svg"+        t2 <- readFile "test/line2.svg"+        t1 `shouldBe` t2+      where+        emptyChart = withChart def (\_ _ -> mempty) [corners one]+        justAxesChart = axes def+        line1Chart = withChart def (lineChart lineDefs) lineData+        line2Chart =+            lineChart lineDefs sixbyfour lineData <>+            axes (chartRange .~ Just (rangeR2s lineData) $ def)++        lineDefs :: [LineConfig]+        lineDefs =+            [ LineConfig 0.01 (Color 0.945 0.345 0.329 0.8)+            , LineConfig 0.02 (Color 0.698 0.569 0.184 0.5)+            , LineConfig 0.005 (Color 0.5 0.5 0.5 1.0)+            ]+        lineData :: [[V2 Double]]+        lineData =+            fmap r2 <$>+            [ [(0.0,1.0),(1.0,1.0),(2.0,5.0)]+            , [(0.0,0.0),(3.0,3.0)]+            , [(0.5,4.0),(0.5,0)]+            ]++main :: IO ()+main = do+    t1 <- testSpec "withChart" testWithChart+    defaultMain $ testGroup "chart-unit" [t1]