{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

-- | Read some text and attempt to make a chart.
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)

-- $setup
--
-- >>> :set -Wno-type-defaults
-- >>> import Chart
-- >>> import Prettychart.Any
-- >>> import Data.Text (unpack)

-- | Attempt to read some text and interpret it as data suitable for charting.
--
-- In the example below, 'anyChart' determines that the input text is of type [(Double, Double)] and renders a scatter chart of the data.
--
-- >>> unknownData = (,) <$> (((\x -> sin (pi * x/40)) . fromIntegral <$> ([1..40] :: [Int]))) <*> (((\x -> cos (pi * x/40)) . fromIntegral <$> ([1..40] :: [Int])))
-- >>> let c = anyChart $ show $ unknownData
-- >>> writeFile "other/anychart.svg" $ either id (unpack . renderChartOptions) c
--
-- ![anyChart Example](other/anychart.svg)
anyChart :: String -> Either String ChartOptions
anyChart :: String -> Either String ChartOptions
anyChart String
t =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left String
"<html>bad read</html>") forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> [b]
rights forall a b. (a -> b) -> a -> b
$
    [ -- single list
      forall a.
Read a =>
String -> (a -> ChartOptions) -> Either String ChartOptions
tryChart String
t [Double] -> ChartOptions
anyList1,
      -- double list
      forall a.
Read a =>
String -> (a -> ChartOptions) -> Either String ChartOptions
tryChart String
t [[Double]] -> ChartOptions
anyList2,
      -- single tuple list
      forall a.
Read a =>
String -> (a -> ChartOptions) -> Either String ChartOptions
tryChart String
t (\[(Double, Double)]
x -> [[(Double, Double)]] -> ChartOptions
anyTuple2 [[(Double, Double)]
x]),
      -- double tuple list
      forall a.
Read a =>
String -> (a -> ChartOptions) -> Either String ChartOptions
tryChart String
t [[(Double, Double)]] -> ChartOptions
anyTuple2,
      -- (Text,Double) single list
      forall a.
Read a =>
String -> (a -> ChartOptions) -> Either String ChartOptions
tryChart String
t [(Text, Double)] -> ChartOptions
anySingleNamedBarChart
    ]

-- | Attempt to read chart data and write to file.
anyWrite :: FilePath -> String -> IO ()
anyWrite :: String -> String -> IO ()
anyWrite String
f String
t = String -> String -> IO ()
writeFile String
f forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id (Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChartOptions -> Text
renderChartOptions) forall a b. (a -> b) -> a -> b
$ String -> Either String ChartOptions
anyChart String
t

-- | Read a String and try a chart with a particular shape.
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => String -> Either String a
readEither String
t

-- | Default chart for a single list.
anyList1 :: [Double] -> ChartOptions
anyList1 :: [Double] -> ChartOptions
anyList1 [Double]
xs
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs forall a. Ord a => a -> a -> Bool
> Int
1000 = Range Double -> Int -> [Double] -> ChartOptions
histChart (forall a. a -> Maybe a -> a
fromMaybe forall a. Multiplicative a => a
one forall a b. (a -> b) -> a -> b
$ forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 [Double]
xs) Int
20 [Double]
xs
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs 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] [] [])

-- | Default chart for a double list.
anyList2 :: [[Double]] -> ChartOptions
anyList2 :: [[Double]] -> ChartOptions
anyList2 [] = forall a. Monoid a => a
mempty
anyList2 l :: [[Double]]
l@([Double]
xs : [[Double]]
xss)
  | (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
xss forall a. Ord a => a -> a -> Bool
< Int
4) Bool -> Bool -> Bool
&& (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs forall a. Ord a => a -> a -> Bool
< Int
10) = [[Double]] -> ChartOptions
anyBar2 [[Double]]
l
  -- square
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
l ==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[Double]]
l =
      [[Double]] -> ChartOptions
anySurfaceChart [[Double]]
l
  | Bool
otherwise = [[Double]] -> ChartOptions
anyLineChart [[Double]]
l

