never executed always true always false
1 -- This Source Code Form is subject to the terms of the Mozilla Public
2 -- License, v. 2.0. If a copy of the MPL was not distributed with this
3 -- file, You can obtain one at http://mozilla.org/MPL/2.0/.
4
5 {-# LANGUAGE DuplicateRecordFields #-}
6 {-# LANGUAGE NamedFieldPuns #-}
7
8 -- |
9 -- Copyright: © 2018-2020 IOHK
10 -- License: MPL-2.0
11 -- Stability: experimental
12 --
13 -- Plot 'Histogram' as unicode strings; for terminal plotting.
14 -- For example, one could plot answers and their frequencies to the question:
15 --
16 -- /"Who's your favorite metal band?"/
17 --
18 -- > plot $ Histogram
19 -- > { width = 80
20 -- > , height = 24
21 -- > , bins =
22 -- > [ ( "Metallica", 78 )
23 -- > , ( "Iron Maiden", 61 )
24 -- > , ( "Slayer", 16 )
25 -- > , ( "Dimmu Borgir", 3 )
26 -- > , ( "Ghost", 48 )
27 -- > ]
28 -- > }
29 --
30 -- > 78 ┤┌─────────────┐
31 -- > ││ │
32 -- > ││ │
33 -- > ││ │
34 -- > ││ │
35 -- > 62 ┤│ │
36 -- > ││ ├─────────────┐
37 -- > ││ │ │
38 -- > ││ │ │
39 -- > ││ │ │
40 -- > 47 ┤│ │ │ ┌─────────────┐
41 -- > ││ │ │ │ │
42 -- > ││ │ │ │ │
43 -- > ││ │ │ │ │
44 -- > ││ │ │ │ │
45 -- > 31 ┤│ │ │ │ │
46 -- > ││ │ │ │ │
47 -- > ││ │ │ │ │
48 -- > ││ │ │ │ │
49 -- > ││ │ │ │ │
50 -- > 16 ┤│ │ ├─────────────┐ │ │
51 -- > ││ │ │ │ │ │
52 -- > ││ │ │ │ │ │
53 -- > ││ │ │ │ │ │
54 -- > ││ │ │ ├──────────────┤ │
55 -- > Metallica Iron Maiden Slayer Dimmu Borgir Ghost
56 module Plot.Text.Histogram
57 ( Histogram (..)
58 , plot
59 ) where
60
61 import Control.Applicative
62 ( (<|>) )
63 import Data.List
64 ( nub )
65 import Data.Maybe
66 ( fromJust, fromMaybe )
67
68 -- | Model a distribution as an [Histogram](https://en.wikipedia.org/wiki/Histogram).
69 -- This representation works for continuous non-overlapping distributions. Axes
70 -- are labelled automatically based on the bins.
71 data Histogram = Histogram
72 { width :: !Int
73 , height :: !Int
74 , bins :: ![(String, Int)]
75 } deriving (Show, Read)
76
77 -- | Convert an 'Histogram' to 'String'
78 plot :: Histogram -> String
79 plot Histogram{width,height,bins}
80 | height == 0 || width == 0 =
81 ""
82 | otherwise =
83 unlines $ getPlot $ mconcat $ axis widthYAxis ys : (bar . mkBar <$> bins)
84 where
85 highest = maximum (snd <$> bins)
86 nbLbls = min (length bins) (height `div` 3)
87
88 widthYAxis = maximum ((+3) . length <$> lbls)
89
90 mkBar (label, x) = Bar
91 { width = 1 + (width - 2 - widthYAxis) `div` length bins
92 , height = round (double height * double x / double highest)
93 , label
94 }
95
96 lbls = nub [ show $ round (double highest * double i / double nbLbls)
97 | i <- [ 1 .. nbLbls ]
98 ]
99
100 ys = Axis (round $ double height / double (length lbls) - 1) <$> lbls
101
102 -- | Represent a labelled vertical bar.
103 data Bar = Bar
104 { width :: Int
105 , height :: Int
106 , label :: String
107 }
108
109 bar :: Bar -> Plot
110 bar (Bar w h l)
111 | h == 0 =
112 Plot $ replicate w '─' : lbl
113
114 | otherwise =
115 Plot $ [ padMiddle w '─' "┌┐" ]
116 ++ ( padMiddle w ' ' "││" .* (h - 1) )
117 ++ lbl
118 where
119 lbl = [ padBoth w ' ' l ]
120
121 -- | Represent one mark on the y-axis.
122 data Axis = Axis
123 { height :: Int
124 , label :: String
125 }
126
127 axis :: Int -> [Axis] -> Plot
128 axis _ [] = Plot []
129 axis w es = Plot (concatMap each (reverse es) ++ [ replicate w ' ' ])
130 where
131 each :: Axis -> [String]
132 each (Axis h l) =
133 padLeft w ' ' (l <> " ┤ ") : replicate h (padLeft w ' ' "│ ")
134
135 --
136 -- Plot
137 --
138
139 -- | A plot represents a partial plot on the console which is modeled as a 2D
140 -- grid (a list of list of chars). Plots can be combined horizontally and merged
141 -- into a bigger plot. Edges are smoothen into more appropriate charaters.
142 --
143 -- For any plots of length N & M, the plot (N <> M) is of length (N + M - 1).
144 newtype Plot = Plot { getPlot :: [String] }
145
146 instance Semigroup Plot where
147 Plot xs <> Plot ys
148 | length xs > length ys =
149 let ys' = fill (x - y) ys in Plot $ zipWith merge xs ys'
150
151 | otherwise =
152 let xs' = fill (y - x) xs in Plot $ zipWith merge xs' ys
153 where
154 (x, y) = (length xs, length ys)
155
156 merge [] ys = ys
157 merge xs [] = xs
158 merge xs ys
159 | match "││" = into "│"
160 | match "│┌" = into "├"
161 | match "│ " = into "│"
162 | match "┐│" = into "┤"
163 | match "┐┌" = into "┬"
164 | match "┐ " = into "┐"
165 | match " │" = into "│"
166 | match " ┌" = into "┌"
167 | match "─│" = into "┘"
168 | match "│─" = into "└"
169 | match "──" = into "─"
170 | match "┬─" = into "┬"
171 | match "┐─" = into "─"
172 | match "─┌" = into "─"
173 | otherwise = into " "
174 where
175 match [a,b] = last xs == a && head ys == b
176 into s = init xs ++ s ++ tail ys
177
178 instance Monoid Plot where
179 mempty = Plot []
180
181 --
182 -- Helpers
183 --
184
185 infixl 5 .*
186
187 (.*) :: e -> Int -> [e]
188 (.*) = flip replicate
189
190 double :: Real i => i -> Double
191 double = fromRational . toRational
192
193 padRight :: Int -> e -> [e] -> [e]
194 padRight n e es =
195 es ++ replicate (n - length es) e
196
197 padLeft :: Int -> e -> [e] -> [e]
198 padLeft n e es =
199 replicate (n - length es) e ++ es
200
201 padBoth :: Int -> e -> [e] -> [e]
202 padBoth n e es
203 | len >= n = es
204 | len `mod` 2 == 0 = padBoth n e $ padRight (len + 1) e es
205 | otherwise = padBoth n e $ padLeft (len + 1) e es
206 where
207 len = length es
208
209 padMiddle :: Int -> e -> [e] -> [e]
210 padMiddle n e es =
211 take half es ++ replicate δ e ++ drop half es
212 where
213 δ = n - length es
214 half = length es `div` 2
215
216 fill :: Int -> [String] -> [String]
217 fill n [] = replicate n mempty
218 fill n (h:q) = replicate n (replicate (length h) ' ') ++ (h:q)