chart-svg-0.4.0: src/Chart/Examples.hs
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}
-- | Examples of chart construction.
module Chart.Examples
( -- * Unit & Hud
unitExample,
hudOptionsExample,
-- * Iconic primitives.
lineExample,
rectExample,
textExample,
glyphsExample,
pathExample,
-- * Compounds
barExample,
barDataExample,
sbarExample,
waveExample,
surfaceExample,
rosenbrock,
arcFlagsExample,
ellipseExample,
quadExample,
cubicExample,
vennExample,
arrowExample,
dateExample,
-- * Colour
gradientExample,
wheelExample,
-- * Debugging
debugExample,
pathChartOptions,
writeAllExamples,
writeAllExamplesDark,
)
where
import Chart
import Data.Bifunctor
import Data.Bool
import Data.ByteString (ByteString)
import Data.Function
import Data.String.Interpolate
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time
import Optics.Core
import Prelude hiding (abs)
-- | unit example
--
-- 
unitExample :: ChartOptions
unitExample = mempty & #charts .~ named "unit" [RectChart defaultRectStyle [one]] & #hudOptions .~ defaultHudOptions
-- | A 'BlankChart', 'defaultHudOptions' example.
--
-- 
hudOptionsExample :: ChartOptions
hudOptionsExample =
mempty
& #hudOptions .~ defaultHudOptions
& #charts .~ blank one
-- | rect example
--
-- 
rectExample :: ChartOptions
rectExample =
mempty
& #hudOptions
.~ ( mempty
& set
#axes
[(defaultPriority, defaultAxisOptions & #ticks % #ltick .~ Nothing)]
)
& #charts .~ named "rect" (zipWith RectChart ropts rss)
rss :: [[Rect Double]]
rss =
[ gridR (\x -> exp (-x ** 2 / 2)) (Range (-5) 5) 50,
gridR (\x -> 0.5 * exp (-x ** 2 / 8)) (Range (-5) 5) 50
]
ropts :: [RectStyle]
ropts =
[ blob (palette1a 1 0.4),
blob (palette1a 2 0.4)
]
-- | line example
--
-- 
lineExample :: ChartOptions
lineExample =
mempty & set #hudOptions ho & #charts .~ named "line" cs
where
ho =
defaultHudOptions
& set
#titles
[ (6, defaultTitle "Line Chart" & set (#style % #size) 0.1),
( 11,
defaultTitle "Made with love and chart-svg"
& set (#style % #size) 0.06
& set #place PlaceBottom
& set #anchor AnchorEnd
)
]
& set
#legends
[ ( 12,
defaultLegendOptions
& over #frame (fmap (set #color white))
& set #place (PlaceAbsolute (Point 0.45 (-0.35)))
& set (#textStyle % #size) 0.20
& set #content (zipWith (\t c -> (t, [c])) ["palette1 0", "palette1 1", "palette1 2"] cs)
)
]
cs =
zipWith
( \c l ->
LineChart
( defaultLineStyle
& set #color (palette1 c)
& set #size 0.015
)
[l]
)
[0 ..]
ls
ls =
[ [Point 0.0 1.0, Point 1.0 1.0, Point 2.0 5.0],
[Point 0.0 0.0, Point 2.8 3.0],
[Point 0.5 4.0, Point 0.5 0]
]
priorityv1Example :: ChartOptions
priorityv1Example = lineExample & (#hudOptions % #frames) .~ [(1, FrameOptions (Just defaultRectStyle) 0), (100, FrameOptions (Just (defaultRectStyle & #color .~ (palette1 4 & opac' .~ 0.05) & #borderColor .~ palette1 4)) 0.1)] & #hudOptions % #legends %~ fmap (first (const (Priority 50))) & #hudOptions % #legends %~ fmap (second (set #place PlaceRight))
priorityv2Example :: ChartOptions
priorityv2Example = priorityv1Example & #hudOptions % #titles %~ fmap (first (const (Priority 51))) & #hudOptions % #legends %~ fmap (first (const (Priority 50))) & #hudOptions % #legends %~ fmap (second (set #place PlaceRight))
-- | text example
--
-- 
textExample :: ChartOptions
textExample =
mempty
& #charts
.~ named
"text"
[ TextChart
(defaultTextStyle & #color .~ dark & #size .~ 0.05 & #vshift .~ 0)
ts
]
& #hudOptions .~ defaultHudOptions
& #markupOptions % #cssOptions % #preferColorScheme .~ PreferHud
& #markupOptions % #cssOptions % #cssExtra .~ fillSwitch (dark, light) "dark" "text"
where
ts :: [(Text, Point Double)]
ts =
zip
(fmap Text.singleton ['a' .. 'z'])
((\x -> Point (sin (x * 0.1)) x) <$> [0 .. 25])
-- | glyphs example
--
-- 
glyphsExample :: ChartOptions
glyphsExample =
mempty
& set (#markupOptions % #markupHeight) 50
& set (#hudOptions % #chartAspect) (FixedAspect 12)
& set
#charts
( named "glyphs" $
zipWith
( \(sh, bs) p ->
GlyphChart
( defaultGlyphStyle
& #size .~ (0.8 :: Double)
& #borderSize .~ bs
& #shape .~ sh
)
[p]
)
[ (CircleGlyph, 0.02 :: Double),
(SquareGlyph, 0.02),
(RectSharpGlyph 0.75, 0.02),
(RectRoundedGlyph 0.75 0.01 0.01, 0.02),
(EllipseGlyph 0.75, 0.02),
(VLineGlyph, 0.02),
(HLineGlyph, 0.02),
(TriangleGlyph (Point 0.0 (0.5 * sqrt 2)) (Point (-cos (pi / 3)) (-sin (pi / 3) / 2)) (Point (cos (pi / 3)) (-sin (pi / 3) / 2)), 0.02),
(PathGlyph "M 0.5,-0.3660 A 1.0 1.0 -0.0 0 1 0,0.5 A 1.0 1.0 -0.0 0 1 -0.5,-0.3660 A 1.0 1.0 -0.0 0 1 0.5,-0.3660 L 0.5,-0.3660 Z" ScaleBorder, 0.02)
]
[Point x 0 | x <- [0 .. (8 :: Double)]]
)
-- | Example data for Bar chart
barDataExample :: BarData
barDataExample =
BarData
[[1, 2, 3, 5, 8, 0, -2, 11, 2, 1], [1 .. 10]]
(("row " <>) . Text.pack . show <$> [1 .. 11 :: Int])
(("column " <>) . Text.pack . show <$> [1 .. 2 :: Int])
-- | Bar chart example.
--
-- 
barExample :: ChartOptions
barExample = barChart defaultBarOptions barDataExample
-- | Stacked bar chart example.
--
-- 
sbarExample :: ChartOptions
sbarExample = barChart (defaultBarOptions & set #barOrientation Vert & set #barStacked Stacked & #displayValues .~ False & #barRectStyles %~ fmap (#borderSize .~ 0)) barDataExample
-- | wave example
--
-- 
waveExample :: ChartOptions
waveExample = mempty & #charts .~ named "wave" [GlyphChart defaultGlyphStyle $ gridP sin (Range 0 (2 * pi)) 30] & #hudOptions .~ defaultHudOptions
-- | venn diagram
--
-- 
vennExample :: ChartOptions
vennExample =
mempty
& #charts .~ named "venn" (zipWith (\c x -> PathChart (defaultPathStyle & #borderSize .~ 0.005 & #color .~ palette1a c 0.2 & over #borderColor (set opac' 1)) x) [0 ..] (svgToPathData <$> vennSegs))
& #hudOptions .~ defaultHudOptions
& #hudOptions % #chartAspect .~ FixedAspect 1
{-
These were originally based on:
[ ("origin", Point 0 0), -- origin
("circle1", Point 0.5 (-0.5 + cos (pi / 6))), -- center of circle 1
("circle2", Point 0 -0.5), -- center of circle 2
("circle3", Point -0.5 (-0.5 + cos (pi / 6))), -- center of circle 3
("corner1", Point 0 (-0.5 + 2 * cos (pi / 6))), -- corner 1
("corner2", Point 1 -0.5), -- corner 2
("corner3", Point -1 -0.5) -- corner 3
]
-}
vennSegs :: [ByteString]
vennSegs =
[ "M0.0,-1.2320508075688774 A0.5 0.5 0.0 1 1 1.0,0.5 1.0 1.0 0.0 0 0 0.5,-0.3660254037844387 1.0 1.0 0.0 0 0 0.0,-1.2320508075688774 Z",
"M-1.0,0.5 A0.5 0.5 0.0 1 0 1.0,0.5 1.0 1.0 0.0 0 1 0.0,0.5 1.0 1.0 0.0 0 1 -1.0,0.5 Z",
"M-1.0,0.5 A0.5 0.5 0.0 1 1 0.0,-1.2320508075688774 1.0 1.0 0.0 0 0 -0.5,-0.3660254037844387 1.0 1.0 0.0 0 0 -1.0,0.5 Z",
"M0.5,-0.3660254037844387 A1.0 1.0 0.0 0 1 1.0,0.5 1.0 1.0 0.0 0 1 0.0,0.5 1.0 1.0 0.0 0 0 0.5,-0.3660254037844387 Z",
"M0.0,0.5 A1.0 1.0 0.0 0 1 -1.0,0.5 1.0 1.0 0.0 0 1 -0.5,-0.3660254037844387 1.0 1.0 0.0 0 0 0.0,0.5 Z",
"M0.0,-1.2320508075688774 A1.0 1.0 0.0 0 1 0.5,-0.3660254037844387 1.0 1.0 0.0 0 0 -0.5,-0.3660254037844387 1.0 1.0 0.0 0 1 0.0,-1.2320508075688774 Z",
"M0.5,-0.3660254037844387 A1.0 1.0 0.0 0 1 0.0,0.5 1.0 1.0 0.0 0 1 -0.5,-0.3660254037844387 1.0 1.0 0.0 0 1 0.5,-0.3660254037844387 Z"
]
-- | Compound path example.
--
-- 
pathExample :: ChartOptions
pathExample =
mempty
& #charts .~ named "path" [path', c0] <> named "pathtext" [t0]
& #hudOptions .~ defaultHudOptions
& #hudOptions % #chartAspect .~ ChartAspect
& #markupOptions % #cssOptions % #preferColorScheme .~ PreferHud
& #markupOptions % #cssOptions % #cssExtra .~ fillSwitch (dark, light) "dark" "pathtext"
where
ps =
[ StartP (Point 0 0),
LineP (Point 1 0),
CubicP (Point 0.2 0) (Point 0.25 1) (Point 1 1),
QuadP (Point (-1) 2) (Point 0 1),
ArcP (ArcInfo (Point 1 1) (-pi / 6) False False) (Point 0 0)
]
ts =
[ "StartP (Point 0 0)",
"LineP (Point 1 0)",
"CubicP (Point 0.2 0) (Point 0.25 1) (Point 1 1)",
"QuadP (Point (-1) 2) (Point 0 1)",
"ArcP (ArcInfo (Point 1 1) (-pi / 6) False False) (Point 0 0)"
]
path' = PathChart (defaultPathStyle & #color .~ palette1a 0 0.1 & #borderColor .~ palette1a 1 1) ps
c0 = GlyphChart defaultGlyphStyle (pointPath <$> ps)
midp = Point 0 0 : zipWith (\(Point x y) (Point x' y') -> Point ((x + x') / 2) ((y + y') / 2)) (drop 1 (pointPath <$> ps)) (pointPath <$> ps)
offp = [Point 0 0.05, Point 0 0, Point (-0.2) 0, Point (-0.1) 0.1, Point 0 (-0.1)]
t0 = TextChart (defaultTextStyle & set #size 0.05) (zip ts (zipWith addp offp midp))
-- | ellipse example
--
-- Under scaling, angles are not invariant, and this effects the shape of ellipses and thus SVG arc paths. Compare the effect of aspect changes to the axes of this ellipse:
--
-- 
--
-- Below is the same ellipse with FixedAspect 2. Points scale exactly, but the original points that represent the end points of the axes are no longer on the new axes of the ellipse.
--
-- 
ellipseExample :: ChartAspect -> ChartOptions
ellipseExample a =
mempty
& #charts .~ named "ellipse" [ell, ellFull, c0, c1, bbox, xradii, yradii]
& #hudOptions .~ defaultHudOptions
& #hudOptions % #chartAspect .~ a
& #hudOptions % #legends .~ [(10, defaultLegendOptions & #content .~ lrows & #textStyle % #size .~ 0.2 & #size .~ 0.1)]
& #hudOptions % #titles .~ [(11, defaultTitle "ArcPosition (Point 1 0) (Point 0 1) (ArcInfo (Point 1.5 1) (pi / 3) True True)" & #style % #size .~ 0.08)]
where
p@(ArcPosition p1 p2 _) = ArcPosition (Point 1 0) (Point 0 1) (ArcInfo (Point 1.5 1) (pi / 3) True True)
(ArcCentroid c r phi' ang0' angd) = arcCentroid p
ellFull = LineChart fullels [ellipse c r phi' . (\x -> 2 * pi * x / 100.0) <$> [0 .. 100]]
ell = LineChart els [ellipse c r phi' . (\x -> ang0' + angd * x / 100.0) <$> [0 .. 100]]
g0 = defaultGlyphStyle & #shape .~ CircleGlyph
c0 = GlyphChart g0 [c]
g1 = defaultGlyphStyle & #color .~ palette1a 4 0.2
c1 = GlyphChart g1 [p1, p2]
bbox = RectChart bbs [arcBox p]
bbs = defaultRectStyle & #borderSize .~ 0.002 & #color .~ palette1a 7 0.005 & #borderColor .~ grey 0.5 1
xradii = LineChart xals [[ellipse c r phi' 0, ellipse c r phi' pi]]
yradii = LineChart yals [[ellipse c r phi' (pi / 2), ellipse c r phi' (3 / 2 * pi)]]
xals = defaultLineStyle & #color .~ palette1 6 & #size .~ 0.005 & #dasharray .~ Just [0.03, 0.01] & #linecap .~ Just LineCapRound
yals = defaultLineStyle & #color .~ palette1 5 & #size .~ 0.005 & #dasharray .~ Just [0.03, 0.01] & #linecap .~ Just LineCapRound
fullels = defaultLineStyle & #size .~ 0.002 & #color .~ palette1 1
els = defaultLineStyle & #size .~ 0.005 & #color .~ palette1 2
lrows =
second (: [])
<$> [ ("Major Axis", LineChart xals [[zero]]),
("Minor Axis", LineChart yals [[zero]]),
("Full Ellipse", LineChart fullels [[zero]]),
("Arc", LineChart els [[zero]]),
("Centroid", GlyphChart (g0 & #size .~ 0.01) [zero]),
("Endpoints", GlyphChart (g1 & #size .~ 0.01) [zero]),
("Bounding Box", RectChart (bbs & #borderSize .~ 0.01) [fmap (2 *) one])
]
-- | Reproduction of the flag explanation chart in <https://developer.mozilla.org/en-US/docs/Web/SVG/Tutorial/Paths>
--
-- 
arcFlagsExample :: ChartOptions
arcFlagsExample =
mempty
& set
#charts
( vert
0.02
[ hori 0.02 [colSweep, colSweep2, colLargeFalse, colLargeTrue],
rowLarge
]
)
& #hudOptions % #chartAspect .~ ChartAspect
& #markupOptions % #cssOptions % #preferColorScheme .~ PreferHud
& #markupOptions % #cssOptions % #cssExtra
.~ [i|
{
.chart g {
stroke: #{showRGBA dark};
}
.chart g text {
fill: #{showRGBA dark};
}
}
@media (prefers-color-scheme:dark) {
.chart g {
stroke: #{showRGBA light};
}
.chart g text {
fill: #{showRGBA light};
}
}
|]
where
rowLarge =
unnamed
[ BlankChart [Rect 0 9 (-2.75) (-3.25)],
TextChart (defaultTextStyle & #size .~ 0.6) [("Large", Point 5.5 (-3.0))]
]
colLargeFalse =
vert
0.02
[ unnamed (checkFlags False True (set opac' 0.3 dark)),
unnamed (checkFlags False False (set opac' 0.3 dark)),
unnamed
[ BlankChart [Rect (-1) 2 (-0.25) 0.25],
TextChart (defaultTextStyle & #size .~ 0.4) [("False", Point 0.5 (-0.1))]
]
]
colLargeTrue =
vert
0.02
[ unnamed (checkFlags True True (set opac' 0.3 dark)),
unnamed (checkFlags True False (set opac' 0.3 dark)),
unnamed
[ BlankChart [Rect (-1) 2 (-0.25) 0.25],
TextChart (defaultTextStyle & #size .~ 0.4) [("True", Point 0.5 (-0.1))]
]
]
colSweep =
unnamed
[ BlankChart [Rect (-0.4) 0.4 (-1) 5],
TextChart
(defaultTextStyle & #size .~ 0.6 & #rotation .~ Just (pi / 2))
[("Sweep", Point 0.1 2)]
]
colSweep2 =
vert
0.02
[ unnamed
[ BlankChart [Rect (-0.25) 0.25 (-1) 2],
TextChart
(defaultTextStyle & #size .~ 0.4 & #rotation .~ Just (pi / 2))
[("True", Point 0.1 0.5)]
],
unnamed
[ BlankChart [Rect (-0.25) 0.25 (-1) 2],
TextChart
(defaultTextStyle & #size .~ 0.4 & #rotation .~ Just (pi / 2))
[("False", Point 0.1 0.5)]
]
]
checkFlags :: Bool -> Bool -> Colour -> [Chart]
checkFlags large' sweep co = [c1, c2, ell, arc1]
where
c = Point 1.0 1.0
p1 = ArcPosition (Point 0.0 1.0) (Point 1.0 0.0) (ArcInfo (Point 1.0 1.0) 0 large' sweep)
ps1 = singletonPie c p1
(ArcCentroid c' r phi' ang0' angd) = arcCentroid p1
arc1 = PathChart (defaultPathStyle & #color .~ co & #borderColor .~ set opac' 0.5 dark) ps1
c1 = LineChart (defaultLineStyle & #size .~ 0.02 & #color .~ set opac' 0.2 dark) [ellipse (Point 1.0 1.0) (Point 1.0 1.0) 0 . (\x -> 0 + 2 * pi * x / 100.0) <$> [0 .. 100]]
c2 = LineChart (defaultLineStyle & #size .~ 0.02 & #color .~ set opac' 0.2 dark) [ellipse (Point 0.0 0.0) (Point 1.0 1.0) 0 . (\x -> 0 + 2 * pi * x / 100.0) <$> [0 .. 100]]
ell = LineChart (defaultLineStyle & #size .~ 0.05 & #color .~ set opac' 0.5 co) [ellipse c' r phi' . (\x -> ang0' + angd * x / 100.0) <$> [0 .. 100]]
-- | quad example
--
-- 
quadExample :: ChartOptions
quadExample =
mempty
& #charts .~ named "quad" [path', curve, c0, c1, bbox]
& #hudOptions .~ defaultHudOptions
& #hudOptions % #chartAspect .~ FixedAspect 1.5
& #hudOptions % #legends .~ [(10, defaultLegendOptions & #content .~ lrows & #textStyle % #size .~ 0.2 & #size .~ 0.2)]
& #hudOptions % #titles .~ [(11, defaultTitle "QuadPosition (Point 0 0) (Point 1 1) (Point 2 (-1))" & #style % #size .~ 0.08)]
where
p@(QuadPosition start end control) = QuadPosition (Point 0 0) (Point 1 1) (Point 2 (-1))
ps = singletonQuad p
path' = PathChart pathStyle ps
curve = LineChart curveStyle [quadBezier p . (/ 100.0) <$> [0 .. 100]]
curveStyle = defaultLineStyle & #size .~ 0.002 & #color .~ palette1 1
c0 = GlyphChart defaultGlyphStyle [start, end]
c1 = GlyphChart controlStyle [control]
bbox = RectChart bbs [quadBox p]
bbs = defaultRectStyle & #borderSize .~ 0.002 & #color .~ palette1a 0 0.05 & #borderColor .~ grey 0.4 1
pathStyle = defaultPathStyle & #color .~ palette1a 2 0.2 & #borderColor .~ transparent
controlStyle = defaultGlyphStyle & #shape .~ CircleGlyph
lrows =
second (: [])
<$> [ ("Path Fill", PathChart pathStyle [StartP zero]),
("Path Chord", LineChart curveStyle [[zero]]),
("Path Endpoints", GlyphChart defaultGlyphStyle [zero]),
("Path Control Point", GlyphChart controlStyle [zero]),
("Bounding Box", RectChart (bbs & #borderSize .~ 0.01) [one])
]
-- | cubic example
--
-- 
cubicExample :: ChartOptions
cubicExample =
mempty
& #charts .~ named "cubic" [path', curve, c0, c1, bbox]
& #hudOptions .~ mempty
& #hudOptions % #chartAspect .~ FixedAspect 1.5
& #hudOptions % #legends .~ [(10, defaultLegendOptions & #content .~ lrows & #textStyle % #size .~ 0.2 & #size .~ 0.2)]
& #hudOptions % #titles .~ [(11, defaultTitle "CubicPosition (Point 0 0) (Point 1 1) (Point 1 0) (Point 0 1)" & #style % #size .~ 0.08)]
where
p@(CubicPosition start end control1 control2) = CubicPosition (Point 0 0) (Point 1 1) (Point 1 0) (Point 0 1)
ps = singletonCubic p
path' = PathChart pathStyle ps
curve = LineChart curveStyle [cubicBezier p . (/ 100.0) <$> [0 .. 100]]
c0 = GlyphChart defaultGlyphStyle [start, end]
c1 = GlyphChart controlStyle [control1, control2]
bbox = RectChart bbs [cubicBox p]
bbs = defaultRectStyle & #borderSize .~ 0.002 & #color .~ palette1a 0 0.05 & #borderColor .~ grey 0.4 1
pathStyle = defaultPathStyle & #color .~ palette1a 3 0.2 & #borderColor .~ transparent
controlStyle = defaultGlyphStyle & #shape .~ CircleGlyph
curveStyle = defaultLineStyle & #size .~ 0.002 & #color .~ palette1 7
lrows =
second (: [])
<$> [ ("Path Fill", PathChart pathStyle [StartP zero]),
("Path Chord", LineChart curveStyle [[zero]]),
("Path Endpoints", GlyphChart defaultGlyphStyle [zero]),
("Path Control Point", GlyphChart controlStyle [zero]),
("Bounding Box", RectChart (bbs & #borderSize .~ 0.01) [one])
]
-- | The common way to create a surface chart (or contour chart or heat map) is usually a grid over a function, a process reified in 'surfacef'.
--
-- This is also an example of 'mix' and 'mixes'. In this example, colors with the same lightness have been chosen in the gradient and the result should appear a fairly uniform lightness across the surface.
--
-- 
surfaceExample :: ChartOptions
surfaceExample =
mempty
& #charts .~ named "surface" cs
& #markupOptions .~ (defaultMarkupOptions & #cssOptions % #shapeRendering .~ UseCssCrisp)
where
grain = Point 100 100
r = one
f = fst . bimap ((-1.0) *) (fmap ((-1.0) *)) . rosenbrock 1 10
evenColors = trimColour . over lightness' (const 0.55) . palette1 <$> [0 .. 5]
so =
defaultSurfaceOptions
& #soGrain .~ grain
& #soRange .~ r
& #soStyle % #surfaceColors .~ evenColors
(cs, _) = surfacef f so
-- | arrow example
--
-- Which happens to be the gradient of the surface example.
--
-- 
arrowExample :: ChartOptions
arrowExample =
mempty
& #hudOptions .~ (defaultHudOptions & #axes %~ fmap (second (#ticks % #ltick .~ Nothing)))
& #charts .~ named "arrow" ((\p -> gchart (tail' . f $ p) (angle . f $ p) p) <$> ps)
& #markupOptions % #cssOptions % #preferColorScheme .~ PreferHud
& #markupOptions % #cssOptions % #cssExtra
.~ [i|
{
.arrow g {
fill: #{showRGBA dark};
stroke: #{showRGBA dark};
}
}
@media (prefers-color-scheme:dark) {
.arrow g {
fill: #{showRGBA light};
stroke: #{showRGBA light};
}
}
|]
where
f = snd . bimap ((-1.0) *) (fmap ((-1.0) *)) . rosenbrock 1 10
ps = grid MidPos (one :: Rect Double) (Point 10 10 :: Point Int) :: [Point Double]
arrow = PathGlyph "M -1 0 L 1 0 M 1 0 L 0.4 0.3 M 1 0 L 0.4 -0.3" NoScaleBorder
gs s r' =
defaultGlyphStyle
& #borderSize .~ 0.05
& #size .~ s
& #borderColor .~ dark
& #rotation .~ Just r'
& #shape .~ arrow
gchart s r' p = GlyphChart (gs s r') [p]
tail' :: Point Double -> Double
tail' = max 0.05 . min 0.02 . (* 0.01) . (/ avmag) . norm
avmag = sum (norm . f <$> ps) / fromIntegral (length ps)
-- | function for testing
--
-- > f(x,y) = (a-x)^2 + b * (y - x^2)^2
-- > = a^2 - 2ax + x^2 + b * y^2 - b * 2 * y * x^2 + b * x ^ 4
-- > f'x = -2a + 2 * x - b * 4 * y * x + 4 * b * x ^ 3
-- > f'y = 2 * b * y - 2 * b * x^2
-- > f a b (Point x y) = (a^2 - 2ax + x^2 + b * y^2 - b * 2 * y * x^2 + b * x^4, Point (-2a + 2 * x - b * 4 * y * x + 4 * b * x ^ 3), 2 * b * y - 2 * b * x^2)
rosenbrock :: Double -> Double -> Point Double -> (Double, Point Double)
rosenbrock a b (Point x y) = (a ** 2 - 2 * a * x + x ** 2 + b * y ** 2 - b * 2 * y * x ** 2 + b * x ** 4, Point (-2 * a + 2 * x - b * 4 * y * x + 4 * b * x ** 3) (2 * b * y - 2 * b * x ** 2))
-- | date example
--
-- A hud that has date as the x-axis, and time as the y-axis. See 'placedTimeLabelContinuous'.
--
-- 
dateExample :: ChartOptions
dateExample =
mempty
& #charts .~ blank (Rect 0 1 0 1)
& #hudOptions
.~ ( mempty
& #chartAspect .~ FixedAspect 1.5
& #axes
.~ [ (defaultPriority, defaultAxisOptions & #place .~ PlaceLeft & #ticks % #style .~ TickPlaced tsTime),
(defaultPriority, defaultAxisOptions & #ticks % #style .~ TickPlaced tsDate)
]
)
where
tsTime = placedTimeLabelContinuous PosIncludeBoundaries Nothing 12 (Range (UTCTime (fromGregorian 2021 12 6) (toDiffTime 0)) (UTCTime (fromGregorian 2021 12 7) (toDiffTime 0)))
tsDate = placedTimeLabelContinuous PosIncludeBoundaries (Just (Text.pack "%d %b")) 2 (Range (UTCTime (fromGregorian 2021 12 6) (toDiffTime 0)) (UTCTime (fromGregorian 2022 3 13) (toDiffTime 0)))
-- | gradient example
--
-- Mixing Colours using the <https://bottosson.github.io/posts/oklab/ oklch> color model.
--
-- 
gradientExample :: ChartOptions
gradientExample = gradient (Just (orig / 360)) 100 6 100 c0 c1
where
ok = LCHA 0.5 0.12 127 1
c0 = ok & lch' % hLCH' .~ 0.001
c1 = ok & lch' % hLCH' .~ 360
orig = view (lch' % hLCH') ok
gradientChart_ :: Int -> LCHA -> LCHA -> [Chart]
gradientChart_ grain c0 c1 =
(\(r, c) -> RectChart (defaultRectStyle & #color .~ c & #borderSize .~ 0) [r])
. (\x -> (Rect x (x + d) 0 1, view lcha2colour' (mixLCHA x c0 c1)))
<$> grid LowerPos (Range 0 1) grain
where
d = 1 / fromIntegral grain
gradient :: Maybe Double -> Double -> Double -> Int -> LCHA -> LCHA -> ChartOptions
gradient marker h fa grain ok0 ok1 =
mempty
& #markupOptions % #markupHeight
.~ h
& #markupOptions % #cssOptions % #shapeRendering
.~ UseCssCrisp
& #hudOptions
.~ ( mempty
& #chartAspect .~ FixedAspect fa
& #frames .~ [(Priority 1, FrameOptions (Just (border 0.004 white)) 0.1)]
)
& #charts
.~ named "gradient" (gradientChart_ grain ok0 ok1) <> strip
where
strip = case marker of
Nothing -> mempty
Just marker' ->
named
"border"
[borderStrip 0.02 light (Rect (marker' - 0.02) (marker' + 0.02) (-0.1) 1.1)]
borderStrip :: Double -> Colour -> Rect Double -> Chart
borderStrip w c r = RectChart (defaultRectStyle & #color .~ transparent & #borderSize .~ w & #borderColor .~ c) [r]
-- | Color wheel displaying palette1 choices
--
-- -- 
wheelExample :: ChartOptions
wheelExample = dotMap 0.01 50 0.5 0.5 (palette1 <$> [0 .. 7])
-- | The dotMap
--
-- > dotMap 0.01 20 0.8 0.3
dotMap :: Double -> Int -> Double -> Double -> [Colour] -> ChartOptions
dotMap s grain l maxchroma cs =
mempty
& #hudOptions
.~ defaultHudOptions
& #charts
.~ named "dots" (dot_ <$> cs)
<> named
"wheel"
( ( \(p, c) ->
GlyphChart
( defaultGlyphStyle
& #size .~ s
& #color .~ c
& #borderSize .~ 0
)
[p]
)
<$> filter (validColour . snd) (wheelPoints grain l maxchroma)
)
dot_ :: Colour -> Chart
dot_ x = (\(p, c) -> GlyphChart (defaultGlyphStyle & #size .~ 0.08 & #color .~ c & #borderColor .~ Colour 0.5 0.5 0.5 1 & #shape .~ CircleGlyph) [p]) (colour2Point x, x)
where
colour2Point c = review lcha2colour' c & (\(LCHA _ ch h _) -> uncurry Point (review xy2ch' (ch, h)))
wheelPoints :: Int -> Double -> Double -> [(Point Double, Colour)]
wheelPoints grain l maxchroma =
(\(Point c h) -> (uncurry Point $ view (re xy2ch') (c, h), view lcha2colour' (LCHA l c h 1)))
<$> grid LowerPos (Rect 0 maxchroma 0 360) (Point grain grain)
-- | Adding reference points and bounding boxes to visualize chart alignment for use in debugging charts.
--
-- -- 
debugExample :: ChartOptions -> ChartOptions
debugExample cs =
mempty
& set #markupOptions (view #markupOptions cs)
& set (#hudOptions % #chartAspect) (view (#hudOptions % #chartAspect) cs)
& set #charts (e1 <> e2 <> e3)
where
e1 = addHud (view #hudOptions cs) (view #charts cs)
e2 = glyphize (defaultGlyphStyle & #size .~ 0.01 & #shape .~ CircleGlyph) e1
e3 = rectangularize (defaultRectStyle & #borderColor .~ dark & #borderSize .~ 0.001 & #color % opac' .~ 0.05) e1
-- | All the examples and the associated filepaths
pathChartOptions :: [(FilePath, ChartOptions)]
pathChartOptions =
[ ("other/unit.svg", unitExample),
("other/rect.svg", rectExample),
("other/text.svg", textExample),
("other/glyphs.svg", glyphsExample),
("other/line.svg", lineExample),
("other/hudoptions.svg", hudOptionsExample),
("other/bar.svg", barExample),
("other/sbar.svg", sbarExample),
("other/surface.svg", surfaceExample),
("other/wave.svg", waveExample),
("other/venn.svg", vennExample),
("other/path.svg", pathExample),
("other/arcflags.svg", arcFlagsExample),
("other/ellipse.svg", ellipseExample (FixedAspect 1.7)),
("other/ellipse2.svg", ellipseExample (FixedAspect 2)),
("other/quad.svg", quadExample),
("other/cubic.svg", cubicExample),
("other/arrow.svg", arrowExample),
("other/date.svg", dateExample),
("other/gradient.svg", gradientExample),
("other/wheel.svg", wheelExample),
("other/debug.svg", debugExample lineExample),
("other/priorityv1.svg", priorityv1Example),
("other/priorityv2.svg", priorityv2Example)
]
-- | Run this to refresh example SVG's.
writeAllExamples :: IO ()
writeAllExamples = do
mapM_ (uncurry writeChartOptions) pathChartOptions
putStrLn "ok"
-- | Version of charts with a dark-friendly hud
writeAllExamplesDark :: IO ()
writeAllExamplesDark = do
mapM_
( uncurry writeChartOptions
. bimap
((<> "d.svg") . reverse . drop 4 . reverse)
( \x ->
x
& #hudOptions %~ colourHudOptions (rgb light)
& #markupOptions % #cssOptions % #preferColorScheme .~ PreferDark
)
)
pathChartOptions
putStrLn "dark version, ok"