diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,9 @@ +0.2 +=== +- removed gpalette (transferred to chart-svg) +- color-scheme bug fixed +- chart-svg-0.6 refactors + 0.1.2 === diff --git a/other/anychart.svg b/other/anychart.svg --- a/other/anychart.svg +++ b/other/anychart.svg @@ -1,4 +1,4 @@ --1.0-0.5 0.0 0.5 1.00.00.20.40.60.81.0 diff --git a/prettychart.cabal b/prettychart.cabal --- a/prettychart.cabal +++ b/prettychart.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: prettychart -version: 0.1.2.0 +version: 0.2.0.0 license: BSD-3-Clause license-file: LICENSE copyright: Tony Day (c) 2023 @@ -13,7 +13,7 @@ description: Serve and print charts from ghci, with automatic formatting. build-type: Simple -tested-with: GHC == 8.10.7 || ==9.2.8 || ==9.4.5 || ==9.6.2 +tested-with: GHC == 8.10.7 || ==9.2.8 || ==9.4.5 || ==9.6.2 || ==9.8.1 extra-doc-files: ChangeLog.md other/*.svg @@ -98,14 +98,14 @@ , base >=4.7 && <5 , box >=0.9 && <0.10 , bytestring >=0.11.3 && <0.13 - , chart-svg >=0.5 && <0.6 - , containers >=0.6 && <0.7 + , chart-svg >=0.6 && <0.7 + , containers >=0.6 && <0.8 , markup-parse >=0.1 && <0.2 , numhask-space >=0.10 && <0.12 , optics-core >=0.4 && <0.5 - , text >=1.2 && <2.1 + , text >=1.2 && <2.2 , time >=1.9 && <1.13 - , web-rep >=0.10.1 && <0.12 + , web-rep >=0.12.1 && <0.13 exposed-modules: Prettychart Prettychart.Any diff --git a/readme.org b/readme.org --- a/readme.org +++ b/readme.org @@ -9,6 +9,24 @@ - Some useful chart patterns that didn't make the cut in chart-svg (See Chartpretty.Charts) * Usage +** live coding + +The server can be used to view and develop chart-svg charts. + +#+begin_src haskell :results output +> (display, quit) <- startChartServer (Just "prettychart") +Setting phaser>s to stun... (port 9160) (ctrl-c to quit) + +-- open localhost:9160 +-- developing and sending a chart to the server + +> import Chart.Examples +> display lineExample + +> quit + +#+end_src + ** ghci integration Add this to your .ghci.conf file to automatically go into :prettychart mode. @@ -49,27 +67,6 @@ :noprettychart #+end_src -** live coding - -The server can also be used to view and develop chart-svg charts. - -#+begin_src haskell :results output -> (sendChart, quitChartServer) <- startChartServer (Just "prettychart") -Setting phaser>s to stun... (port 9160) (ctrl-c to quit) - --- open localhost:9160 --- developing and sending a chart to the server - -> import Chart.Examples -> sendChart $ lineExample - -> quitServer -> [1..10] -[1,2,3,4,5,6,7,8,9,10] - -#+end_src - - * Development #+begin_src haskell :results output @@ -107,13 +104,13 @@ ** live #+begin_src haskell :results output -(sendChart, quitChartServer) <- startChartServer Nothing +(display, quit) <- startChartServer Nothing #+end_src #+RESULTS: #+begin_src haskell :results output -sendChart $ debugExample quadExample +display $ debugExample quadExample #+end_src #+RESULTS: diff --git a/src/Prettychart/Any.hs b/src/Prettychart/Any.hs --- a/src/Prettychart/Any.hs +++ b/src/Prettychart/Any.hs @@ -67,18 +67,19 @@ -- | Default chart for a single list. anyList1 :: [Double] -> ChartOptions anyList1 xs - | length xs > 1000 = histChart (unsafeSpace1 xs) 20 xs + | length xs > 1000 = histChart (fromMaybe one $ space1 xs) 20 xs | length xs > 10 = anyLineChart [xs] | otherwise = barChart defaultBarOptions (BarData [xs] [] []) -- | Default chart for a double list. anyList2 :: [[Double]] -> ChartOptions -anyList2 xss - | (length xss < 4) && (length (head xss) < 10) = anyBar2 xss +anyList2 [] = mempty +anyList2 l@(xs : xss) + | (length xss < 4) && (length xs < 10) = anyBar2 l -- square - | all (length xss ==) (length <$> xss) = - anySurfaceChart xss - | otherwise = anyLineChart xss + | all ((length l ==) . length) l = + anySurfaceChart l + | otherwise = anyLineChart l -- | Bar chart for a labelled list. anySingleNamedBarChart :: [(Text, Double)] -> ChartOptions @@ -109,29 +110,33 @@ anyLineChart :: [[Double]] -> ChartOptions anyLineChart xss = mempty - & #hudOptions .~ defaultHudOptions - & #charts .~ unnamed (zipWith (\c xs -> simpleLineChart 0.02 (palette1 c) xs) [0 ..] xss) + & #hudOptions + .~ defaultHudOptions + & #chartTree + .~ unnamed (zipWith (\c xs -> simpleLineChart 0.02 (palette c) xs) [0 ..] xss) -- | Default scatter chart for paired data anyTuple2 :: [[(Double, Double)]] -> ChartOptions anyTuple2 xss = mempty - & #hudOptions .~ defaultHudOptions - & #charts .~ unnamed (scatterChart (fmap (fmap (uncurry Point)) xss)) + & #hudOptions + .~ defaultHudOptions + & #chartTree + .~ unnamed (scatterChart (fmap (fmap (uncurry Point)) xss)) -- | Default pixel chart for double list. anySurfaceChart :: [[Double]] -> ChartOptions -anySurfaceChart xss = mempty & #charts .~ ct +anySurfaceChart xss = mempty & #chartTree .~ ct where - ct = runHud (aspect 1) h0 (unnamed c) - (h0, _) = toHuds (anySurfaceHud nrows ncols) gr + ct = runHudWith one h0 (unnamed c) + (_, h0) = toHuds (anySurfaceHud nrows ncols) gr gr = Rect 0 (fromIntegral nrows :: Double) 0 (fromIntegral ncols) (c, _) = surfacef (\(Point x y) -> (xss' !! floor x) !! floor y) (SurfaceOptions defaultSurfaceStyle (Point nrows ncols) gr) -- (defaultSurfaceLegendOptions dark "") - nrows = rows xss + nrows = Prettychart.Any.rows xss ncols = length xss xss' = appendZeros xss @@ -143,7 +148,7 @@ appendZeros xs = ( \x -> take - (rows xs) + (Prettychart.Any.rows xs) (x <> repeat 0) ) <$> xs @@ -152,17 +157,21 @@ anySurfaceHud nx ny = defaultHudOptions & #axes - .~ [ ( 5, - defaultAxisOptions - & #ticks % #style .~ TickPlaced (zip ((0.5 +) <$> [0 ..]) labelsy) - & #place .~ PlaceLeft + .~ [ Priority + 5 + ( defaultYAxisOptions + & #ticks + % #tick + .~ TickPlaced (zip ((0.5 +) <$> [0 ..]) labelsy) ), - ( 5, - defaultAxisOptions - & #ticks % #style .~ TickPlaced (zip ((0.5 +) <$> [0 ..]) labelsx) - & #place .~ PlaceBottom + Priority + 5 + ( defaultXAxisOptions + & #ticks + % #tick + .~ TickPlaced (zip ((0.5 +) <$> [0 ..]) labelsx) ) - ] + ] where labelsx = pack . show <$> [0 .. (nx - 1)] labelsy = pack . show <$> [0 .. (ny - 1)] diff --git a/src/Prettychart/Charts.hs b/src/Prettychart/Charts.hs --- a/src/Prettychart/Charts.hs +++ b/src/Prettychart/Charts.hs @@ -10,7 +10,6 @@ timeXAxis, titles3, histChart, - gpalette, scatterChart, blendMidLineStyles, quantileNames, @@ -66,18 +65,19 @@ -- | Create a hud that has time as the x-axis, based on supplied UTCTime list. timeXAxis :: Int -> [UTCTime] -> AxisOptions timeXAxis nticks ds = - defaultAxisOptions - & #ticks % #style - .~ TickPlaced - ( first (* fromIntegral (length ds)) <$> placedTimeLabelContinuous PosInnerOnly Nothing nticks (unsafeSpace1 ds) - ) + defaultXAxisOptions + & #ticks + % #tick + .~ TickPlaced + ( first (* fromIntegral (length ds)) <$> placedTimeLabelContinuous PosInnerOnly Nothing nticks (unsafeSpace1 ds) + ) -- | common pattern of chart title, x-axis title and y-axis title -titles3 :: Priority -> (Text, Text, Text) -> [(Priority, Title)] +titles3 :: Double -> (Text, Text, Text) -> [Priority TitleOptions] titles3 p (t, x, y) = - [ (p, defaultTitle t & #style % #size .~ 0.08), - (p, defaultTitle x & #place .~ PlaceBottom & #style % #size .~ 0.05), - (p, defaultTitle y & #place .~ PlaceLeft & #style % #size .~ 0.05) + [ Priority p (defaultTitleOptions t & #style % #size .~ 0.08), + Priority p (defaultTitleOptions x & #place .~ PlaceBottom & #style % #size .~ 0.05), + Priority p (defaultTitleOptions y & #place .~ PlaceLeft & #style % #size .~ 0.05) ] -- | histogram chart @@ -88,9 +88,14 @@ ChartOptions histChart r g xs = mempty - & #charts .~ named "histogram" [RectChart defaultRectStyle rects] - & #hudOptions % #axes .~ [(5, defaultAxisOptions & #ticks % #ltick .~ Nothing & #ticks % #style .~ TickRound (FormatN FSCommaPrec (Just 2) 4 True True) 5 NoTickExtend)] - & #hudOptions % #frames .~ [(20, defaultFrameOptions & #buffer .~ 0.05)] + & #chartTree + .~ named "histogram" [RectChart defaultRectStyle rects] + & #hudOptions + % #axes + .~ [Priority 5 (defaultXAxisOptions & #ticks % #lineTick .~ Nothing & #ticks % #tick .~ TickRound (FormatN FSCommaPrec (Just 2) 4 True True) 5 NoTickExtend)] + & #hudOptions + % #frames + .~ [Priority 20 (defaultFrameOptions & #buffer .~ 0.05)] where hcuts = gridSensible OuterPos False r g h = fill hcuts xs @@ -102,45 +107,36 @@ scatterChart :: [[Point Double]] -> [Chart] -scatterChart xss = zipWith GlyphChart (gpaletteStyle 0.04 0.01) xss +scatterChart xss = zipWith (\(s, sh) ps -> GlyphChart (s & set #glyphShape sh) ps) (gpaletteStyle 0.04 0.01) xss -- | GlyphStyle palette -gpaletteStyle :: Double -> Double -> [GlyphStyle] -gpaletteStyle s bs = zipWith (\c g -> defaultGlyphStyle & #size .~ s & #color .~ palette1 c & #shape .~ g & #borderSize .~ bs) [0 ..] gpalette - --- | Glyph palette -gpalette :: [GlyphShape] -gpalette = - [ CircleGlyph, - SquareGlyph, - RectSharpGlyph 0.75, - RectRoundedGlyph 0.75 0.01 0.01, - EllipseGlyph 0.75, - VLineGlyph, - HLineGlyph, - TriangleGlyph (Point 0.0 0.0) (Point 1 1) (Point 1 0), - PathGlyph "M0.05,-0.03660254037844387 A0.1 0.1 0.0 0 1 0.0,0.05 0.1 0.1 0.0 0 1 -0.05,-0.03660254037844387 0.1 0.1 0.0 0 1 0.05,-0.03660254037844387 Z" ScaleBorder - ] +gpaletteStyle :: Double -> Double -> [(Style, GlyphShape)] +gpaletteStyle s bs = zipWith (\c g -> (defaultGlyphStyle & #size .~ s & #color .~ palette c & #glyphShape .~ g & #borderSize .~ bs, g)) [0 ..] (gpalette <$> [0 .. 8]) -- | Chart template for quantiles. quantileChart :: [Text] -> - [LineStyle] -> + [Style] -> [[Double]] -> ChartOptions -quantileChart names ls xs = mempty & #hudOptions .~ h & #charts .~ unnamed c +quantileChart names ls xs = mempty & #hudOptions .~ h & #chartTree .~ unnamed c where h = defaultHudOptions & ( #legends - .~ [ ( 10, + .~ [ Priority 10 $ defaultLegendOptions - & #textStyle % #size .~ 0.1 - & #vgap .~ 0.05 - & #innerPad .~ 0.2 - & #place .~ PlaceRight - & #legendCharts .~ zip names ((: []) <$> c) - ) + & #textStyle + % #size + .~ 0.1 + & #vgap + .~ 0.05 + & #innerPad + .~ 0.2 + & #place + .~ PlaceRight + & #legendCharts + .~ zip names ((: []) <$> c) ] ) c = @@ -157,7 +153,7 @@ quantileNames qs = percent commaSF Nothing <$> qs -- | @blendMidLineStyle n w@ produces n lines of width w interpolated between two colors. -blendMidLineStyles :: Int -> Double -> (Colour, Colour) -> [LineStyle] +blendMidLineStyles :: Int -> Double -> (Colour, Colour) -> [Style] blendMidLineStyles l w (c1, c2) = lo where m = (fromIntegral l - 1) / 2 :: Double @@ -174,26 +170,27 @@ -- | quantile values [Double] -> ChartOptions -quantileHistChart names qs vs = mempty & #charts .~ unnamed [chart'] & #hudOptions .~ hudOptions +quantileHistChart names qs vs = mempty & #chartTree .~ unnamed [chart'] & #hudOptions .~ hudOptions where hudOptions = defaultHudOptions & #axes - .~ [ ( 5, - maybe - ( axis0 - & #ticks % #style - .~ TickRound (FormatN FSDecimal (Just 3) 4 True True) 6 TickExtend - ) - ( \x -> - axis0 - & #ticks % #style - .~ TickPlaced (zip vs x) - ) - names - ) - ] - axis0 = defaultAxisOptions & #ticks % #ltick .~ Nothing & (#ticks % #ttick) %~ fmap (first (#size .~ 0.03)) + .~ [ Priority 5 $ + maybe + ( axis0 + & #ticks + % #tick + .~ TickRound (FormatN FSDecimal (Just 3) 4 True True) 6 TickExtend + ) + ( \x -> + axis0 + & #ticks + % #tick + .~ TickPlaced (zip vs x) + ) + names + ] + axis0 = defaultXAxisOptions & #ticks % #lineTick .~ Nothing & set (#ticks % #textTick %? #style % #size) 0.03 chart' = RectChart defaultRectStyle hr hr = zipWith @@ -208,27 +205,38 @@ [Text] -> ChartOptions digitChart utcs xs labels = - mempty & #charts .~ unnamed [c] & #hudOptions .~ hudOptions + mempty & #chartTree .~ unnamed [c] & #hudOptions .~ hudOptions where hudOptions = defaultHudOptions - & #axes .~ [(5, timeXAxis 8 utcs), (5, decileYAxis labels)] + & #axes + .~ [Priority 5 (timeXAxis 8 utcs), Priority 5 (decileYAxis labels)] c = GlyphChart ( defaultGlyphStyle - & #color .~ Colour 0 0 1 1 - & #shape .~ CircleGlyph - & #size .~ 0.01 + & #color + .~ Colour 0 0 1 1 + & #size + .~ 0.01 + & #glyphShape + .~ CircleGlyph ) (xify xs) decileYAxis :: [Text] -> AxisOptions decileYAxis labels = - defaultAxisOptions - & #ticks % #style .~ TickPlaced (zip ((+ 0.5) <$> [0 ..]) labels) - & #ticks % #ltick .~ Nothing - & #ticks % #ttick %~ fmap (first (#size .~ 0.03)) - & #place .~ PlaceLeft + defaultYAxisOptions + & #ticks + % #tick + .~ TickPlaced (zip ((+ 0.5) <$> [0 ..]) labels) + & #ticks + % #lineTick + .~ Nothing + & #ticks + % #textTick + %? #style + % #size + .~ 0.03 -- | Surface chart of quantile vs quantile counts digitSurfaceChart :: @@ -239,7 +247,7 @@ [(Int, Int)] -> ChartTree digitSurfaceChart pixelStyle _ ts names ps = - runHud (aspect 1) hs0 (unnamed cs1) + runHudWith one hs0 (unnamed cs1) where l = length names - 1 pts = Point l l @@ -248,7 +256,7 @@ mapCount = foldl' (\m x -> Map.insertWith (+) x 1.0 m) Map.empty ps f :: Point Double -> Double f (Point x y) = fromMaybe 0 $ Map.lookup (floor (1 + x), floor (1 + y)) mapCount - (hs0, _) = toHuds (qvqHud ts names) gr + (_, hs0) = toHuds (qvqHud ts names) gr (cs1, _) = surfacef f @@ -257,18 +265,35 @@ qvqHud :: (Text, Text, Text) -> [Text] -> HudOptions qvqHud ts labels = defaultHudOptions - & #titles .~ titles3 5 ts + & #titles + .~ titles3 5 ts & #axes - .~ ( (3,) - <$> [ defaultAxisOptions - & #ticks % #style .~ TickPlaced (zip [0 ..] labels) - & #ticks % #ltick .~ Nothing - & #ticks % #ttick %~ fmap (first (#size .~ 0.03)) - & #place .~ PlaceLeft, - defaultAxisOptions - & #ticks % #style .~ TickPlaced (zip [0 ..] labels) - & #ticks % #ltick .~ Nothing - & #ticks % #ttick %~ fmap (first (#size .~ 0.03)) - & #place .~ PlaceBottom - ] - ) + .~ ( Priority 3 + <$> [ defaultYAxisOptions + & #ticks + % #tick + .~ TickPlaced (zip [0 ..] labels) + & #ticks + % #lineTick + .~ Nothing + & #ticks + % #textTick + %? #style + % #size + .~ 0.03 + & #place + .~ PlaceLeft, + defaultXAxisOptions + & #ticks + % #tick + .~ TickPlaced (zip [0 ..] labels) + & #ticks + % #lineTick + .~ Nothing + & #ticks + % #textTick + %? #style + % #size + .~ 0.03 + ] + ) diff --git a/src/Prettychart/Server.hs b/src/Prettychart/Server.hs --- a/src/Prettychart/Server.hs +++ b/src/Prettychart/Server.hs @@ -27,13 +27,15 @@ chartSocketPage title = bootstrapPage & #jsOnLoad - .~ mconcat - [ webSocket, - runScriptJs, - refreshJsbJs - ] + .~ mconcat + [ webSocket, + runScriptJs, + refreshJsbJs + ] & #htmlBody - .~ element "div" [Attr "class" "container"] (element "row" [Attr "class" "col"] (maybe mempty (elementc "h4" []) title) <> element_ "div" (pure $ Attr "id" "prettychart")) + .~ element "div" [Attr "class" "container"] (element "row" [Attr "class" "col"] (maybe mempty (elementc "h4" []) title) <> element_ "div" (pure $ Attr "id" "prettychart")) + & #cssBody + .~ cssColorScheme -- | Print a chart supplying a 'ChartOptions' consumer, and a showable thing that may be chartable. The first argument flags whether to also print the item to stdout. printChart :: (Show a) => Bool -> (ChartOptions -> IO Bool) -> a -> IO ()