-- | Bar chart for a labelled list.
anySingleNamedBarChart :: [(Text, Double)] -> ChartOptions
anySingleNamedBarChart :: [(Text, Double)] -> ChartOptions
anySingleNamedBarChart [(Text, Double)]
xs =
  BarOptions -> BarData -> ChartOptions
barChart
    BarOptions
defaultBarOptions
    ( [[Double]] -> [Text] -> [Text] -> BarData
BarData
        [forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Double)]
xs]
        (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Double)]
xs)
        []
    )

-- | Bar chart for a double list.
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"row " <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> [a] -> [a]
take Int
nrows [(Int
0 :: Int) ..])
        (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"col " <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> [a] -> [a]
take Int
ncols [(Int
0 :: Int) ..])
    )
  where
    ncols :: Int
ncols = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
xss
    nrows :: Int
nrows = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]]
xss)

-- | Multiple line chart.
anyLineChart :: [[Double]] -> ChartOptions
anyLineChart :: [[Double]] -> ChartOptions
anyLineChart [[Double]]
xss =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions
    forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "chartTree" a => a
#chartTree
    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 (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)

-- | Default scatter chart for paired data
anyTuple2 :: [[(Double, Double)]] -> ChartOptions
anyTuple2 :: [[(Double, Double)]] -> ChartOptions
anyTuple2 [[(Double, Double)]]
xss =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions
    forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "chartTree" a => a
#chartTree
    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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> Point a
Point)) [[(Double, Double)]]
xss))

-- | Default pixel chart for double list.
anySurfaceChart :: [[Double]] -> ChartOptions
anySurfaceChart :: [[Double]] -> ChartOptions
anySurfaceChart [[Double]]
xss = forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall a. IsLabel "chartTree" a => a
#chartTree 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 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 = forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nrows :: Double) Double
0 (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' forall a. [a] -> Int -> a
!! forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x) forall a. [a] -> Int -> a
!! forall a b. (RealFrac a, Integral b) => a -> b
floor Double
y)
        (SurfaceStyle -> Point Int -> ChartBox -> SurfaceOptions
SurfaceOptions SurfaceStyle
defaultSurfaceStyle (forall a. a -> a -> Point a
Point Int
nrows Int
ncols) ChartBox
gr)
    -- (defaultSurfaceLegendOptions dark "")
    nrows :: Int
nrows = [[Double]] -> Int
Prettychart.Any.rows [[Double]]
xss
    ncols :: Int
ncols = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
xss
    xss' :: [[Double]]
xss' = [[Double]] -> [[Double]]
appendZeros [[Double]]
xss

-- | Number of rows
rows :: [[Double]] -> Int
rows :: [[Double]] -> Int
rows [[Double]]
xs = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ (Int
0 :) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length 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 ->
      forall a. Int -> [a] -> [a]
take
        ([[Double]] -> Int
Prettychart.Any.rows [[Double]]
xs)
        ([Double]
x forall a. Semigroup a => a -> a -> a
<> forall a. a -> [a]
repeat Double
0)
  )
    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
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "axes" a => a
#axes
    forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [ forall a. Double -> a -> Priority a
Priority
           Double
5
           ( AxisOptions
defaultYAxisOptions
               forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
               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
% forall a. IsLabel "tick" a => a
#tick
               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 (forall a b. [a] -> [b] -> [(a, b)]
zip ((Double
0.5 +) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 ..]) [Text]
labelsy)
           ),
         forall a. Double -> a -> Priority a
Priority
           Double
5
           ( AxisOptions
defaultXAxisOptions
               forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
               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
% forall a. IsLabel "tick" a => a
#tick
               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 (forall a b. [a] -> [b] -> [(a, b)]
zip ((Double
0.5 +) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 ..]) [Text]
labelsx)
           )
       ]
  where
    labelsx :: [Text]
labelsx = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. (Int
nx forall a. Num a => a -> a -> a
- Int
1)]
    labelsy :: [Text]
labelsy = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. (Int
ny forall a. Num a => a -> a -> a
- Int
1)]