{-|

Simple histograms

-}

module Graphics.Plotly.Histogram where

import Graphics.Plotly.Base hiding (sort)
import Data.List (sort, group)
import Lens.Micro
import Data.Aeson (toJSON)
import Data.Text (Text)

-- | build a histogram with a given binsize
histogram :: Int -- ^ number of bins
          -> [Double] -- ^ the individual observations
          -> Trace
histogram :: Int -> [Double] -> Trace
histogram Int
nbins [Double]
pts =
  let (Double
lo, Double
hi) = ([Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
pts, [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
pts)
      binSize :: Double
binSize = (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
nbins
      binToX :: Int -> Double
      binToX :: Int -> Double
binToX Int
binN = Int -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
binN Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
binSize Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
lo
      binMap :: [(Int, Int)]
      binMap :: [(Int, Int)]
binMap = Double -> Double -> [Double] -> [(Int, Int)]
getBinMap Double
lo Double
binSize [Double]
pts
  in Trace
bars Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
x ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ((Int, Int) -> Value) -> [(Int, Int)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> Value) -> ((Int, Int) -> Double) -> (Int, Int) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
binToX (Int -> Double) -> ((Int, Int) -> Int) -> (Int, Int) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> a
fst) [(Int, Int)]
binMap Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
y ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ((Int, Int) -> Value) -> [(Int, Int)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> ((Int, Int) -> Int) -> (Int, Int) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (Int, Int) -> Int
forall a b. (a, b) -> b
snd) [(Int, Int)]
binMap


histMany :: Int -> [(Text, [Double])] -> [Trace]
histMany :: Int -> [(Text, [Double])] -> [Trace]
histMany Int
nbins [(Text, [Double])]
hdata =
  let allPts :: [Double]
allPts = [[Double]] -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Double]] -> [Double]) -> [[Double]] -> [Double]
forall a b. (a -> b) -> a -> b
$ ((Text, [Double]) -> [Double]) -> [(Text, [Double])] -> [[Double]]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [Double]) -> [Double]
forall a b. (a, b) -> b
snd [(Text, [Double])]
hdata
      (Double
lo, Double
hi) = ([Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
allPts, [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
allPts)
      binSize :: Double
binSize = (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
nbins
      binToX :: Int -> Double
      binToX :: Int -> Double
binToX Int
binN = Int -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
binN Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
binSize Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
lo
      getTrace :: (Text, [Double]) -> Trace
getTrace (Text
nm,[Double]
pts) =
        let binMap :: [(Int, Int)]
binMap = Double -> Double -> [Double] -> [(Int, Int)]
getBinMap Double
lo Double
binSize [Double]
pts
        in Trace
bars Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
x ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ((Int, Int) -> Value) -> [(Int, Int)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> Value) -> ((Int, Int) -> Double) -> (Int, Int) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
binToX (Int -> Double) -> ((Int, Int) -> Int) -> (Int, Int) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> a
fst) [(Int, Int)]
binMap
                Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
y ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ((Int, Int) -> Value) -> [(Int, Int)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> ((Int, Int) -> Int) -> (Int, Int) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (Int, Int) -> Int
forall a b. (a, b) -> b
snd) [(Int, Int)]
binMap
                Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Trace -> Identity Trace
Lens' Trace (Maybe Text)
name ((Maybe Text -> Identity (Maybe Text)) -> Trace -> Identity Trace)
-> Text -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
nm
  in ((Text, [Double]) -> Trace) -> [(Text, [Double])] -> [Trace]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [Double]) -> Trace
getTrace [(Text, [Double])]
hdata

goFill :: [(Int,Int)] -> [(Int,Int)]
goFill :: [(Int, Int)] -> [(Int, Int)]
goFill (car :: (Int, Int)
car@(Int
bin1,Int
_):cdr :: [(Int, Int)]
cdr@((Int
bin2,Int
_):[(Int, Int)]
_))
   | Int
bin2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
bin1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 =  (Int, Int)
car (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [(Int, Int)] -> [(Int, Int)]
goFill [(Int, Int)]
cdr
   | Bool
otherwise = (Int, Int)
car (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [(Int, Int)] -> [(Int, Int)]
goFill ((Int
bin1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
0)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:[(Int, Int)]
cdr)
goFill [(Int, Int)]
l = [(Int, Int)]
l

getBinMap :: Double -> Double -> [Double] -> [(Int, Int)]
getBinMap :: Double -> Double -> [Double] -> [(Int, Int)]
getBinMap Double
lo Double
binSize [Double]
pts =
  let binf :: Double -> Int
      binf :: Double -> Int
binf Double
xv = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ (Double
xv Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
binSize
      bins :: [[Int]]
bins = [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
group ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Double -> Int) -> [Double] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Int
binf [Double]
pts
      binMap :: [(Int, Int)]
      binMap :: [(Int, Int)]
binMap = [(Int, Int)] -> [(Int, Int)]
goFill ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ ([Int] -> (Int, Int)) -> [[Int]] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int]
is -> ([Int] -> Int
forall a. [a] -> a
head [Int]
is, [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
is)) [[Int]]
bins
  in [(Int, Int)]
binMap