{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module Prettychart.Any
( anyChart,
anyWrite,
tryChart,
anyList1,
anyList2,
anyTuple2,
anySingleNamedBarChart,
anyBar2,
anyLineChart,
anySurfaceChart,
)
where
import Chart
import Data.Either (rights)
import Data.Maybe
import Data.Text (Text, pack, unpack)
import Optics.Core
import Prettychart.Charts
import Text.Read (readEither)
anyChart :: String -> Either String ChartOptions
anyChart :: String -> Either String ChartOptions
anyChart String
t =
Either String ChartOptions
-> (ChartOptions -> Either String ChartOptions)
-> Maybe ChartOptions
-> Either String ChartOptions
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String ChartOptions
forall a b. a -> Either a b
Left String
"<html>bad read</html>") ChartOptions -> Either String ChartOptions
forall a b. b -> Either a b
Right (Maybe ChartOptions -> Either String ChartOptions)
-> ([Either String ChartOptions] -> Maybe ChartOptions)
-> [Either String ChartOptions]
-> Either String ChartOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ChartOptions] -> Maybe ChartOptions
forall a. [a] -> Maybe a
listToMaybe ([ChartOptions] -> Maybe ChartOptions)
-> ([Either String ChartOptions] -> [ChartOptions])
-> [Either String ChartOptions]
-> Maybe ChartOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String ChartOptions] -> [ChartOptions]
forall a b. [Either a b] -> [b]
rights ([Either String ChartOptions] -> Either String ChartOptions)
-> [Either String ChartOptions] -> Either String ChartOptions
forall a b. (a -> b) -> a -> b
$
[
String -> ([Double] -> ChartOptions) -> Either String ChartOptions
forall a.
Read a =>
String -> (a -> ChartOptions) -> Either String ChartOptions
tryChart String
t [Double] -> ChartOptions
anyList1,
String
-> ([[Double]] -> ChartOptions) -> Either String ChartOptions
forall a.
Read a =>
String -> (a -> ChartOptions) -> Either String ChartOptions
tryChart String
t [[Double]] -> ChartOptions
anyList2,
String
-> ([(Double, Double)] -> ChartOptions)
-> Either String ChartOptions
forall a.
Read a =>
String -> (a -> ChartOptions) -> Either String ChartOptions
tryChart String
t (\[(Double, Double)]
x -> [[(Double, Double)]] -> ChartOptions
anyTuple2 [[(Double, Double)]
x]),
String
-> ([[(Double, Double)]] -> ChartOptions)
-> Either String ChartOptions
forall a.
Read a =>
String -> (a -> ChartOptions) -> Either String ChartOptions
tryChart String
t [[(Double, Double)]] -> ChartOptions
anyTuple2,
String
-> ([(Text, Double)] -> ChartOptions) -> Either String ChartOptions
forall a.
Read a =>
String -> (a -> ChartOptions) -> Either String ChartOptions
tryChart String
t [(Text, Double)] -> ChartOptions
anySingleNamedBarChart
]
anyWrite :: FilePath -> String -> IO ()
anyWrite :: String -> String -> IO ()
anyWrite String
f String
t = String -> String -> IO ()
writeFile String
f (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (String -> String)
-> (ChartOptions -> String) -> Either String ChartOptions -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
forall a. a -> a
id (Text -> String
unpack (Text -> String)
-> (ChartOptions -> Text) -> ChartOptions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChartOptions -> Text
renderChartOptions) (Either String ChartOptions -> String)
-> Either String ChartOptions -> String
forall a b. (a -> b) -> a -> b
$ String -> Either String ChartOptions
anyChart String
t
tryChart :: (Read a) => String -> (a -> ChartOptions) -> Either String ChartOptions
tryChart :: forall a.
Read a =>
String -> (a -> ChartOptions) -> Either String ChartOptions
tryChart String
t a -> ChartOptions
c = a -> ChartOptions
c (a -> ChartOptions)
-> Either String a -> Either String ChartOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String a
forall a. Read a => String -> Either String a
readEither String
t
anyList1 :: [Double] -> ChartOptions
anyList1 :: [Double] -> ChartOptions
anyList1 [Double]
xs
| [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1000 = Range Double -> Int -> [Double] -> ChartOptions
histChart (Range Double -> Maybe (Range Double) -> Range Double
forall a. a -> Maybe a -> a
fromMaybe Range Double
forall a. Multiplicative a => a
one (Maybe (Range Double) -> Range Double)
-> Maybe (Range Double) -> Range Double
forall a b. (a -> b) -> a -> b
$ [Element (Range Double)] -> Maybe (Range Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 [Double]
[Element (Range Double)]
xs) Int
20 [Double]
xs
| [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10 = [[Double]] -> ChartOptions
anyLineChart [[Double]
xs]
| Bool
otherwise = BarOptions -> BarData -> ChartOptions
barChart BarOptions
defaultBarOptions ([[Double]] -> [Text] -> [Text] -> BarData
BarData [[Double]
xs] [] [])
anyList2 :: [[Double]] -> ChartOptions
anyList2 :: [[Double]] -> ChartOptions
anyList2 [] = ChartOptions
forall a. Monoid a => a
mempty
anyList2 l :: [[Double]]
l@([Double]
xs : [[Double]]
xss)
| ([[Double]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
xss Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4) Bool -> Bool -> Bool
&& ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10) = [[Double]] -> ChartOptions
anyBar2 [[Double]]
l
| ([Double] -> Bool) -> [[Double]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (([[Double]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
l ==) (Int -> Bool) -> ([Double] -> Int) -> [Double] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[Double]]
l =
[[Double]] -> ChartOptions
anySurfaceChart [[Double]]
l
| Bool
otherwise = [[Double]] -> ChartOptions
anyLineChart [[Double]]
l
anySingleNamedBarChart :: [(Text, Double)] -> ChartOptions
anySingleNamedBarChart :: [(Text, Double)] -> ChartOptions
anySingleNamedBarChart [(Text, Double)]
xs =
BarOptions -> BarData -> ChartOptions
barChart
BarOptions
defaultBarOptions
( [[Double]] -> [Text] -> [Text] -> BarData
BarData
[(Text, Double) -> Double
forall a b. (a, b) -> b
snd ((Text, Double) -> Double) -> [(Text, Double)] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Double)]
xs]
((Text, Double) -> Text
forall a b. (a, b) -> a
fst ((Text, Double) -> Text) -> [(Text, Double)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Double)]
xs)
[]
)
anyBar2 :: [[Double]] -> ChartOptions
anyBar2 :: [[Double]] -> ChartOptions
anyBar2 [[Double]]
xss =
BarOptions -> BarData -> ChartOptions
barChart
BarOptions
defaultBarOptions
( [[Double]] -> [Text] -> [Text] -> BarData
BarData
[[Double]]
xss
(String -> Text
pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"row " <>) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
nrows [(Int
0 :: Int) ..])
(String -> Text
pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"col " <>) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
ncols [(Int
0 :: Int) ..])
)
where
ncols :: Int
ncols = [[Double]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
xss
nrows :: Int
nrows = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> [[Double]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]]
xss)
anyLineChart :: [[Double]] -> ChartOptions
anyLineChart :: [[Double]] -> ChartOptions
anyLineChart [[Double]]
xss =
ChartOptions
forall a. Monoid a => a
mempty
ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions
Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree
Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Chart] -> ChartTree
unnamed ((Int -> [Double] -> Chart) -> [Int] -> [[Double]] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
c [Double]
xs -> Double -> Colour -> [Double] -> Chart
simpleLineChart Double
0.02 (Int -> Colour
palette Int
c) [Double]
xs) [Int
0 ..] [[Double]]
xss)
anyTuple2 :: [[(Double, Double)]] -> ChartOptions
anyTuple2 :: [[(Double, Double)]] -> ChartOptions
anyTuple2 [[(Double, Double)]]
xss =
ChartOptions
forall a. Monoid a => a
mempty
ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions
Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree
Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Chart] -> ChartTree
unnamed ([[Point Double]] -> [Chart]
scatterChart (([(Double, Double)] -> [Point Double])
-> [[(Double, Double)]] -> [[Point Double]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Double, Double) -> Point Double)
-> [(Double, Double)] -> [Point Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double -> Point Double)
-> (Double, Double) -> Point Double
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Point Double
forall a. a -> a -> Point a
Point)) [[(Double, Double)]]
xss))
anySurfaceChart :: [[Double]] -> ChartOptions
anySurfaceChart :: [[Double]] -> ChartOptions
anySurfaceChart [[Double]]
xss = ChartOptions
forall a. Monoid a => a
mempty ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ChartTree
ct
where
ct :: ChartTree
ct = ChartBox -> [Hud] -> ChartTree -> ChartTree
runHudWith ChartBox
forall a. Multiplicative a => a
one [Hud]
h0 ([Chart] -> ChartTree
unnamed [Chart]
c)
(Maybe ChartBox
_, [Hud]
h0) = HudOptions -> ChartBox -> (Maybe ChartBox, [Hud])
toHuds (Int -> Int -> HudOptions
anySurfaceHud Int
nrows Int
ncols) ChartBox
gr
gr :: ChartBox
gr = Double -> Double -> Double -> Double -> ChartBox
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nrows :: Double) Double
0 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ncols)
([Chart]
c, Range Double
_) =
(Point Double -> Double)
-> SurfaceOptions -> ([Chart], Range Double)
surfacef
(\(Point Double
x Double
y) -> ([[Double]]
xss' [[Double]] -> Int -> [Double]
forall a. HasCallStack => [a] -> Int -> a
!! Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x) [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
y)
(SurfaceStyle -> Point Int -> ChartBox -> SurfaceOptions
SurfaceOptions SurfaceStyle
defaultSurfaceStyle (Int -> Int -> Point Int
forall a. a -> a -> Point a
Point Int
nrows Int
ncols) ChartBox
gr)
nrows :: Int
nrows = [[Double]] -> Int
Prettychart.Any.rows [[Double]]
xss
ncols :: Int
ncols = [[Double]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
xss
xss' :: [[Double]]
xss' = [[Double]] -> [[Double]]
appendZeros [[Double]]
xss
rows :: [[Double]] -> Int
rows :: [[Double]] -> Int
rows [[Double]]
xs = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int
0 :) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> [[Double]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]]
xs
appendZeros :: [[Double]] -> [[Double]]
appendZeros :: [[Double]] -> [[Double]]
appendZeros [[Double]]
xs =
( \[Double]
x ->
Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take
([[Double]] -> Int
Prettychart.Any.rows [[Double]]
xs)
([Double]
x [Double] -> [Double] -> [Double]
forall a. Semigroup a => a -> a -> a
<> Double -> [Double]
forall a. a -> [a]
repeat Double
0)
)
([Double] -> [Double]) -> [[Double]] -> [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]]
xs
anySurfaceHud :: Int -> Int -> HudOptions
anySurfaceHud :: Int -> Int -> HudOptions
anySurfaceHud Int
nx Int
ny =
HudOptions
defaultHudOptions
HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
A_Lens
NoIx
HudOptions
HudOptions
[Priority AxisOptions]
[Priority AxisOptions]
#axes
Optic
A_Lens
NoIx
HudOptions
HudOptions
[Priority AxisOptions]
[Priority AxisOptions]
-> [Priority AxisOptions] -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [ Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority
Double
5
( AxisOptions
defaultYAxisOptions
AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick
Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double, Text)] -> Tick
TickPlaced ([Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Double
0.5 +) (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 ..]) [Text]
labelsy)
),
Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority
Double
5
( AxisOptions
defaultXAxisOptions
AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick
Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double, Text)] -> Tick
TickPlaced ([Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Double
0.5 +) (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 ..]) [Text]
labelsx)
)
]
where
labelsx :: [Text]
labelsx = String -> Text
pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. (Int
nx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
labelsy :: [Text]
labelsy = String -> Text
pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. (Int
ny Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]